Bug 6874: [QA Follow-up] Adjustments for opac-retrieve
Adds httpheaders sub to UploadedFiles; this will be extended on a new report. (Idea is to add configurable headers for file extensions.) Trivial unit test added. Small cosmetic changes to opac-retrieve-file. Test plan: Run test UploadedFiles.t Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl> Signed-off-by: Tomas Cohen Arazi <tomascohen@unc.edu.ar>
This commit is contained in:
parent
b113318bb2
commit
d7cdb6e15e
3 changed files with 25 additions and 17 deletions
|
@ -290,4 +290,18 @@ sub DelUploadedFile {
|
||||||
return $retval;
|
return $retval;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
=head2 httpheaders
|
||||||
|
|
||||||
|
httpheaders returns http headers for a retrievable upload
|
||||||
|
Will be extended by report 14282
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub httpheaders {
|
||||||
|
my $file= shift;
|
||||||
|
return
|
||||||
|
( '-type' => 'application/octet-stream',
|
||||||
|
'-attachment' => $file, );
|
||||||
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
|
@ -27,21 +27,11 @@ my $input = new CGI;
|
||||||
|
|
||||||
my $id = $input->param('id');
|
my $id = $input->param('id');
|
||||||
my $file = C4::UploadedFiles::GetUploadedFile($id);
|
my $file = C4::UploadedFiles::GetUploadedFile($id);
|
||||||
exit 1 if not $file;
|
exit 1 if !$file || !-f $file->{filepath};
|
||||||
|
|
||||||
my $file_path = $file->{filepath};
|
open my $fh, '<', $file->{filepath} or die "Can't open file: $!";
|
||||||
|
print $input->header( C4::UploadedFiles::httpheaders( $file->{filename} ));
|
||||||
if( -f $file_path ) {
|
while(<$fh>) {
|
||||||
open my $fh, '<', $file_path or die "Can't open file: $!";
|
print $_;
|
||||||
print $input->header(
|
|
||||||
-type => "application/octet-stream",
|
|
||||||
-attachment => $file->{filename}
|
|
||||||
);
|
|
||||||
while(<$fh>) {
|
|
||||||
print $_;
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
exit 1;
|
|
||||||
}
|
}
|
||||||
|
close $fh;
|
||||||
exit 0;
|
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
use Modern::Perl;
|
use Modern::Perl;
|
||||||
use File::Temp qw/ tempdir /;
|
use File::Temp qw/ tempdir /;
|
||||||
use Test::CGI::Multipart;
|
use Test::CGI::Multipart;
|
||||||
use Test::More tests => 17;
|
use Test::More tests => 18;
|
||||||
use Test::Warn;
|
use Test::Warn;
|
||||||
|
|
||||||
use t::lib::Mocks;
|
use t::lib::Mocks;
|
||||||
|
@ -55,3 +55,7 @@ my $UploadResult;
|
||||||
warning_like { $UploadResult=C4::UploadedFiles::UploadFile($testfilename,'../',$testfile_fh->handle); } qr/^Filename or dirname contains '..'. Aborting upload/, "Expected warning for bad file upload.";
|
warning_like { $UploadResult=C4::UploadedFiles::UploadFile($testfilename,'../',$testfile_fh->handle); } qr/^Filename or dirname contains '..'. Aborting upload/, "Expected warning for bad file upload.";
|
||||||
is($UploadResult, undef, "UploadFile with dir containing \"..\" return undef");
|
is($UploadResult, undef, "UploadFile with dir containing \"..\" return undef");
|
||||||
is(C4::UploadedFiles::GetUploadedFile(), undef, 'GetUploadedFile without parameters returns undef');
|
is(C4::UploadedFiles::GetUploadedFile(), undef, 'GetUploadedFile without parameters returns undef');
|
||||||
|
|
||||||
|
#trivial test for httpheaders
|
||||||
|
my @hdrs = C4::UploadedFiles::httpheaders('does_not_matter_yet');
|
||||||
|
is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders'); #TODO Will be extended on report 14282
|
||||||
|
|
Loading…
Reference in a new issue