|
Line 0
Link Here
|
| 0 |
- |
1 |
#!/usr/bin/perl |
|
|
2 |
|
| 3 |
use Modern::Perl; |
| 4 |
use File::Temp qw/ tempdir /; |
| 5 |
use Test::More tests => 6; |
| 6 |
|
| 7 |
use Test::MockModule; |
| 8 |
use t::lib::Mocks; |
| 9 |
|
| 10 |
use C4::Context; |
| 11 |
use Koha::Upload; |
| 12 |
|
| 13 |
my $dbh = C4::Context->dbh; |
| 14 |
$dbh->{AutoCommit} = 0; |
| 15 |
$dbh->{RaiseError} = 1; |
| 16 |
|
| 17 |
our $current_upload = 0; |
| 18 |
our $uploads = [ |
| 19 |
[ |
| 20 |
{ name => 'file1', cat => 'A', size => 6000 }, |
| 21 |
{ name => 'file2', cat => 'A', size => 8000 }, |
| 22 |
], |
| 23 |
[ |
| 24 |
{ name => 'file3', cat => 'B', size => 1000 }, |
| 25 |
], |
| 26 |
[ |
| 27 |
{ name => 'file4', cat => undef, size => 5000 }, # temporary |
| 28 |
], |
| 29 |
[ |
| 30 |
{ name => 'file2', cat => 'A', size => 8000 }, |
| 31 |
# uploading a duplicate in cat A should fail |
| 32 |
], |
| 33 |
[ |
| 34 |
{ name => 'file4', cat => undef, size => 5000 }, # temp duplicate |
| 35 |
], |
| 36 |
]; |
| 37 |
|
| 38 |
# Redirect upload dir structure and mock File::Spec and CGI |
| 39 |
my $tempdir = tempdir( CLEANUP => 1 ); |
| 40 |
t::lib::Mocks::mock_config('upload_path', $tempdir); |
| 41 |
my $specmod = Test::MockModule->new( 'File::Spec' ); |
| 42 |
$specmod->mock( 'tmpdir' => sub { return $tempdir; } ); |
| 43 |
my $cgimod = Test::MockModule->new( 'CGI' ); |
| 44 |
$cgimod->mock( 'new' => \&newCGI ); |
| 45 |
|
| 46 |
# Start testing |
| 47 |
subtest 'Test01' => sub { |
| 48 |
plan tests => 7; |
| 49 |
test01(); |
| 50 |
}; |
| 51 |
subtest 'Test02' => sub { |
| 52 |
plan tests => 4; |
| 53 |
test02(); |
| 54 |
}; |
| 55 |
subtest 'Test03' => sub { |
| 56 |
plan tests => 2; |
| 57 |
test03(); |
| 58 |
}; |
| 59 |
subtest 'Test04' => sub { |
| 60 |
plan tests => 3; |
| 61 |
test04(); |
| 62 |
}; |
| 63 |
subtest 'Test05' => sub { |
| 64 |
plan tests => 5; |
| 65 |
test05(); |
| 66 |
}; |
| 67 |
subtest 'Test06' => sub { |
| 68 |
plan tests => 2; |
| 69 |
test06(); |
| 70 |
}; |
| 71 |
$dbh->rollback; |
| 72 |
|
| 73 |
sub test01 { |
| 74 |
my $upl = Koha::Upload->new({ |
| 75 |
category => $uploads->[$current_upload]->[0]->{cat}, |
| 76 |
}); |
| 77 |
my $cgi= $upl->cgi; |
| 78 |
my $res= $upl->result; |
| 79 |
is( $res =~ /^\d+,\d+$/, 1, 'Upload 1 includes two files' ); |
| 80 |
is( $upl->count, 2, 'Count returns 2 also' ); |
| 81 |
foreach my $r ( $upl->get({ id => $res }) ) { |
| 82 |
if( $r->{name} eq 'file1' ) { |
| 83 |
is( $r->{categorycode}, 'A', 'Check category A' ); |
| 84 |
is( $r->{filesize}, 6000, 'Check size of file1' ); |
| 85 |
} elsif( $r->{name} eq 'file2' ) { |
| 86 |
is( $r->{filesize}, 8000, 'Check size of file2' ); |
| 87 |
is( $r->{public}, undef, 'Check public undefined' ); |
| 88 |
} |
| 89 |
} |
| 90 |
is( $upl->err, undef, 'No errors reported' ); |
| 91 |
} |
| 92 |
|
| 93 |
sub test02 { |
| 94 |
my $upl = Koha::Upload->new({ |
| 95 |
category => $uploads->[$current_upload]->[0]->{cat}, |
| 96 |
public => 1, |
| 97 |
}); |
| 98 |
my $cgi= $upl->cgi; |
| 99 |
is( $upl->count, 1, 'Upload 2 includes one file' ); |
| 100 |
my $res= $upl->result; |
| 101 |
my $r = $upl->get({ id => $res, filehandle => 1 }); |
| 102 |
is( $r->{categorycode}, 'B', 'Check category B' ); |
| 103 |
is( $r->{public}, 1, 'Check public == 1' ); |
| 104 |
is( ref($r->{fh}) eq 'IO::File' && $r->{fh}->opened, 1, 'Get returns a file handle' ); |
| 105 |
} |
| 106 |
|
| 107 |
sub test03 { |
| 108 |
my $upl = Koha::Upload->new; #temporary |
| 109 |
my $cgi= $upl->cgi; |
| 110 |
is( $upl->count, 1, 'Upload 3 includes one temporary file' ); |
| 111 |
my $r = $upl->get({ id => $upl->result }); |
| 112 |
is( $r->{categorycode}, undef, 'Category NULL for temp file' ); |
| 113 |
} |
| 114 |
|
| 115 |
sub test04 { # Fail on a file already there |
| 116 |
my $upl = Koha::Upload->new({ |
| 117 |
category => $uploads->[$current_upload]->[0]->{cat}, |
| 118 |
}); |
| 119 |
my $cgi= $upl->cgi; |
| 120 |
is( $upl->count, 0, 'Upload 4 failed as expected' ); |
| 121 |
is( $upl->result, undef, 'Result is undefined' ); |
| 122 |
my $e = $upl->err; |
| 123 |
is( $e->{file2}, 1, "Errcode 1 [already exists] reported" ); |
| 124 |
} |
| 125 |
|
| 126 |
sub test05 { # add temporary file with same name and contents, delete it |
| 127 |
my $upl = Koha::Upload->new({ tmp => 1 }); |
| 128 |
my $cgi= $upl->cgi; |
| 129 |
is( $upl->count, 1, 'Upload 5 adds duplicate temporary file' ); |
| 130 |
my $id = $upl->result; |
| 131 |
my $r = $upl->get({ id => $id }); |
| 132 |
my @d = $upl->delete({ id => $id }); |
| 133 |
is( $d[0], $r->{name}, 'Delete successful' ); |
| 134 |
is( -e $r->{path}? 1: 0, 0, 'File no longer found after delete' ); |
| 135 |
is( scalar $upl->get({ id => $id }), undef, 'Record also gone' ); |
| 136 |
is( $upl->delete({ id => $id }), undef, 'Repeated delete failed' ); |
| 137 |
} |
| 138 |
|
| 139 |
sub test06 { #simple test for httpheaders and getCategories |
| 140 |
my @hdrs = Koha::Upload->httpheaders('does_not_matter_yet'); |
| 141 |
is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders'); |
| 142 |
$dbh->do("INSERT INTO authorised_values (category, authorised_value, lib) VALUES (?,?,?) ", undef, ( 'UPLOAD', 'HAVE_AT_LEAST_ONE', 'Hi there' )); |
| 143 |
my $cat = Koha::Upload->getCategories; |
| 144 |
is( @$cat >= 1, 1, 'getCategories returned at least one category' ); |
| 145 |
} |
| 146 |
|
| 147 |
sub newCGI { |
| 148 |
my ( $class, $hook ) = @_; |
| 149 |
my $read = 0; |
| 150 |
foreach my $uh ( @{$uploads->[ $current_upload ]} ) { |
| 151 |
for( my $i=0; $i< $uh->{size}; $i+=1000 ) { |
| 152 |
$read+= 1000; |
| 153 |
&$hook( $uh->{name}, 'a'x1000, $read ); |
| 154 |
} |
| 155 |
} |
| 156 |
$current_upload++; |
| 157 |
return $class; |
| 158 |
} |