Koha/Upload.pm

   1 package Koha::Upload;
   2
   3 # Copyright 2007 LibLime, Galen Charlton
   4 # Copyright 2011-2012 BibLibre
   5 # Copyright 2015 Rijksmuseum
   6 #
   7 # This file is part of Koha.
   8 #
   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
  12 # version.
  13 #
  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.
  17 #
  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.
  21
  22 =head1 NAME
  23
  24 Koha::Upload - Facilitate file uploads (temporary and permanent)
  25
  26 =head1 SYNOPSIS
  27
  28     use Koha::Upload;
  29
  30     # add an upload (see tools/upload-file.pl)
  31     # the public flag allows retrieval via OPAC
  32     my $upload = Koha::Upload->new( public => 1, category => 'A' );
  33     my $cgi = $upload->cgi;
  34     # Do something with $upload->count, $upload->result or $upload->err
  35
  36     # get some upload records (in staff)
  37     # Note: use the public flag for OPAC
  38     my @uploads = Koha::Upload->new->get( term => $term );
  39     $template->param( uploads => \@uploads );
  40
  41     # staff download
  42     my $rec = Koha::Upload->new->get({ id => $id, filehandle => 1 });
  43     my $fh = $rec->{fh};
  44     my @hdr = Koha::Upload->httpheaders( $rec->{name} );
  45     print Encode::encode_utf8( $input->header( @hdr ) );
  46     while( <$fh> ) { print $_; }
  47     $fh->close;
  48
  49     # delete an upload
  50     my ( $fn ) = Koha::Upload->new->delete({ id => $id });
  51
  52 =head1 DESCRIPTION
  53
  54     This module is a refactored version of C4::UploadedFile but adds on top
  55     of that the new functions from report 6874 (Upload plugin in editor).
  56     That report added module UploadedFiles.pm. This module contains the
  57     functionality of both.
  58
  59 =head1 METHODS
  60
  61 =cut
  62
  63 use constant KOHA_UPLOAD => 'koha_upload';
  64 use constant BYTES_DIGEST => 2048;
  65
  66 use Modern::Perl;
  67 use CGI; # no utf8 flag, since it may interfere with binary uploads
  68 use Digest::MD5;
  69 use Encode;
  70 use File::Spec;
  71 use IO::File;
  72 use Time::HiRes;
  73
  74 use base qw(Class::Accessor);
  75
  76 use C4::Context;
  77 use C4::Koha;
  78 use Koha::UploadedFile;
  79 use Koha::UploadedFiles;
  80
  81 __PACKAGE__->mk_ro_accessors( qw|| );
  82
  83 =head2 new
  84
  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.
  89
  90 =cut
  91
  92 sub new {
  93     my ( $class, $params ) = @_;
  94     my $self = $class->SUPER::new();
  95     $self->_init( $params );
  96     return $self;
  97 }
  98
  99 =head2 cgi
 100
 101     Returns CGI object. The CGI hook is used to store the uploaded files.
 102
 103 =cut
 104
 105 sub cgi {
 106     my ( $self ) = @_;
 107
 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 );
 113     if( $query ) {
 114         $self->_done;
 115         return $query;
 116     }
 117 }
 118
 119 =head2 count
 120
 121     Returns number of uploaded files without errors
 122
 123 =cut
 124
 125 sub count {
 126     my ( $self ) = @_;
 127     return scalar grep { !exists $self->{files}->{$_}->{errcode} } keys %{ $self->{files} };
 128 }
 129
 130 =head2 result
 131
 132     Returns a string of id's for each successful upload separated by commas.
 133
 134 =cut
 135
 136 sub result {
 137     my ( $self ) = @_;
 138     my @a = map { $self->{files}->{$_}->{id} }
 139         grep { !exists $self->{files}->{$_}->{errcode} }
 140         keys %{ $self->{files} };
 141     return @a? ( join ',', @a ): undef;
 142 }
 143
 144 =head2 err
 145
 146     Returns hash with errors in format { file => err, ... }
 147     Undefined if there are no errors.
 148
 149 =cut
 150
 151 sub err {
 152     my ( $self ) = @_;
 153     my $err;
 154     foreach my $f ( keys %{ $self->{files} } ) {
 155         my $e = $self->{files}->{$f}->{errcode};
 156         $err->{ $f } = $e if $e;
 157     }
 158     return $err;
 159 }
 160
 161 =head2 get
 162
 163     Returns arrayref of uploaded records (hash) or one uploaded record.
 164     You can pass id => $id or hashvalue => $hash or term => $term.
 165     Optional parameter filehandle => 1 returns you a filehandle too.
 166
 167 =cut
 168
 169 sub get {
 170     my ( $self, $params ) = @_;
 171     my $temp= $self->_lookup( $params );
 172     my ( @rv, $res);
 173     foreach my $r ( @$temp ) {
 174         undef $res;
 175         foreach( qw[id hashvalue filesize uploadcategorycode public permanent owner] ) {
 176             $res->{$_} = $r->{$_};
 177         }
 178         $res->{name} = $r->{filename};
 179         $res->{path} = $self->_full_fname($r);
 180         if( $res->{path} && -r $res->{path} ) {
 181             if( $params->{filehandle} ) {
 182                 my $fh = IO::File->new( $res->{path}, "r" );
 183                 $fh->binmode if $fh;
 184                 $res->{fh} = $fh;
 185             }
 186             push @rv, $res;
 187         } else {
 188             $self->{files}->{ $r->{filename} }->{errcode}=5; #not readable
 189         }
 190         last if !wantarray;
 191     }
 192     return wantarray? @rv: $res;
 193 }
 194
 195 =head2 delete
 196
 197     Returns array of deleted filenames or undef.
 198     Since it now only accepts id as parameter, you should not expect more
 199     than one filename.
 200
 201 =cut
 202
 203 sub delete {
 204     my ( $self, $params ) = @_;
 205     return if !$params->{id};
 206     my @res;
 207     my $temp = $self->_lookup({ id => $params->{id} });
 208     foreach( @$temp ) {
 209         my $d = $self->_delete( $_ );
 210         push @res, $d if $d;
 211     }
 212     return if !@res;
 213     return @res;
 214 }
 215
 216 =head1 CLASS METHODS
 217
 218 =head2 getCategories
 219
 220     getCategories returns a list of upload category codes and names
 221
 222 =cut
 223
 224 sub getCategories {
 225     my ( $class ) = @_;
 226     my $cats = C4::Koha::GetAuthorisedValues('UPLOAD');
 227     [ map {{ code => $_->{authorised_value}, name => $_->{lib} }} @$cats ];
 228 }
 229
 230 =head2 httpheaders
 231
 232     httpheaders returns http headers for a retrievable upload
 233     Will be extended by report 14282
 234
 235 =cut
 236
 237 sub httpheaders {
 238     my ( $class, $name ) = @_;
 239     return (
 240         '-type'       => 'application/octet-stream',
 241         '-attachment' => $name,
 242     );
 243 }
 244
 245 =head2 allows_add_by
 246
 247     allows_add_by checks if $userid has permission to add uploaded files
 248
 249 =cut
 250
 251 sub allows_add_by {
 252     my ( $class, $userid ) = @_; # do not confuse with borrowernumber
 253     my $flags = [
 254         { tools      => 'upload_general_files' },
 255         { circulate  => 'circulate_remaining_permissions' },
 256         { tools      => 'stage_marc_import' },
 257         { tools      => 'upload_local_cover_images' },
 258     ];
 259     require C4::Auth;
 260     foreach( @$flags ) {
 261         return 1 if C4::Auth::haspermission( $userid, $_ );
 262     }
 263     return;
 264 }
 265
 266 =head1 INTERNAL ROUTINES
 267
 268 =cut
 269
 270 sub _init {
 271     my ( $self, $params ) = @_;
 272
 273     $self->{rootdir} = C4::Context->config('upload_path');
 274     $self->{tmpdir} = File::Spec->tmpdir;
 275
 276     $params->{tmp} = $params->{temp} if !exists $params->{tmp};
 277     $self->{temporary} = $params->{tmp}? 1: 0; #default false
 278     if( $params->{tmp} ) {
 279         my $db =  C4::Context->config('database');
 280         $self->{category} = KOHA_UPLOAD;
 281         $self->{category} =~ s/koha/$db/;
 282     } else {
 283         $self->{category} = $params->{category} || KOHA_UPLOAD;
 284     }
 285
 286     $self->{files} = {};
 287     $self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv;
 288     $self->{public} = $params->{public}? 1: undef;
 289 }
 290
 291 sub _fh {
 292     my ( $self, $filename ) = @_;
 293     if( $self->{files}->{$filename} ) {
 294         return $self->{files}->{$filename}->{fh};
 295     }
 296 }
 297
 298 sub _create_file {
 299     my ( $self, $filename ) = @_;
 300     my $fh;
 301     if( $self->{files}->{$filename} &&
 302             $self->{files}->{$filename}->{errcode} ) {
 303         #skip
 304     } elsif( !$self->{temporary} && !$self->{rootdir} ) {
 305         $self->{files}->{$filename}->{errcode} = 3; #no rootdir
 306     } elsif( $self->{temporary} && !$self->{tmpdir} ) {
 307         $self->{files}->{$filename}->{errcode} = 4; #no tempdir
 308     } else {
 309         my $dir = $self->_dir;
 310         my $hashval = $self->{files}->{$filename}->{hash};
 311         my $fn = $hashval. '_'. $filename;
 312
 313         # if the file exists and it is registered, then set error
 314         # if it exists, but is not in the database, we will overwrite
 315         if( -e "$dir/$fn" &&
 316             Koha::UploadedFiles->search({
 317                 hashvalue          => $hashval,
 318                 uploadcategorycode => $self->{category},
 319             })->count ) {
 320             $self->{files}->{$filename}->{errcode} = 1; #already exists
 321             return;
 322         }
 323
 324         $fh = IO::File->new( "$dir/$fn", "w");
 325         if( $fh ) {
 326             $fh->binmode;
 327             $self->{files}->{$filename}->{fh}= $fh;
 328         } else {
 329             $self->{files}->{$filename}->{errcode} = 2; #not writable
 330         }
 331     }
 332     return $fh;
 333 }
 334
 335 sub _dir {
 336     my ( $self ) = @_;
 337     my $dir = $self->{temporary}? $self->{tmpdir}: $self->{rootdir};
 338     $dir.= '/'. $self->{category};
 339     mkdir $dir if !-d $dir;
 340     return $dir;
 341 }
 342
 343 sub _full_fname {
 344     my ( $self, $rec ) = @_;
 345     my $p;
 346     if( ref $rec ) {
 347         $p = File::Spec->catfile(
 348             $rec->{permanent}? $self->{rootdir}: $self->{tmpdir},
 349             $rec->{dir},
 350             $rec->{hashvalue}. '_'. $rec->{filename}
 351         );
 352     }
 353     return $p;
 354 }
 355
 356 sub _hook {
 357     my ( $self, $filename, $buffer, $bytes_read, $data ) = @_;
 358     $filename= Encode::decode_utf8( $filename ); # UTF8 chars in filename
 359     $self->_compute( $filename, $buffer );
 360     my $fh = $self->_fh( $filename ) // $self->_create_file( $filename );
 361     print $fh $buffer if $fh;
 362 }
 363
 364 sub _done {
 365     my ( $self ) = @_;
 366     $self->{done} = 1;
 367     foreach my $f ( keys %{ $self->{files} } ) {
 368         my $fh = $self->_fh($f);
 369         $self->_register( $f, $fh? tell( $fh ): undef )
 370             if !$self->{files}->{$f}->{errcode};
 371         $fh->close if $fh;
 372     }
 373 }
 374
 375 sub _register {
 376     my ( $self, $filename, $size ) = @_;
 377     my $rec = Koha::UploadedFile->new({
 378         hashvalue => $self->{files}->{$filename}->{hash},
 379         filename  => $filename,
 380         dir       => $self->{category},
 381         filesize  => $size,
 382         owner     => $self->{uid},
 383         uploadcategorycode => $self->{category},
 384         public    => $self->{public},
 385         permanent => $self->{temporary}? 0: 1,
 386     })->store;
 387     $self->{files}->{$filename}->{id} = $rec->id if $rec;
 388 }
 389
 390 sub _lookup {
 391     my ( $self, $params ) = @_;
 392
 393     my ( $cond, $attr, %pubhash );
 394     %pubhash = $self->{public}? ( public => 1 ): ();
 395     if( $params->{id} ) {
 396         return [] if $params->{id} !~ /^\d+(,\d+)*$/;
 397         $cond = { id => [ split ',', $params->{id} ], %pubhash };
 398     } elsif( $params->{hashvalue} ) {
 399         $cond = { hashvalue => $params->{hashvalue}, %pubhash };
 400     } elsif( $params->{term} ) {
 401         $cond =
 402             [ { filename => { like => '%'.$params->{term}.'%' }, %pubhash },
 403               { hashvalue => { like => '%'.$params->{term}.'%' }, %pubhash } ];
 404     } else {
 405         return [];
 406     }
 407     $attr = { order_by => { -asc => 'id' }};
 408
 409     return Koha::UploadedFiles->search( $cond, $attr )->unblessed;
 410     # Does always return an arrayref (perhaps an empty one)
 411 }
 412
 413 sub _delete {
 414     my ( $self, $rec ) = @_;
 415     my $dbh = C4::Context->dbh;
 416     my $sql = 'DELETE FROM uploaded_files WHERE id=?';
 417     my $file = $self->_full_fname($rec);
 418     if( !-e $file ) { # we will just delete the record
 419         # TODO Should we add a trace here for the missing file?
 420         $dbh->do( $sql, undef, ( $rec->{id} ) );
 421         return $rec->{filename};
 422     } elsif( unlink($file) ) {
 423         $dbh->do( $sql, undef, ( $rec->{id} ) );
 424         return $rec->{filename};
 425     }
 426     $self->{files}->{ $rec->{filename} }->{errcode} = 7;
 427     #NOTE: errcode=6 is used to report successful delete (see template)
 428     return;
 429 }
 430
 431 sub _compute {
 432 # Computes hash value when sub hook feeds the first block
 433 # For temporary files, the id is made unique with time
 434     my ( $self, $name, $block ) = @_;
 435     if( !$self->{files}->{$name}->{hash} ) {
 436         my $str = $name. ( $self->{uid} // '0' ).
 437             ( $self->{temporary}? Time::HiRes::time(): '' ).
 438             $self->{category}. substr( $block, 0, BYTES_DIGEST );
 439         # since Digest cannot handle wide chars, we need to encode here
 440         # there could be a wide char in the filename or the category
 441         my $h = Digest::MD5::md5_hex( Encode::encode_utf8( $str ) );
 442         $self->{files}->{$name}->{hash} = $h;
 443     }
 444 }
 445
 446 =head1 AUTHOR
 447
 448     Koha Development Team
 449     Larger parts from Galen Charlton, Julian Maurice and Marcel de Rooy
 450
 451 =cut
 452
 453 1;