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
  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.
  13 #
  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.
  18 #
  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>.
  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 IO::File;
  73 use Time::HiRes;
  74
  75 use base qw(Class::Accessor);
  76
  77 use C4::Context;
  78 use C4::Koha;
  79 use Koha::UploadedFile;
  80 use Koha::UploadedFiles;
  81
  82 __PACKAGE__->mk_ro_accessors( qw|| );
  83
  84 =head1 INSTANCE METHODS
  85
  86 =head2 new
  87
  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.
  92
  93 =cut
  94
  95 sub new {
  96     my ( $class, $params ) = @_;
  97     my $self = $class->SUPER::new();
  98     $self->_init( $params );
  99     return $self;
 100 }
 101
 102 =head2 cgi
 103
 104     Returns CGI object. The CGI hook is used to store the uploaded files.
 105
 106 =cut
 107
 108 sub cgi {
 109     my ( $self ) = @_;
 110
 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 );
 116     if( $query ) {
 117         $self->_done;
 118         return $query;
 119     }
 120 }
 121
 122 =head2 count
 123
 124     Returns number of uploaded files without errors
 125
 126 =cut
 127
 128 sub count {
 129     my ( $self ) = @_;
 130     return scalar grep { !exists $self->{files}->{$_}->{errcode} } keys %{ $self->{files} };
 131 }
 132
 133 =head2 result
 134
 135     Returns a string of id's for each successful upload separated by commas.
 136
 137 =cut
 138
 139 sub result {
 140     my ( $self ) = @_;
 141     my @a = map { $self->{files}->{$_}->{id} }
 142         grep { !exists $self->{files}->{$_}->{errcode} }
 143         keys %{ $self->{files} };
 144     return @a? ( join ',', @a ): undef;
 145 }
 146
 147 =head2 err
 148
 149     Returns hashref with errors in format { file => { code => err }, ... }
 150     Undefined if there are no errors.
 151
 152 =cut
 153
 154 sub err {
 155     my ( $self ) = @_;
 156     my $err;
 157     foreach my $f ( keys %{ $self->{files} } ) {
 158         my $e = $self->{files}->{$f}->{errcode};
 159         $err->{ $f }->{code} = $e if $e;
 160     }
 161     return $err;
 162 }
 163
 164 =head1 CLASS METHODS
 165
 166 =head2 allows_add_by
 167
 168     allows_add_by checks if $userid has permission to add uploaded files
 169
 170 =cut
 171
 172 sub allows_add_by {
 173     my ( $class, $userid ) = @_; # do not confuse with borrowernumber
 174     my $flags = [
 175         { tools      => 'upload_general_files' },
 176         { circulate  => 'circulate_remaining_permissions' },
 177         { tools      => 'stage_marc_import' },
 178         { tools      => 'upload_local_cover_images' },
 179     ];
 180     require C4::Auth;
 181     foreach( @$flags ) {
 182         return 1 if C4::Auth::haspermission( $userid, $_ );
 183     }
 184     return;
 185 }
 186
 187 =head1 INTERNAL ROUTINES
 188
 189 =cut
 190
 191 sub _init {
 192     my ( $self, $params ) = @_;
 193
 194     $self->{rootdir} = Koha::UploadedFile->permanent_directory;
 195     $self->{tmpdir} = C4::Context::temporary_directory;
 196
 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/;
 203     } else {
 204         $self->{category} = $params->{category} || KOHA_UPLOAD;
 205     }
 206
 207     $self->{files} = {};
 208     $self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv;
 209     $self->{public} = $params->{public}? 1: undef;
 210 }
 211
 212 sub _fh {
 213     my ( $self, $filename ) = @_;
 214     if( $self->{files}->{$filename} ) {
 215         return $self->{files}->{$filename}->{fh};
 216     }
 217 }
 218
 219 sub _create_file {
 220     my ( $self, $filename ) = @_;
 221     my $fh;
 222     if( $self->{files}->{$filename} &&
 223             $self->{files}->{$filename}->{errcode} ) {
 224         #skip
 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
 229     } else {
 230         my $dir = $self->_dir;
 231         my $hashval = $self->{files}->{$filename}->{hash};
 232         my $fn = $hashval. '_'. $filename;
 233
 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
 236         if( -e "$dir/$fn" &&
 237         Koha::UploadedFiles->search({
 238             hashvalue          => $hashval,
 239             uploadcategorycode => $self->{category},
 240         })->count ) {
 241             $self->{files}->{$filename}->{errcode} = ERR_EXISTS;
 242             return;
 243         }
 244
 245         $fh = IO::File->new( "$dir/$fn", "w");
 246         if( $fh ) {
 247             $fh->binmode;
 248             $self->{files}->{$filename}->{fh}= $fh;
 249         } else {
 250             $self->{files}->{$filename}->{errcode} = ERR_PERMS;
 251         }
 252     }
 253     return $fh;
 254 }
 255
 256 sub _dir {
 257     my ( $self ) = @_;
 258     my $dir = $self->{temporary}? $self->{tmpdir}: $self->{rootdir};
 259     $dir.= '/'. $self->{category};
 260     mkdir $dir if !-d $dir;
 261     return $dir;
 262 }
 263
 264 sub _hook {
 265     my ( $self, $filename, $buffer, $bytes_read, $data ) = @_;
 266     $filename= Encode::decode_utf8( $filename ); # UTF8 chars in filename
 267     $self->_compute( $filename, $buffer );
 268     my $fh = $self->_fh( $filename ) // $self->_create_file( $filename );
 269     print $fh $buffer if $fh;
 270 }
 271
 272 sub _done {
 273     my ( $self ) = @_;
 274     $self->{done} = 1;
 275     foreach my $f ( keys %{ $self->{files} } ) {
 276         my $fh = $self->_fh($f);
 277         $self->_register( $f, $fh? tell( $fh ): undef )
 278             if !$self->{files}->{$f}->{errcode};
 279         $fh->close if $fh;
 280     }
 281 }
 282
 283 sub _register {
 284     my ( $self, $filename, $size ) = @_;
 285     my $rec = Koha::UploadedFile->new({
 286         hashvalue => $self->{files}->{$filename}->{hash},
 287         filename  => $filename,
 288         dir       => $self->{category},
 289         filesize  => $size,
 290         owner     => $self->{uid},
 291         uploadcategorycode => $self->{category},
 292         public    => $self->{public},
 293         permanent => $self->{temporary}? 0: 1,
 294     })->store;
 295     $self->{files}->{$filename}->{id} = $rec->id if $rec;
 296 }
 297
 298 sub _compute {
 299 # Computes hash value when sub hook feeds the first block
 300 # For temporary files, the id is made unique with time
 301     my ( $self, $name, $block ) = @_;
 302     if( !$self->{files}->{$name}->{hash} ) {
 303         my $str = $name. ( $self->{uid} // '0' ).
 304             ( $self->{temporary}? Time::HiRes::time(): '' ).
 305             $self->{category}. substr( $block, 0, BYTES_DIGEST );
 306         # since Digest cannot handle wide chars, we need to encode here
 307         # there could be a wide char in the filename or the category
 308         my $h = Digest::MD5::md5_hex( Encode::encode_utf8( $str ) );
 309         $self->{files}->{$name}->{hash} = $h;
 310     }
 311 }
 312
 313 =head1 AUTHOR
 314
 315     Koha Development Team
 316     Larger parts from Galen Charlton, Julian Maurice and Marcel de Rooy
 317
 318 =cut
 319
 320 1;