Bug 14321: Introduce Koha::Upload
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.
Signed-off-by: Mirko Tietgen <mirko@abunchofthings.net>
Signed-off-by: Julian Maurice <julian.maurice@biblibre.com>
Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
This commit is contained in:
Marcel de Rooy
Tomas Cohen Arazi
parent
d94251e017
commit
ba62a7ef24
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
}
|
||||
Loading…
Reference in New Issue