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 under the
10 # terms of the GNU General Public License as published by the Free Software
11 # Foundation; either version 3 of the License, or (at your option) any later
14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License along
19 # with Koha; if not, write to the Free Software Foundation, Inc.,
20 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
24 Koha::Upload - Facilitate file uploads (temporary and permanent)
29 use Koha::UploadedFiles;
31 # add an upload (see tools/upload-file.pl)
32 # the public flag allows retrieval via OPAC
33 my $upload = Koha::Upload->new( public => 1, category => 'A' );
34 my $cgi = $upload->cgi;
35 # Do something with $upload->count, $upload->result or $upload->err
37 # get some upload records (in staff)
38 my @uploads1 = Koha::UploadedFiles->search({ filename => $name });
39 my @uploads2 = Koha::UploadedFiles->search_term({ term => $term });
42 my $rec = Koha::UploadedFiles->find( $id );
43 my $fh = $rec->file_handle;
44 my @hdr = Koha::Upload->httpheaders( $rec->filename );
45 print Encode::encode_utf8( $input->header( @hdr ) );
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.
59 =head1 INSTANCE METHODS
63 use constant KOHA_UPLOAD => 'koha_upload';
64 use constant BYTES_DIGEST => 2048;
67 use CGI; # no utf8 flag, since it may interfere with binary uploads
74 use base qw(Class::Accessor);
78 use Koha::UploadedFile;
79 use Koha::UploadedFiles;
81 __PACKAGE__->mk_ro_accessors( qw|| );
85 Returns new object based on Class::Accessor.
86 Use tmp or temp flag for temporary storage.
87 Use public flag to mark uploads as available in OPAC.
88 The category parameter is only useful for permanent storage.
93 my ( $class, $params ) = @_;
94 my $self = $class->SUPER::new();
95 $self->_init( $params );
101 Returns CGI object. The CGI hook is used to store the uploaded files.
108 # Next call handles the actual upload via CGI hook.
109 # The third parameter (0) below means: no CGI temporary storage.
110 # Cancelling an upload will make CGI abort the script; no problem,
111 # the file(s) without db entry will be removed later.
112 my $query = CGI::->new( sub { $self->_hook(@_); }, {}, 0 );
121 Returns number of uploaded files without errors
127 return scalar grep { !exists $self->{files}->{$_}->{errcode} } keys %{ $self->{files} };
132 Returns a string of id's for each successful upload separated by commas.
138 my @a = map { $self->{files}->{$_}->{id} }
139 grep { !exists $self->{files}->{$_}->{errcode} }
140 keys %{ $self->{files} };
141 return @a? ( join ',', @a ): undef;
146 Returns hash with errors in format { file => err, ... }
147 Undefined if there are no errors.
154 foreach my $f ( keys %{ $self->{files} } ) {
155 my $e = $self->{files}->{$f}->{errcode};
156 $err->{ $f } = $e if $e;
165 getCategories returns a list of upload category codes and names
171 my $cats = C4::Koha::GetAuthorisedValues('UPLOAD');
172 [ map {{ code => $_->{authorised_value}, name => $_->{lib} }} @$cats ];
177 httpheaders returns http headers for a retrievable upload
178 Will be extended by report 14282
183 my ( $class, $name ) = @_;
185 '-type' => 'application/octet-stream',
186 '-attachment' => $name,
192 allows_add_by checks if $userid has permission to add uploaded files
197 my ( $class, $userid ) = @_; # do not confuse with borrowernumber
199 { tools => 'upload_general_files' },
200 { circulate => 'circulate_remaining_permissions' },
201 { tools => 'stage_marc_import' },
202 { tools => 'upload_local_cover_images' },
206 return 1 if C4::Auth::haspermission( $userid, $_ );
211 =head1 INTERNAL ROUTINES
216 my ( $self, $params ) = @_;
218 $self->{rootdir} = Koha::UploadedFile->permanent_directory;
219 $self->{tmpdir} = Koha::UploadedFile->temporary_directory;
221 $params->{tmp} = $params->{temp} if !exists $params->{tmp};
222 $self->{temporary} = $params->{tmp}? 1: 0; #default false
223 if( $params->{tmp} ) {
224 my $db = C4::Context->config('database');
225 $self->{category} = KOHA_UPLOAD;
226 $self->{category} =~ s/koha/$db/;
228 $self->{category} = $params->{category} || KOHA_UPLOAD;
232 $self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv;
233 $self->{public} = $params->{public}? 1: undef;
237 my ( $self, $filename ) = @_;
238 if( $self->{files}->{$filename} ) {
239 return $self->{files}->{$filename}->{fh};
244 my ( $self, $filename ) = @_;
246 if( $self->{files}->{$filename} &&
247 $self->{files}->{$filename}->{errcode} ) {
249 } elsif( !$self->{temporary} && !$self->{rootdir} ) {
250 $self->{files}->{$filename}->{errcode} = 3; #no rootdir
251 } elsif( $self->{temporary} && !$self->{tmpdir} ) {
252 $self->{files}->{$filename}->{errcode} = 4; #no tempdir
254 my $dir = $self->_dir;
255 my $hashval = $self->{files}->{$filename}->{hash};
256 my $fn = $hashval. '_'. $filename;
258 # if the file exists and it is registered, then set error
259 # if it exists, but is not in the database, we will overwrite
261 Koha::UploadedFiles->search({
262 hashvalue => $hashval,
263 uploadcategorycode => $self->{category},
265 $self->{files}->{$filename}->{errcode} = 1; #already exists
269 $fh = IO::File->new( "$dir/$fn", "w");
272 $self->{files}->{$filename}->{fh}= $fh;
274 $self->{files}->{$filename}->{errcode} = 2; #not writable
282 my $dir = $self->{temporary}? $self->{tmpdir}: $self->{rootdir};
283 $dir.= '/'. $self->{category};
284 mkdir $dir if !-d $dir;
289 my ( $self, $filename, $buffer, $bytes_read, $data ) = @_;
290 $filename= Encode::decode_utf8( $filename ); # UTF8 chars in filename
291 $self->_compute( $filename, $buffer );
292 my $fh = $self->_fh( $filename ) // $self->_create_file( $filename );
293 print $fh $buffer if $fh;
299 foreach my $f ( keys %{ $self->{files} } ) {
300 my $fh = $self->_fh($f);
301 $self->_register( $f, $fh? tell( $fh ): undef )
302 if !$self->{files}->{$f}->{errcode};
308 my ( $self, $filename, $size ) = @_;
309 my $rec = Koha::UploadedFile->new({
310 hashvalue => $self->{files}->{$filename}->{hash},
311 filename => $filename,
312 dir => $self->{category},
314 owner => $self->{uid},
315 uploadcategorycode => $self->{category},
316 public => $self->{public},
317 permanent => $self->{temporary}? 0: 1,
319 $self->{files}->{$filename}->{id} = $rec->id if $rec;
323 # Computes hash value when sub hook feeds the first block
324 # For temporary files, the id is made unique with time
325 my ( $self, $name, $block ) = @_;
326 if( !$self->{files}->{$name}->{hash} ) {
327 my $str = $name. ( $self->{uid} // '0' ).
328 ( $self->{temporary}? Time::HiRes::time(): '' ).
329 $self->{category}. substr( $block, 0, BYTES_DIGEST );
330 # since Digest cannot handle wide chars, we need to encode here
331 # there could be a wide char in the filename or the category
332 my $h = Digest::MD5::md5_hex( Encode::encode_utf8( $str ) );
333 $self->{files}->{$name}->{hash} = $h;
339 Koha Development Team
340 Larger parts from Galen Charlton, Julian Maurice and Marcel de Rooy