t/db_dependent/UploadedFiles.t

   1 #!/usr/bin/perl
   2
   3 use Modern::Perl;
   4 use File::Temp qw/ tempdir /;
   5 use Test::CGI::Multipart;
   6 use Test::More tests => 18;
   7 use Test::Warn;
   8
   9 use t::lib::Mocks;
  10
  11 use C4::Context;
  12 use C4::UploadedFiles;
  13
  14 # This simulates a multipart POST request with a file upload.
  15 my $tcm = new Test::CGI::Multipart;
  16 $tcm->upload_file(
  17     name => 'testfile',
  18     file => 'testfilename.txt',
  19     value => "This is the content of testfilename.txt",
  20 );
  21 my $cgi = $tcm->create_cgi;
  22
  23 my $tempdir = tempdir(CLEANUP => 1);
  24 t::lib::Mocks::mock_config('upload_path', $tempdir);
  25
  26 my $testfilename = $cgi->param('testfile');
  27 my $testfile_fh = $cgi->upload('testfile');
  28 my $id = C4::UploadedFiles::UploadFile($testfilename, '', $testfile_fh->handle);
  29 ok($id, "File uploaded, id is $id");
  30
  31 my $file = C4::UploadedFiles::GetUploadedFile($id);
  32 isa_ok($file, 'HASH', "GetUploadedFiles($id)");
  33 foreach my $key (qw(hashvalue filename filepath dir)) {
  34     ok(exists $file->{$key}, "GetUploadedFile($id)->{$key} exists");
  35 }
  36
  37 ok(-e $file->{filepath}, "File $file->{filepath} exists");
  38
  39 ok(C4::UploadedFiles::DanglingEntry()==-1, "DanglingEntry() returned -1 as expected.");
  40 ok(C4::UploadedFiles::DanglingEntry($id)==0, "DanglingEntry($id) returned 0 as expected.");
  41 unlink ($file->{filepath});
  42 ok(C4::UploadedFiles::DanglingEntry($id)==1, "DanglingEntry($id) returned 1 as expected.");
  43
  44 open my $fh,">",($file->{filepath});
  45 print $fh "";
  46 close $fh;
  47
  48 my $DelResult;
  49 is(C4::UploadedFiles::DelUploadedFile($id),1, "DelUploadedFile($id) returned 1 as expected.");
  50 warning_like { $DelResult=C4::UploadedFiles::DelUploadedFile($id); } qr/file for hash/, "Expected warning for deleting Dangling Entry.";
  51 is($DelResult,-1, "DelUploadedFile($id) returned -1 as expected.");
  52 ok(! -e $file->{filepath}, "File $file->{filepath} does not exist anymore");
  53
  54 my $UploadResult;
  55 warning_like { $UploadResult=C4::UploadedFiles::UploadFile($testfilename,'../',$testfile_fh->handle); } qr/^Filename or dirname contains '..'. Aborting upload/, "Expected warning for bad file upload.";
  56 is($UploadResult, undef, "UploadFile with dir containing \"..\" return undef");
  57 is(C4::UploadedFiles::GetUploadedFile(), undef, 'GetUploadedFile without parameters returns undef');
  58
  59 #trivial test for httpheaders
  60 my @hdrs = C4::UploadedFiles::httpheaders('does_not_matter_yet');
  61 is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders'); #TODO Will be extended on report 14282