1 package Koha::Uploader;
3 # Copyright 2007 LibLime, Galen Charlton
4 # Copyright 2011-2012 BibLibre
5 # Copyright 2015 Rijksmuseum
7 # This file is part of Koha.
9 # Koha is free software; you can redistribute it and/or modify it
10 # under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 3 of the License, or
12 # (at your option) any later version.
14 # Koha is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
24 Koha::Uploader - Facilitate file uploads (temporary and permanent)
29 use Koha::UploadedFile;
30 use Koha::UploadedFiles;
32 # add an upload (see tools/upload-file.pl)
33 # the public flag allows retrieval via OPAC
34 my $upload = Koha::Uploader->new( public => 1, category => 'A' );
35 my $cgi = $upload->cgi;
36 # Do something with $upload->count, $upload->result or $upload->err
38 # get some upload records (in staff) via Koha::UploadedFiles
39 my $uploads1 = Koha::UploadedFiles->search({ filename => $name });
40 my $uploads2 = Koha::UploadedFiles->search_term({ term => $term });
42 # staff download (via Koha::UploadedFile[s])
43 my $rec = Koha::UploadedFiles->find( $id );
44 my $fh = $rec->file_handle;
45 print Encode::encode_utf8( $input->header( $rec->httpheaders ) );
46 while( <$fh> ) { print $_; }
51 This module is a refactored version of C4::UploadedFile but adds on top
52 of that the new functions from report 6874 (Upload plugin in editor).
53 That report added module UploadedFiles.pm. This module contains the
54 functionality of both.
56 The module has been revised to use Koha::Object[s]; the delete method
57 has been moved to Koha::UploadedFile[s], as well as the get method.
61 use constant KOHA_UPLOAD => 'koha_upload';
62 use constant BYTES_DIGEST => 2048;
63 use constant ERR_EXISTS => 'UPLERR_ALREADY_EXISTS';
64 use constant ERR_PERMS => 'UPLERR_CANNOT_WRITE';
65 use constant ERR_ROOT => 'UPLERR_NO_ROOT_DIR';
66 use constant ERR_TEMP => 'UPLERR_NO_TEMP_DIR';
69 use CGI; # no utf8 flag, since it may interfere with binary uploads
75 use base qw(Class::Accessor);
79 use Koha::UploadedFile;
80 use Koha::UploadedFiles;
82 __PACKAGE__->mk_ro_accessors( qw|| );
84 =head1 INSTANCE METHODS
88 Returns new object based on Class::Accessor.
89 Use tmp or temp flag for temporary storage.
90 Use public flag to mark uploads as available in OPAC.
91 The category parameter is only useful for permanent storage.
96 my ( $class, $params ) = @_;
97 my $self = $class->SUPER::new();
98 $self->_init( $params );
104 Returns CGI object. The CGI hook is used to store the uploaded files.
111 # Next call handles the actual upload via CGI hook.
112 # The third parameter (0) below means: no CGI temporary storage.
113 # Cancelling an upload will make CGI abort the script; no problem,
114 # the file(s) without db entry will be removed later.
115 my $query = CGI::->new( sub { $self->_hook(@_); }, {}, 0 );
124 Returns number of uploaded files without errors
130 return scalar grep { !exists $self->{files}->{$_}->{errcode} } keys %{ $self->{files} };
135 Returns a string of id's for each successful upload separated by commas.
141 my @a = map { $self->{files}->{$_}->{id} }
142 grep { !exists $self->{files}->{$_}->{errcode} }
143 keys %{ $self->{files} };
144 return @a? ( join ',', @a ): undef;
149 Returns hashref with errors in format { file => { code => err }, ... }
150 Undefined if there are no errors.
157 foreach my $f ( keys %{ $self->{files} } ) {
158 my $e = $self->{files}->{$f}->{errcode};
159 $err->{ $f }->{code} = $e if $e;
168 allows_add_by checks if $userid has permission to add uploaded files
173 my ( $class, $userid ) = @_; # do not confuse with borrowernumber
175 { tools => 'upload_general_files' },
176 { circulate => 'circulate_remaining_permissions' },
177 { tools => 'stage_marc_import' },
178 { tools => 'upload_local_cover_images' },
182 return 1 if C4::Auth::haspermission( $userid, $_ );
187 =head1 INTERNAL ROUTINES
192 my ( $self, $params ) = @_;
194 $self->{rootdir} = Koha::UploadedFile->permanent_directory;
195 $self->{tmpdir} = C4::Context::temporary_directory;
197 $params->{tmp} = $params->{temp} if !exists $params->{tmp};
198 $self->{temporary} = $params->{tmp}? 1: 0; #default false
199 if( $params->{tmp} ) {
200 my $db = C4::Context->config('database');
201 $self->{category} = KOHA_UPLOAD;
202 $self->{category} =~ s/koha/$db/;
204 $self->{category} = $params->{category} || KOHA_UPLOAD;
208 $self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv;
209 $self->{public} = $params->{public}? 1: undef;
213 my ( $self, $filename ) = @_;
214 if( $self->{files}->{$filename} ) {
215 return $self->{files}->{$filename}->{fh};
220 my ( $self, $filename ) = @_;
222 if( $self->{files}->{$filename} &&
223 $self->{files}->{$filename}->{errcode} ) {
225 } elsif( !$self->{temporary} && !$self->{rootdir} ) {
226 $self->{files}->{$filename}->{errcode} = ERR_ROOT; #no rootdir
227 } elsif( $self->{temporary} && !$self->{tmpdir} ) {
228 $self->{files}->{$filename}->{errcode} = ERR_TEMP; #no tempdir
230 my $dir = $self->_dir;
231 my $hashval = $self->{files}->{$filename}->{hash};
232 my $fn = $hashval. '_'. $filename;
234 # if the file exists and it is registered, then set error
235 # if it exists, but is not in the database, we will overwrite
237 Koha::UploadedFiles->search({
238 hashvalue => $hashval,
239 uploadcategorycode => $self->{category},
241 $self->{files}->{$filename}->{errcode} = ERR_EXISTS;
245 $fh = IO::File->new( "$dir/$fn", "w");
248 $self->{files}->{$filename}->{fh}= $fh;
250 $self->{files}->{$filename}->{errcode} = ERR_PERMS;
258 my $dir = $self->{temporary}? $self->{tmpdir}: $self->{rootdir};
259 $dir.= '/'. $self->{category};
260 mkdir $dir if !-d $dir;
265 my ( $self, $filename, $buffer, $bytes_read, $data ) = @_;
266 $filename= Encode::decode_utf8( $filename ); # UTF8 chars in filename
267 $filename =~ s/[^A-Za-z0-9\-\.]//g;
268 $self->_compute( $filename, $buffer );
269 my $fh = $self->_fh( $filename ) // $self->_create_file( $filename );
270 print $fh $buffer if $fh;
276 foreach my $f ( keys %{ $self->{files} } ) {
277 my $fh = $self->_fh($f);
278 $self->_register( $f, $fh? tell( $fh ): undef )
279 if !$self->{files}->{$f}->{errcode};
285 my ( $self, $filename, $size ) = @_;
286 my $rec = Koha::UploadedFile->new({
287 hashvalue => $self->{files}->{$filename}->{hash},
288 filename => $filename,
289 dir => $self->{category},
291 owner => $self->{uid},
292 uploadcategorycode => $self->{category},
293 public => $self->{public},
294 permanent => $self->{temporary}? 0: 1,
296 $self->{files}->{$filename}->{id} = $rec->id if $rec;
300 # Computes hash value when sub hook feeds the first block
301 # For temporary files, the id is made unique with time
302 my ( $self, $name, $block ) = @_;
303 if( !$self->{files}->{$name}->{hash} ) {
304 my $str = $name. ( $self->{uid} // '0' ).
305 ( $self->{temporary}? Time::HiRes::time(): '' ).
306 $self->{category}. substr( $block, 0, BYTES_DIGEST );
307 # since Digest cannot handle wide chars, we need to encode here
308 # there could be a wide char in the filename or the category
309 my $h = Digest::MD5::md5_hex( Encode::encode_utf8( $str ) );
310 $self->{files}->{$name}->{hash} = $h;
316 Koha Development Team
317 Larger parts from Galen Charlton, Julian Maurice and Marcel de Rooy