From a3311ec8a11534a23f65c76dd3a304296a73de18 Mon Sep 17 00:00:00 2001 From: Marcel de Rooy Date: Thu, 30 Jul 2015 19:19:44 +0200 Subject: [PATCH] Bug 14321: Introduce Koha::Upload Content-Type: text/plain; charset=utf-8 This patch introduces Koha::Upload. It will replace the modules C4::UploadedFile.pm and the new C4::UploadedFiles.pm (from BZ 6874). It also includes a new unit test. NOTE: This unit test will replace the test for UploadedFiles.pm. It will no longer use dependency Test::CGI::Multipart. We are now mocking CGI and its hook to achieve the same result. Test plan: [1] Run t/db_dependent/Upload.t. Note that if you see a WARNING, you will still need to add an entry upload_path to your koha-conf.xml. Or you need to give write permission to your Koha instance user for that folder. --- Koha/Upload.pm | 426 +++++++++++++++++++++++++++++++++++++++++++++++ t/db_dependent/Upload.t | 183 ++++++++++++++++++++ 2 files changed, 609 insertions(+) create mode 100644 Koha/Upload.pm create mode 100644 t/db_dependent/Upload.t diff --git a/Koha/Upload.pm b/Koha/Upload.pm new file mode 100644 index 0000000..e30b354 --- /dev/null +++ b/Koha/Upload.pm @@ -0,0 +1,426 @@ +package Koha::Upload; + +# Copyright 2007 LibLime, Galen Charlton +# Copyright 2011-2012 BibLibre +# Copyright 2015 Rijksmuseum +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +=head1 NAME + +Koha::Upload - Facilitate file uploads (temporary and permanent) + +=head1 SYNOPSIS + + use Koha::Upload; + + # add an upload (see tools/upload-file.pl) + # the public flag allows retrieval via OPAC + my $upload = Koha::Upload->new( public => 1, category => 'A' ); + my $cgi = $upload->cgi; + # Do something with $upload->count, $upload->result or $upload->err + + # get some upload records (in staff) + # Note: use the public flag for OPAC + my @uploads = Koha::Upload->new->get( term => $term ); + $template->param( uploads => \@uploads ); + + # staff download + my $rec = Koha::Upload->new->get({ id => $id, filehandle => 1 }); + my $fh = $rec->{fh}; + my @hdr = Koha::Upload->httpheaders( $rec->{name} ); + print Encode::encode_utf8( $input->header( @hdr ) ); + while( <$fh> ) { print $_; } + $fh->close; + + # delete an upload + my ( $fn ) = Koha::Upload->new->delete({ id => $id }); + +=head1 DESCRIPTION + + This module is a refactored version of C4::UploadedFile but adds on top + of that the new functions from report 6874 (Upload plugin in editor). + That report added module UploadedFiles.pm. This module contains the + functionality of both. + +=head1 METHODS + +=cut + +use constant KOHA_UPLOAD => 'koha_upload'; +use constant BYTES_DIGEST => 2048; + +use Modern::Perl; +use CGI; # no utf8 flag, since it may interfere with binary uploads +use Digest::MD5; +use Encode; +use File::Spec; +use IO::File; +use Time::HiRes; + +use base qw(Class::Accessor); + +use C4::Context; +use C4::Koha; + +__PACKAGE__->mk_ro_accessors( qw|| ); + +=head2 new + + Returns new object based on Class::Accessor. + Use tmp or temp flag for temporary storage. + Use public flag to mark uploads as available in OPAC. + The category parameter is only useful for permanent storage. + +=cut + +sub new { + my ( $class, $params ) = @_; + my $self = $class->SUPER::new(); + $self->_init( $params ); + return $self; +} + +=head2 cgi + + Returns CGI object. The CGI hook is used to store the uploaded files. + +=cut + +sub cgi { + my ( $self ) = @_; + + # Next call handles the actual upload via CGI hook. + # The third parameter (0) below means: no CGI temporary storage. + # Cancelling an upload will make CGI abort the script; no problem, + # the file(s) without db entry will be removed later. + my $query = CGI::->new( sub { $self->_hook(@_); }, {}, 0 ); + if( $query ) { + $self->_done; + return $query; + } +} + +=head2 count + + Returns number of uploaded files without errors + +=cut + +sub count { + my ( $self ) = @_; + return scalar grep { !exists $self->{files}->{$_}->{errcode} } keys $self->{files}; +} + +=head2 result + + Returns a string of id's for each successful upload separated by commas. + +=cut + +sub result { + my ( $self ) = @_; + my @a = map { $self->{files}->{$_}->{id} } + grep { !exists $self->{files}->{$_}->{errcode} } + keys $self->{files}; + return @a? ( join ',', @a ): undef; +} + +=head2 err + + Returns hash with errors in format { file => err, ... } + Undefined if there are no errors. + +=cut + +sub err { + my ( $self ) = @_; + my $err; + foreach my $f ( keys $self->{files} ) { + my $e = $self->{files}->{$f}->{errcode}; + $err->{ $f } = $e if $e; + } + return $err; +} + +=head2 get + + Returns arrayref of uploaded records (hash) or one uploaded record. + You can pass id => $id or hashvalue => $hash or term => $term. + Optional parameter filehandle => 1 returns you a filehandle too. + +=cut + +sub get { + my ( $self, $params ) = @_; + my $temp= $self->_lookup( $params ); + my ( @rv, $res); + foreach my $r ( @$temp ) { + undef $res; + foreach( qw[id hashvalue filesize categorycode public permanent] ) { + $res->{$_} = $r->{$_}; + } + $res->{name} = $r->{filename}; + $res->{path} = $self->_full_fname($r); + if( $res->{path} && -r $res->{path} ) { + if( $params->{filehandle} ) { + my $fh = IO::File->new( $res->{path}, "r" ); + $fh->binmode if $fh; + $res->{fh} = $fh; + } + push @rv, $res; + } else { + $self->{files}->{ $r->{filename} }->{errcode}=5; #not readable + } + last if !wantarray; + } + return wantarray? @rv: $res; +} + +=head2 delete + + Returns array of deleted filenames or undef. + Since it now only accepts id as parameter, you should not expect more + than one filename. + +=cut + +sub delete { + my ( $self, $params ) = @_; + return if !$params->{id}; + my @res; + my $temp = $self->_lookup({ id => $params->{id} }); + foreach( @$temp ) { + my $d = $self->_delete( $_ ); + push @res, $d if $d; + } + return if !@res; + return @res; +} + +sub DESTROY { +} + +# ************** HELPER ROUTINES / CLASS METHODS ****************************** + +=head2 getCategories + + getCategories returns a list of upload category codes and names + +=cut + +sub getCategories { + my ( $class ) = @_; + my $cats = C4::Koha::GetAuthorisedValues('UPLOAD'); + [ map {{ code => $_->{authorised_value}, name => $_->{lib} }} @$cats ]; +} + +=head2 httpheaders + + httpheaders returns http headers for a retrievable upload + Will be extended by report 14282 + +=cut + +sub httpheaders { + my ( $class, $name ) = @_; + return ( + '-type' => 'application/octet-stream', + '-attachment' => $name, + ); +} + +# ************** INTERNAL ROUTINES ******************************************** + +sub _init { + my ( $self, $params ) = @_; + + $self->{rootdir} = C4::Context->config('upload_path'); + $self->{tmpdir} = File::Spec->tmpdir; + + $params->{tmp} = $params->{temp} if !exists $params->{tmp}; + $self->{temporary} = $params->{tmp}? 1: 0; #default false + $self->{category} = $params->{tmp}? KOHA_UPLOAD: + ( $params->{category} || KOHA_UPLOAD ); + + $self->{files} = {}; + $self->{uid} = C4::Context->userenv->{number} if C4::Context->userenv; + $self->{public} = $params->{public}? 1: undef; +} + +sub _fh { + my ( $self, $filename ) = @_; + if( $self->{files}->{$filename} ) { + return $self->{files}->{$filename}->{fh}; + } +} + +sub _create_file { + my ( $self, $filename ) = @_; + my $fh; + if( $self->{files}->{$filename} && + $self->{files}->{$filename}->{errcode} ) { + #skip + } elsif( !$self->{temporary} && !$self->{rootdir} ) { + $self->{files}->{$filename}->{errcode} = 3; #no rootdir + } elsif( $self->{temporary} && !$self->{tmpdir} ) { + $self->{files}->{$filename}->{errcode} = 4; #no tempdir + } else { + my $dir = $self->_dir; + my $fn = $self->{files}->{$filename}->{hash}. '_'. $filename; + if( -e "$dir/$fn" && @{ $self->_lookup({ + hashvalue => $self->{files}->{$filename}->{hash} }) } ) { + # if the file exists and it is registered, then set error + $self->{files}->{$filename}->{errcode} = 1; #already exists + return; + } + $fh = IO::File->new( "$dir/$fn", "w"); + if( $fh ) { + $fh->binmode; + $self->{files}->{$filename}->{fh}= $fh; + } else { + $self->{files}->{$filename}->{errcode} = 2; #not writable + } + } + return $fh; +} + +sub _dir { + my ( $self ) = @_; + my $dir = $self->{temporary}? $self->{tmpdir}: $self->{rootdir}; + $dir.= '/'. $self->{category}; + mkdir $dir if !-d $dir; + return $dir; +} + +sub _full_fname { + my ( $self, $rec ) = @_; + my $p; + if( ref $rec ) { + $p= $rec->{permanent}? $self->{rootdir}: $self->{tmpdir}; + $p.= '/'; + $p.= $rec->{dir}. '/'. $rec->{hashvalue}. '_'. $rec->{filename}; + } + return $p; +} + +sub _hook { + my ( $self, $filename, $buffer, $bytes_read, $data ) = @_; + $filename= Encode::decode_utf8( $filename ); # UTF8 chars in filename + $self->_compute( $filename, $buffer ); + my $fh = $self->_fh( $filename ) // $self->_create_file( $filename ); + print $fh $buffer if $fh; +} + +sub _done { + my ( $self ) = @_; + $self->{done} = 1; + foreach my $f ( keys $self->{files} ) { + my $fh = $self->_fh($f); + $self->_register( $f, $fh? tell( $fh ): undef ) + if !$self->{files}->{$f}->{errcode}; + $fh->close if $fh; + } +} + +sub _register { + my ( $self, $filename, $size ) = @_; + my $dbh= C4::Context->dbh; + my $sql= "INSERT INTO uploaded_files (hashvalue, filename, dir, filesize, + owner, categorycode, public, permanent) VALUES (?,?,?,?,?,?,?,?)"; + my @pars= ( + $self->{files}->{$filename}->{hash}, + $filename, + $self->{category}, + $size, + $self->{uid}, + $self->{category}, + $self->{public}, + $self->{temporary}? 0: 1, + ); + $dbh->do( $sql, undef, @pars ); + my $i = $dbh->last_insert_id(undef, undef, 'uploaded_files', undef); + $self->{files}->{$filename}->{id} = $i if $i; +} + +sub _lookup { + my ( $self, $params ) = @_; + my $dbh = C4::Context->dbh; + my $sql = qq| +SELECT id,hashvalue,filename,dir,filesize,categorycode,public,permanent +FROM uploaded_files + |; + my @pars; + if( $params->{id} ) { + return [] if $params->{id} !~ /^\d+(,\d+)*$/; + $sql.= "WHERE id IN ($params->{id})"; + @pars = (); + } elsif( $params->{hashvalue} ) { + $sql.= "WHERE hashvalue=?"; + @pars = ( $params->{hashvalue} ); + } elsif( $params->{term} ) { + $sql.= "WHERE (filename LIKE ? OR hashvalue LIKE ?)"; + @pars = ( '%'.$params->{term}.'%', '%'.$params->{term}.'%' ); + } else { + return []; + } + $sql.= $self->{public}? " AND public=1": ''; + $sql.= ' ORDER BY id'; + my $temp= $dbh->selectall_arrayref( $sql, { Slice => {} }, @pars ); + return $temp; +} + +sub _delete { + my ( $self, $rec ) = @_; + my $dbh = C4::Context->dbh; + my $sql = 'DELETE FROM uploaded_files WHERE id=?'; + my $file = $self->_full_fname($rec); + if( !-e $file ) { # we will just delete the record + # TODO Should we add a trace here for the missing file? + $dbh->do( $sql, undef, ( $rec->{id} ) ); + return $rec->{filename}; + } elsif( unlink($file) ) { + $dbh->do( $sql, undef, ( $rec->{id} ) ); + return $rec->{filename}; + } + $self->{files}->{ $rec->{filename} }->{errcode} = 7; + #NOTE: errcode=6 is used to report successful delete (see template) + return; +} + +sub _compute { +# Computes hash value when sub hook feeds the first block +# For temporary files, the id is made unique with time + my ( $self, $name, $block ) = @_; + if( !$self->{files}->{$name}->{hash} ) { + my $str = $name. ( $self->{uid} // '0' ). + ( $self->{temporary}? Time::HiRes::time(): '' ). + $self->{category}. substr( $block, 0, BYTES_DIGEST ); + # since Digest cannot handle wide chars, we need to encode here + # there could be a wide char in the filename or the category + my $h = Digest::MD5::md5_hex( Encode::encode_utf8( $str ) ); + $self->{files}->{$name}->{hash} = $h; + } +} + +=head1 AUTHOR + + Koha Development Team + Larger parts from Galen Charlton, Julian Maurice and Marcel de Rooy + +=cut + +1; diff --git a/t/db_dependent/Upload.t b/t/db_dependent/Upload.t new file mode 100644 index 0000000..d818034 --- /dev/null +++ b/t/db_dependent/Upload.t @@ -0,0 +1,183 @@ +#!/usr/bin/perl + +use Modern::Perl; +use File::Temp qw/ tempdir /; +use Test::More tests => 7; + +use Test::MockModule; +use t::lib::Mocks; + +use C4::Context; +use Koha::Upload; + +my $dbh = C4::Context->dbh; +$dbh->{AutoCommit} = 0; +$dbh->{RaiseError} = 1; + +our $current_upload = 0; +our $uploads = [ + [ + { name => 'file1', cat => 'A', size => 6000 }, + { name => 'file2', cat => 'A', size => 8000 }, + ], + [ + { name => 'file3', cat => 'B', size => 1000 }, + ], + [ + { name => 'file4', cat => undef, size => 5000 }, # temporary + ], + [ + { name => 'file2', cat => 'A', size => 8000 }, + # uploading a duplicate in cat A should fail + ], + [ + { name => 'file4', cat => undef, size => 5000 }, # temp duplicate + ], +]; + +# Before we mock upload_path, we are checking the real folder +# This may help identifying upload problems +my $realdir = C4::Context->config('upload_path'); +if( !$realdir ) { + warn "WARNING: You do not have upload_path in koha-conf.xml"; +} elsif( !-w $realdir ) { + warn "WARNING: You do not have write permissions in $realdir"; +} + +# Redirect upload dir structure and mock File::Spec and CGI +my $tempdir = tempdir( CLEANUP => 1 ); +t::lib::Mocks::mock_config('upload_path', $tempdir); +my $specmod = Test::MockModule->new( 'File::Spec' ); +$specmod->mock( 'tmpdir' => sub { return $tempdir; } ); +my $cgimod = Test::MockModule->new( 'CGI' ); +$cgimod->mock( 'new' => \&newCGI ); + +# Start testing +subtest 'Test01' => sub { + plan tests => 7; + test01(); +}; +subtest 'Test02' => sub { + plan tests => 4; + test02(); +}; +subtest 'Test03' => sub { + plan tests => 2; + test03(); +}; +subtest 'Test04' => sub { + plan tests => 3; + test04(); +}; +subtest 'Test05' => sub { + plan tests => 5; + test05(); +}; +subtest 'Test06' => sub { + plan tests => 2; + test06(); +}; +subtest 'Test07' => sub { + plan tests => 2; + test07(); +}; +$dbh->rollback; + +sub test01 { + # Delete existing records (for later tests) + $dbh->do( "DELETE FROM uploaded_files" ); + + my $upl = Koha::Upload->new({ + category => $uploads->[$current_upload]->[0]->{cat}, + }); + my $cgi= $upl->cgi; + my $res= $upl->result; + is( $res =~ /^\d+,\d+$/, 1, 'Upload 1 includes two files' ); + is( $upl->count, 2, 'Count returns 2 also' ); + foreach my $r ( $upl->get({ id => $res }) ) { + if( $r->{name} eq 'file1' ) { + is( $r->{categorycode}, 'A', 'Check category A' ); + is( $r->{filesize}, 6000, 'Check size of file1' ); + } elsif( $r->{name} eq 'file2' ) { + is( $r->{filesize}, 8000, 'Check size of file2' ); + is( $r->{public}, undef, 'Check public undefined' ); + } + } + is( $upl->err, undef, 'No errors reported' ); +} + +sub test02 { + my $upl = Koha::Upload->new({ + category => $uploads->[$current_upload]->[0]->{cat}, + public => 1, + }); + my $cgi= $upl->cgi; + is( $upl->count, 1, 'Upload 2 includes one file' ); + my $res= $upl->result; + my $r = $upl->get({ id => $res, filehandle => 1 }); + is( $r->{categorycode}, 'B', 'Check category B' ); + is( $r->{public}, 1, 'Check public == 1' ); + is( ref($r->{fh}) eq 'IO::File' && $r->{fh}->opened, 1, 'Get returns a file handle' ); +} + +sub test03 { + my $upl = Koha::Upload->new({ tmp => 1 }); #temporary + my $cgi= $upl->cgi; + is( $upl->count, 1, 'Upload 3 includes one temporary file' ); + my $r = $upl->get({ id => $upl->result }); + is( $r->{categorycode}, 'koha_upload', 'Check category temp file' ); +} + +sub test04 { # Fail on a file already there + my $upl = Koha::Upload->new({ + category => $uploads->[$current_upload]->[0]->{cat}, + }); + my $cgi= $upl->cgi; + is( $upl->count, 0, 'Upload 4 failed as expected' ); + is( $upl->result, undef, 'Result is undefined' ); + my $e = $upl->err; + is( $e->{file2}, 1, "Errcode 1 [already exists] reported" ); +} + +sub test05 { # add temporary file with same name and contents, delete it + my $upl = Koha::Upload->new({ tmp => 1 }); + my $cgi= $upl->cgi; + is( $upl->count, 1, 'Upload 5 adds duplicate temporary file' ); + my $id = $upl->result; + my $r = $upl->get({ id => $id }); + my @d = $upl->delete({ id => $id }); + is( $d[0], $r->{name}, 'Delete successful' ); + is( -e $r->{path}? 1: 0, 0, 'File no longer found after delete' ); + is( scalar $upl->get({ id => $id }), undef, 'Record also gone' ); + is( $upl->delete({ id => $id }), undef, 'Repeated delete failed' ); +} + +sub test06 { #some extra tests for get + my $upl = Koha::Upload->new({ public => 1 }); + my @rec = $upl->get({ term => 'file' }); + is( @rec, 1, 'Get returns only one public result (file3)' ); + $upl = Koha::Upload->new; # public == 0 + @rec = $upl->get({ term => 'file' }); + is( @rec, 4, 'Get returns now four results' ); +} + +sub test07 { #simple test for httpheaders and getCategories + my @hdrs = Koha::Upload->httpheaders('does_not_matter_yet'); + is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders'); + $dbh->do("INSERT INTO authorised_values (category, authorised_value, lib) VALUES (?,?,?) ", undef, ( 'UPLOAD', 'HAVE_AT_LEAST_ONE', 'Hi there' )); + my $cat = Koha::Upload->getCategories; + is( @$cat >= 1, 1, 'getCategories returned at least one category' ); +} + +sub newCGI { + my ( $class, $hook ) = @_; + my $read = 0; + foreach my $uh ( @{$uploads->[ $current_upload ]} ) { + for( my $i=0; $i< $uh->{size}; $i+=1000 ) { + $read+= 1000; + &$hook( $uh->{name}, 'a'x1000, $read ); + } + } + $current_upload++; + return $class; +} -- 1.7.10.4