Koha/Uploader.pm

   1 package Koha::Uploader;
   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::Uploader - Facilitate file uploads (temporary and permanent)
  25
  26 =head1 SYNOPSIS
  27
  28     use Koha::Uploader;
  29     use Koha::UploadedFile;
  30     use Koha::UploadedFiles;
  31
  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
  37
  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 });
  41
  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 $_; }
  47     $fh->close;
  48
  49 =head1 DESCRIPTION
  50
  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.
  55
  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.
  58
  59 =cut
  60
  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';
  67
  68 use Modern::Perl;
  69 use CGI; # no utf8 flag, since it may interfere with binary uploads
  70 use Digest::MD5;
  71 use Encode;
  72 use File::Spec;
  73 use IO::File;
  74 use Time::HiRes;
  75
  76 use base qw(Class::Accessor);
  77
  78 use C4::Context;
  79 use C4::Koha;
  80 use Koha::UploadedFile;
  81 use Koha::UploadedFiles;
  82
  83 __PACKAGE__->mk_ro_accessors( qw|| );
  84
  85 =head1 INSTANCE METHODS
  86
  87 =head2 new
  88
  89     Returns new object based on Class::Accessor.
  90     Use tmp or temp flag for temporary storage.
  91     Use public flag to mark uploads as available in OPAC.
  92     The category parameter is only useful for permanent storage.
  93
  94 =cut
  95
  96 sub new {
  97     my ( $class, $params ) = @_;
  98     my $self = $class->SUPER::new();
  99     $self->_init( $params );
 100     return $self;
 101 }
 102
 103 =head2 cgi
 104
 105     Returns CGI object. The CGI hook is used to store the uploaded files.
 106
 107 =cut
 108
 109 sub cgi {
 110     my ( $self ) = @_;
 111
 112     # Next call handles the actual upload via CGI hook.
 113     # The third parameter (0) below means: no CGI temporary storage.
 114     # Cancelling an upload will make CGI abort the script; no problem,
 115     # the file(s) without db entry will be removed later.
 116     my $query = CGI::->new( sub { $self->_hook(@_); }, {}, 0 );
 117     if( $query ) {
 118         $self->_done;
 119         return $query;
 120     }
 121 }
 122
 123 =head2 count
 124
 125     Returns number of uploaded files without errors
 126
 127 =cut
 128
 129 sub count {
 130     my ( $self ) = @_;
 131     return scalar grep { !exists $self->{files}->{$_}->{errcode} } keys %{ $self->{files} };
 132 }
 133
 134 =head2 result
 135
 136     Returns a string of id's for each successful upload separated by commas.
 137
 138 =cut
 139
 140 sub result {
 141     my ( $self ) = @_;
 142     my @a = map { $self->{files}->{$_}->{id} }
 143         grep { !exists $self->{files}->{$_}->{errcode} }
 144         keys %{ $self->{files} };
 145     return @a? ( join ',', @a ): undef;
 146 }
 147
 148 =head2 err
 149
 150     Returns hashref with errors in format { file => { code => err }, ... }
 151     Undefined if there are no errors.
 152
 153 =cut
 154
 155 sub err {
 156     my ( $self ) = @_;
 157     my $err;
 158     foreach my $f ( keys %{ $self->{files} } ) {
 159         my $e = $self->{files}->{$f}->{errcode};
 160         $err->{ $f }->{code} = $e if $e;
 161     }
 162     return $err;
 163 }
 164
 165 =head1 CLASS METHODS
 166
 167 =head2 allows_add_by
 168
 169     allows_add_by checks if $userid has permission to add uploaded files
 170
 171 =cut
 172
 173 sub allows_add_by {
 174     my ( $class, $userid ) = @_; # do not confuse with borrowernumber
 175     my $flags = [
 176         { tools      => 'upload_general_files' },
 177         { circulate  => 'circulate_remaining_permissions' },
 178         { tools      => 'stage_marc_import' },
 179         { tools      => 'upload_local_cover_images' },
 180     ];
 181     require C4::Auth;
 182     foreach( @$flags ) {
 183         return 1 if C4::Auth::haspermission( $userid, $_ );
 184     }
 185     return;
 186 }
 187
 188 =head1 INTERNAL ROUTINES
 189
 190 =cut
 191
 192 sub _init {
 193     my ( $self, $params ) = @_;
 194
 195     $self->{rootdir} = Koha::UploadedFile->permanent_directory;
 196     $self->{tmpdir} = C4::Context::temporary_directory;
 197
 198     $params->{tmp} = $params->{temp} if !exists $params->{tmp};
 199     $self->{temporary} = $params->{tmp}? 1: 0; #default false
 200     if( $params->{tmp} ) {
 201         my $db =  C4::Context->config('database');
 202         $self->{category} = KOHA_UPLOAD;
 203         $self->{category} =~ s/koha/$db/;
 204     } else {
 205         $self->{category} = $params->{category} || KOHA_UPLOAD;
 206     }
 207
 208     $self->{files} = {};
 209     $self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv;
 210     $self->{public} = $params->{public}? 1: undef;
 211 }
 212
 213 sub _fh {
 214     my ( $self, $filename ) = @_;
 215     if( $self->{files}->{$filename} ) {
 216         return $self->{files}->{$filename}->{fh};
 217     }
 218 }
 219
 220 sub _create_file {
 221     my ( $self, $filename ) = @_;
 222     my $fh;
 223     if( $self->{files}->{$filename} &&
 224             $self->{files}->{$filename}->{errcode} ) {
 225         #skip
 226     } elsif( !$self->{temporary} && !$self->{rootdir} ) {
 227         $self->{files}->{$filename}->{errcode} = ERR_ROOT; #no rootdir
 228     } elsif( $self->{temporary} && !$self->{tmpdir} ) {
 229         $self->{files}->{$filename}->{errcode} = ERR_TEMP; #no tempdir
 230     } else {
 231         my $dir = $self->_dir;
 232         my $hashval = $self->{files}->{$filename}->{hash};
 233         my $fn = $hashval. '_'. $filename;
 234
 235         # if the file exists and it is registered, then set error
 236         # if it exists, but is not in the database, we will overwrite
 237         if( -e "$dir/$fn" &&
 238         Koha::UploadedFiles->search({
 239             hashvalue          => $hashval,
 240             uploadcategorycode => $self->{category},
 241         })->count ) {
 242             $self->{files}->{$filename}->{errcode} = ERR_EXISTS;
 243             return;
 244         }
 245
 246         $fh = IO::File->new( "$dir/$fn", "w");
 247         if( $fh ) {
 248             $fh->binmode;
 249             $self->{files}->{$filename}->{fh}= $fh;
 250         } else {
 251             $self->{files}->{$filename}->{errcode} = ERR_PERMS;
 252         }
 253     }
 254     return $fh;
 255 }
 256
 257 sub _dir {
 258     my ( $self ) = @_;
 259     my $dir = $self->{temporary}? $self->{tmpdir}: $self->{rootdir};
 260     $dir.= '/'. $self->{category};
 261     mkdir $dir if !-d $dir;
 262     return $dir;
 263 }
 264
 265 sub _hook {
 266     my ( $self, $filename, $buffer, $bytes_read, $data ) = @_;
 267     $filename= Encode::decode_utf8( $filename ); # UTF8 chars in filename
 268     $self->_compute( $filename, $buffer );
 269     my $fh = $self->_fh( $filename ) // $self->_create_file( $filename );
 270     print $fh $buffer if $fh;
 271 }
 272
 273 sub _done {
 274     my ( $self ) = @_;
 275     $self->{done} = 1;
 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};
 280         $fh->close if $fh;
 281     }
 282 }
 283
 284 sub _register {
 285     my ( $self, $filename, $size ) = @_;
 286     my $rec = Koha::UploadedFile->new({
 287         hashvalue => $self->{files}->{$filename}->{hash},
 288         filename  => $filename,
 289         dir       => $self->{category},
 290         filesize  => $size,
 291         owner     => $self->{uid},
 292         uploadcategorycode => $self->{category},
 293         public    => $self->{public},
 294         permanent => $self->{temporary}? 0: 1,
 295     })->store;
 296     $self->{files}->{$filename}->{id} = $rec->id if $rec;
 297 }
 298
 299 sub _compute {
 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;
 311     }
 312 }
 313
 314 =head1 AUTHOR
 315
 316     Koha Development Team
 317     Larger parts from Galen Charlton, Julian Maurice and Marcel de Rooy
 318
 319 =cut
 320
 321 1;