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     use Koha::UploadedFiles;
  30
  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
  36
  37     # get some upload records (in staff)
  38     my @uploads1 = Koha::UploadedFiles->search({ filename => $name });
  39     my @uploads2 = Koha::UploadedFiles->search_term({ term => $term });
  40
  41     # staff download
  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 $_; }
  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 =head1 INSTANCE 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 =head1 CLASS METHODS
 162
 163 =head2 getCategories
 164
 165     getCategories returns a list of upload category codes and names
 166
 167 =cut
 168
 169 sub getCategories {
 170     my ( $class ) = @_;
 171     my $cats = C4::Koha::GetAuthorisedValues('UPLOAD');
 172     [ map {{ code => $_->{authorised_value}, name => $_->{lib} }} @$cats ];
 173 }
 174
 175 =head2 httpheaders
 176
 177     httpheaders returns http headers for a retrievable upload
 178     Will be extended by report 14282
 179
 180 =cut
 181
 182 sub httpheaders {
 183     my ( $class, $name ) = @_;
 184     return (
 185         '-type'       => 'application/octet-stream',
 186         '-attachment' => $name,
 187     );
 188 }
 189
 190 =head2 allows_add_by
 191
 192     allows_add_by checks if $userid has permission to add uploaded files
 193
 194 =cut
 195
 196 sub allows_add_by {
 197     my ( $class, $userid ) = @_; # do not confuse with borrowernumber
 198     my $flags = [
 199         { tools      => 'upload_general_files' },
 200         { circulate  => 'circulate_remaining_permissions' },
 201         { tools      => 'stage_marc_import' },
 202         { tools      => 'upload_local_cover_images' },
 203     ];
 204     require C4::Auth;
 205     foreach( @$flags ) {
 206         return 1 if C4::Auth::haspermission( $userid, $_ );
 207     }
 208     return;
 209 }
 210
 211 =head1 INTERNAL ROUTINES
 212
 213 =cut
 214
 215 sub _init {
 216     my ( $self, $params ) = @_;
 217
 218     $self->{rootdir} = Koha::UploadedFile->permanent_directory;
 219     $self->{tmpdir} = Koha::UploadedFile->temporary_directory;
 220
 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/;
 227     } else {
 228         $self->{category} = $params->{category} || KOHA_UPLOAD;
 229     }
 230
 231     $self->{files} = {};
 232     $self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv;
 233     $self->{public} = $params->{public}? 1: undef;
 234 }
 235
 236 sub _fh {
 237     my ( $self, $filename ) = @_;
 238     if( $self->{files}->{$filename} ) {
 239         return $self->{files}->{$filename}->{fh};
 240     }
 241 }
 242
 243 sub _create_file {
 244     my ( $self, $filename ) = @_;
 245     my $fh;
 246     if( $self->{files}->{$filename} &&
 247             $self->{files}->{$filename}->{errcode} ) {
 248         #skip
 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
 253     } else {
 254         my $dir = $self->_dir;
 255         my $hashval = $self->{files}->{$filename}->{hash};
 256         my $fn = $hashval. '_'. $filename;
 257
 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
 260         if( -e "$dir/$fn" &&
 261         Koha::UploadedFiles->search({
 262             hashvalue          => $hashval,
 263             uploadcategorycode => $self->{category},
 264         })->count ) {
 265             $self->{files}->{$filename}->{errcode} = 1; #already exists
 266             return;
 267         }
 268
 269         $fh = IO::File->new( "$dir/$fn", "w");
 270         if( $fh ) {
 271             $fh->binmode;
 272             $self->{files}->{$filename}->{fh}= $fh;
 273         } else {
 274             $self->{files}->{$filename}->{errcode} = 2; #not writable
 275         }
 276     }
 277     return $fh;
 278 }
 279
 280 sub _dir {
 281     my ( $self ) = @_;
 282     my $dir = $self->{temporary}? $self->{tmpdir}: $self->{rootdir};
 283     $dir.= '/'. $self->{category};
 284     mkdir $dir if !-d $dir;
 285     return $dir;
 286 }
 287
 288 sub _hook {
 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;
 294 }
 295
 296 sub _done {
 297     my ( $self ) = @_;
 298     $self->{done} = 1;
 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};
 303         $fh->close if $fh;
 304     }
 305 }
 306
 307 sub _register {
 308     my ( $self, $filename, $size ) = @_;
 309     my $rec = Koha::UploadedFile->new({
 310         hashvalue => $self->{files}->{$filename}->{hash},
 311         filename  => $filename,
 312         dir       => $self->{category},
 313         filesize  => $size,
 314         owner     => $self->{uid},
 315         uploadcategorycode => $self->{category},
 316         public    => $self->{public},
 317         permanent => $self->{temporary}? 0: 1,
 318     })->store;
 319     $self->{files}->{$filename}->{id} = $rec->id if $rec;
 320 }
 321
 322 sub _compute {
 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;
 334     }
 335 }
 336
 337 =head1 AUTHOR
 338
 339     Koha Development Team
 340     Larger parts from Galen Charlton, Julian Maurice and Marcel de Rooy
 341
 342 =cut
 343
 344 1;