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
  64 use Modern::Perl;
  65 use CGI; # no utf8 flag, since it may interfere with binary uploads
  66 use Digest::MD5;
  67 use Encode;
  68 use File::Spec;
  69 use IO::File;
  70 use Time::HiRes;
  71
  72 use base qw(Class::Accessor);
  73
  74 use C4::Context;
  75 use C4::Koha;
  76 use Koha::UploadedFile;
  77 use Koha::UploadedFiles;
  78
  79 __PACKAGE__->mk_ro_accessors( qw|| );
  80
  81 =head1 INSTANCE METHODS
  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 hashref with errors in format { file => { code => 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 }->{code} = $e if $e;
 157     }
 158     return $err;
 159 }
 160
 161 =head1 CLASS METHODS
 162
 163 =head2 allows_add_by
 164
 165     allows_add_by checks if $userid has permission to add uploaded files
 166
 167 =cut
 168
 169 sub allows_add_by {
 170     my ( $class, $userid ) = @_; # do not confuse with borrowernumber
 171     my $flags = [
 172         { tools      => 'upload_general_files' },
 173         { circulate  => 'circulate_remaining_permissions' },
 174         { tools      => 'stage_marc_import' },
 175         { tools      => 'upload_local_cover_images' },
 176     ];
 177     require C4::Auth;
 178     foreach( @$flags ) {
 179         return 1 if C4::Auth::haspermission( $userid, $_ );
 180     }
 181     return;
 182 }
 183
 184 =head1 INTERNAL ROUTINES
 185
 186 =cut
 187
 188 sub _init {
 189     my ( $self, $params ) = @_;
 190
 191     $self->{rootdir} = Koha::UploadedFile->permanent_directory;
 192     $self->{tmpdir} = C4::Context::temporary_directory;
 193
 194     $params->{tmp} = $params->{temp} if !exists $params->{tmp};
 195     $self->{temporary} = $params->{tmp}? 1: 0; #default false
 196     if( $params->{tmp} ) {
 197         my $db =  C4::Context->config('database');
 198         $self->{category} = KOHA_UPLOAD;
 199         $self->{category} =~ s/koha/$db/;
 200     } else {
 201         $self->{category} = $params->{category} || KOHA_UPLOAD;
 202     }
 203
 204     $self->{files} = {};
 205     $self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv;
 206     $self->{public} = $params->{public}? 1: undef;
 207 }
 208
 209 sub _fh {
 210     my ( $self, $filename ) = @_;
 211     if( $self->{files}->{$filename} ) {
 212         return $self->{files}->{$filename}->{fh};
 213     }
 214 }
 215
 216 sub _create_file {
 217     my ( $self, $filename ) = @_;
 218     my $fh;
 219     if( $self->{files}->{$filename} &&
 220             $self->{files}->{$filename}->{errcode} ) {
 221         #skip
 222     } elsif( !$self->{temporary} && !$self->{rootdir} ) {
 223         $self->{files}->{$filename}->{errcode} = 3; #no rootdir
 224     } elsif( $self->{temporary} && !$self->{tmpdir} ) {
 225         $self->{files}->{$filename}->{errcode} = 4; #no tempdir
 226     } else {
 227         my $dir = $self->_dir;
 228         my $hashval = $self->{files}->{$filename}->{hash};
 229         my $fn = $hashval. '_'. $filename;
 230
 231         # if the file exists and it is registered, then set error
 232         # if it exists, but is not in the database, we will overwrite
 233         if( -e "$dir/$fn" &&
 234         Koha::UploadedFiles->search({
 235             hashvalue          => $hashval,
 236             uploadcategorycode => $self->{category},
 237         })->count ) {
 238             $self->{files}->{$filename}->{errcode} = 1; #already exists
 239             return;
 240         }
 241
 242         $fh = IO::File->new( "$dir/$fn", "w");
 243         if( $fh ) {
 244             $fh->binmode;
 245             $self->{files}->{$filename}->{fh}= $fh;
 246         } else {
 247             $self->{files}->{$filename}->{errcode} = 2; #not writable
 248         }
 249     }
 250     return $fh;
 251 }
 252
 253 sub _dir {
 254     my ( $self ) = @_;
 255     my $dir = $self->{temporary}? $self->{tmpdir}: $self->{rootdir};
 256     $dir.= '/'. $self->{category};
 257     mkdir $dir if !-d $dir;
 258     return $dir;
 259 }
 260
 261 sub _hook {
 262     my ( $self, $filename, $buffer, $bytes_read, $data ) = @_;
 263     $filename= Encode::decode_utf8( $filename ); # UTF8 chars in filename
 264     $self->_compute( $filename, $buffer );
 265     my $fh = $self->_fh( $filename ) // $self->_create_file( $filename );
 266     print $fh $buffer if $fh;
 267 }
 268
 269 sub _done {
 270     my ( $self ) = @_;
 271     $self->{done} = 1;
 272     foreach my $f ( keys %{ $self->{files} } ) {
 273         my $fh = $self->_fh($f);
 274         $self->_register( $f, $fh? tell( $fh ): undef )
 275             if !$self->{files}->{$f}->{errcode};
 276         $fh->close if $fh;
 277     }
 278 }
 279
 280 sub _register {
 281     my ( $self, $filename, $size ) = @_;
 282     my $rec = Koha::UploadedFile->new({
 283         hashvalue => $self->{files}->{$filename}->{hash},
 284         filename  => $filename,
 285         dir       => $self->{category},
 286         filesize  => $size,
 287         owner     => $self->{uid},
 288         uploadcategorycode => $self->{category},
 289         public    => $self->{public},
 290         permanent => $self->{temporary}? 0: 1,
 291     })->store;
 292     $self->{files}->{$filename}->{id} = $rec->id if $rec;
 293 }
 294
 295 sub _compute {
 296 # Computes hash value when sub hook feeds the first block
 297 # For temporary files, the id is made unique with time
 298     my ( $self, $name, $block ) = @_;
 299     if( !$self->{files}->{$name}->{hash} ) {
 300         my $str = $name. ( $self->{uid} // '0' ).
 301             ( $self->{temporary}? Time::HiRes::time(): '' ).
 302             $self->{category}. substr( $block, 0, BYTES_DIGEST );
 303         # since Digest cannot handle wide chars, we need to encode here
 304         # there could be a wide char in the filename or the category
 305         my $h = Digest::MD5::md5_hex( Encode::encode_utf8( $str ) );
 306         $self->{files}->{$name}->{hash} = $h;
 307     }
 308 }
 309
 310 =head1 AUTHOR
 311
 312     Koha Development Team
 313     Larger parts from Galen Charlton, Julian Maurice and Marcel de Rooy
 314
 315 =cut
 316
 317 1;