t/db_dependent/Upload.t

   1 #!/usr/bin/perl
   2
   3 use Modern::Perl;
   4 use File::Temp qw/ tempdir /;
   5 use Test::More tests => 7;
   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 # Before we mock upload_path, we are checking the real folder
  39 # This may help identifying upload problems
  40 my $realdir = C4::Context->config('upload_path');
  41 if( !$realdir ) {
  42     warn "WARNING: You do not have upload_path in koha-conf.xml";
  43 } elsif( !-w $realdir ) {
  44     warn "WARNING: You do not have write permissions in $realdir";
  45 }
  46
  47 # Redirect upload dir structure and mock File::Spec and CGI
  48 my $tempdir = tempdir( CLEANUP => 1 );
  49 t::lib::Mocks::mock_config('upload_path', $tempdir);
  50 my $specmod = Test::MockModule->new( 'File::Spec' );
  51 $specmod->mock( 'tmpdir' => sub { return $tempdir; } );
  52 my $cgimod = Test::MockModule->new( 'CGI' );
  53 $cgimod->mock( 'new' => \&newCGI );
  54
  55 # Start testing
  56 subtest 'Test01' => sub {
  57     plan tests => 7;
  58     test01();
  59 };
  60 subtest 'Test02' => sub {
  61     plan tests => 4;
  62     test02();
  63 };
  64 subtest 'Test03' => sub {
  65     plan tests => 2;
  66     test03();
  67 };
  68 subtest 'Test04' => sub {
  69     plan tests => 3;
  70     test04();
  71 };
  72 subtest 'Test05' => sub {
  73     plan tests => 5;
  74     test05();
  75 };
  76 subtest 'Test06' => sub {
  77     plan tests => 2;
  78     test06();
  79 };
  80 subtest 'Test07' => sub {
  81     plan tests => 2;
  82     test07();
  83 };
  84 $dbh->rollback;
  85
  86 sub test01 {
  87     # Delete existing records (for later tests)
  88     $dbh->do( "DELETE FROM uploaded_files" );
  89
  90     my $upl = Koha::Upload->new({
  91         category => $uploads->[$current_upload]->[0]->{cat},
  92     });
  93     my $cgi= $upl->cgi;
  94     my $res= $upl->result;
  95     is( $res =~ /^\d+,\d+$/, 1, 'Upload 1 includes two files' );
  96     is( $upl->count, 2, 'Count returns 2 also' );
  97     foreach my $r ( $upl->get({ id => $res }) ) {
  98         if( $r->{name} eq 'file1' ) {
  99             is( $r->{uploadcategorycode}, 'A', 'Check category A' );
 100             is( $r->{filesize}, 6000, 'Check size of file1' );
 101         } elsif( $r->{name} eq 'file2' ) {
 102             is( $r->{filesize}, 8000, 'Check size of file2' );
 103             is( $r->{public}, undef, 'Check public undefined' );
 104         }
 105     }
 106     is( $upl->err, undef, 'No errors reported' );
 107 }
 108
 109 sub test02 {
 110     my $upl = Koha::Upload->new({
 111         category => $uploads->[$current_upload]->[0]->{cat},
 112         public => 1,
 113     });
 114     my $cgi= $upl->cgi;
 115     is( $upl->count, 1, 'Upload 2 includes one file' );
 116     my $res= $upl->result;
 117     my $r = $upl->get({ id => $res, filehandle => 1 });
 118     is( $r->{uploadcategorycode}, 'B', 'Check category B' );
 119     is( $r->{public}, 1, 'Check public == 1' );
 120     is( ref($r->{fh}) eq 'IO::File' && $r->{fh}->opened, 1, 'Get returns a file handle' );
 121 }
 122
 123 sub test03 {
 124     my $upl = Koha::Upload->new({ tmp => 1 }); #temporary
 125     my $cgi= $upl->cgi;
 126     is( $upl->count, 1, 'Upload 3 includes one temporary file' );
 127     my $r = $upl->get({ id => $upl->result });
 128     is( $r->{uploadcategorycode}, 'koha_upload', 'Check category temp file' );
 129 }
 130
 131 sub test04 { # Fail on a file already there
 132     my $upl = Koha::Upload->new({
 133         category => $uploads->[$current_upload]->[0]->{cat},
 134     });
 135     my $cgi= $upl->cgi;
 136     is( $upl->count, 0, 'Upload 4 failed as expected' );
 137     is( $upl->result, undef, 'Result is undefined' );
 138     my $e = $upl->err;
 139     is( $e->{file2}, 1, "Errcode 1 [already exists] reported" );
 140 }
 141
 142 sub test05 { # add temporary file with same name and contents, delete it
 143     my $upl = Koha::Upload->new({ tmp => 1 });
 144     my $cgi= $upl->cgi;
 145     is( $upl->count, 1, 'Upload 5 adds duplicate temporary file' );
 146     my $id = $upl->result;
 147     my $r = $upl->get({ id => $id });
 148     my @d = $upl->delete({ id => $id });
 149     is( $d[0], $r->{name}, 'Delete successful' );
 150     is( -e $r->{path}? 1: 0, 0, 'File no longer found after delete' );
 151     is( scalar $upl->get({ id => $id }), undef, 'Record also gone' );
 152     is( $upl->delete({ id => $id }), undef, 'Repeated delete failed' );
 153 }
 154
 155 sub test06 { #some extra tests for get
 156     my $upl = Koha::Upload->new({ public => 1 });
 157     my @rec = $upl->get({ term => 'file' });
 158     is( @rec, 1, 'Get returns only one public result (file3)' );
 159     $upl = Koha::Upload->new; # public == 0
 160     @rec = $upl->get({ term => 'file' });
 161     is( @rec, 4, 'Get returns now four results' );
 162 }
 163
 164 sub test07 { #simple test for httpheaders and getCategories
 165     my @hdrs = Koha::Upload->httpheaders('does_not_matter_yet');
 166     is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders');
 167     $dbh->do("INSERT INTO authorised_values (category, authorised_value, lib) VALUES (?,?,?) ", undef, ( 'UPLOAD', 'HAVE_AT_LEAST_ONE', 'Hi there' ));
 168     my $cat = Koha::Upload->getCategories;
 169     is( @$cat >= 1, 1, 'getCategories returned at least one category' );
 170 }
 171
 172 sub newCGI {
 173     my ( $class, $hook ) = @_;
 174     my $read = 0;
 175     foreach my $uh ( @{$uploads->[ $current_upload ]} ) {
 176         for( my $i=0; $i< $uh->{size}; $i+=1000 ) {
 177             $read+= 1000;
 178             &$hook( $uh->{name}, 'a'x1000, $read );
 179         }
 180     }
 181     $current_upload++;
 182     return $class;
 183 }