Koha-community/Koha
13
7
Fork 0
Code Issues Releases Wiki Activity

Bug 9312: strict perl for picture-upload.pl

Browse source 
Testing - this is a code-cleanup patch, so the purpose
of testing is to ensure that patron image upload functionality
still works.  To test:

- Turn on the patronimages system preference
- Go to Tools | Upload patron images and import a suitable image
  for a test patron.
- Bring up the test patron and verify that the image is attached.
- From the patron details page, upload a replacement image.
- Create a patron image ZIP file containing at least two images (
  per the documentation of the patron image feature) and load it
  via the patron image import tool.
- Verfiy that the test patrons now have images.
- Verify that tools/picture-upload.pl didn't report any errors
  in the Apache error log.

Signed-off-by: Chris Cormack <chris@bigballofwax.co.nz>

Signed-off-by: Katrin Fischer <katrin.fischer.83@web.de>
Signed-off-by: Tomas Cohen Arazi <tomascohen@gmail.com>
This commit is contained in:
Fridolyn SOMERS 2012-12-21 14:31:52 +01:00 committed by Tomas Cohen Arazi
parent 1fc8916e2e
commit 696c9feee2
1 changed files with 30 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

59
tools/picture-upload.pl
View file

@ -19,8 +19,7 @@
# #
# #
#use strict; use Modern::Perl;
#use warnings; FIXME - Bug 2505
use File::Temp; use File::Temp;
use File::Copy; use File::Copy;
@ -73,7 +72,7 @@ Files greater than 100K will be refused. Images should be 140x200 pixels. If the
$debug and warn "Operation requested: $op"; $debug and warn "Operation requested: $op";
my ( $total, $handled, @counts, $tempfile, $tfh ); my ( $total, $handled, @counts, $tempfile, $tfh, %errors );
if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these operational values as the template must use case to be visually pleasing! if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these operational values as the template must use case to be visually pleasing!
my $dirname = File::Temp::tempdir( CLEANUP => 1); my $dirname = File::Temp::tempdir( CLEANUP => 1);
@ -84,15 +83,17 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope
} }
( $tfh, $tempfile ) = File::Temp::tempfile( SUFFIX => $filesuffix, UNLINK => 1 ); ( $tfh, $tempfile ) = File::Temp::tempfile( SUFFIX => $filesuffix, UNLINK => 1 );
$debug and warn "tempfile = $tempfile"; $debug and warn "tempfile = $tempfile";
my ( @directories, $errors ); my ( @directories, $results );
$errors{'NOTZIP'} = 1 if ( $uploadfilename !~ /\.zip$/i && $filetype =~ m/zip/i ); $errors{'NOTZIP'} = 1 if ( $uploadfilename !~ /\.zip$/i && $filetype =~ m/zip/i );
$errors{'NOWRITETEMP'} = 1 unless ( -w $dirname ); $errors{'NOWRITETEMP'} = 1 unless ( -w $dirname );
$errors{'EMPTYUPLOAD'} = 1 unless ( length( $uploadfile ) > 0 ); $errors{'EMPTYUPLOAD'} = 1 unless ( length( $uploadfile ) > 0 );
if ( %errors ) { if ( %errors ) {
$template->param( ERRORS => [ \%errors ] ); $template->param( ERRORS => [ \%errors ] );
} else { output_html_with_http_headers $input, $cookie, $template->output;
exit;
}
while ( <$uploadfile> ) { while ( <$uploadfile> ) {
print $tfh $_; print $tfh $_;
} }
@ -105,15 +106,14 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope
exit; exit;
} }
push @directories, "$dirname"; push @directories, "$dirname";
foreach $recursive_dir ( @directories ) { foreach my $recursive_dir ( @directories ) {
opendir $dir, $recursive_dir; opendir RECDIR, $recursive_dir;
while ( my $entry = readdir $dir ) { while ( my $entry = readdir RECDIR ) {
push @directories, "$recursive_dir/$entry" if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ ); push @directories, "$recursive_dir/$entry" if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ );
$debug and warn "$recursive_dir/$entry"; $debug and warn "$recursive_dir/$entry";
} }
closedir $dir; closedir RECDIR;
} }
my $results;
foreach my $dir ( @directories ) { foreach my $dir ( @directories ) {
$results = handle_dir( $dir, $filesuffix, $template ); $results = handle_dir( $dir, $filesuffix, $template );
$handled++ if $results == 1; $handled++ if $results == 1;
@ -126,7 +126,7 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope
} }
if ( %$results || %errors ) { if ( %$results || %errors ) {
$template->param( ERRORS => [ \%$results ] ); $template->param( ERRORS => [ $results ] );
} else { } else {
my $filecount; my $filecount;
map {$filecount += $_->{count}} @counts; map {$filecount += $_->{count}} @counts;
@ -140,7 +140,6 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope
); );
$template->param( borrowernumber => $borrowernumber ) if $borrowernumber; $template->param( borrowernumber => $borrowernumber ) if $borrowernumber;
} }
}
} elsif ( ($op eq 'Upload') && !$uploadfile ) { } elsif ( ($op eq 'Upload') && !$uploadfile ) {
warn "Problem uploading file or no file uploaded."; warn "Problem uploading file or no file uploaded.";
$template->param(cardnumber => $cardnumber); $template->param(cardnumber => $cardnumber);
@ -150,7 +149,7 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope
$debug and warn "Patron image deleted for $cardnumber"; $debug and warn "Patron image deleted for $cardnumber";
warn "Database returned $dberror" if $dberror; warn "Database returned $dberror" if $dberror;
} }
if ( $borrowernumber && !$errors && !$template->param('ERRORS') ) { if ( $borrowernumber && !%errors && !$template->param('ERRORS') ) {
print $input->redirect ("/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber"); print $input->redirect ("/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber");
} else { } else {
output_html_with_http_headers $input, $cookie, $template->output; output_html_with_http_headers $input, $cookie, $template->output;
@ -158,19 +157,20 @@ if ( $borrowernumber && !$errors && !$template->param('ERRORS') ) {
sub handle_dir { sub handle_dir {
my ( $dir, $suffix, $template, $cardnumber, $source ) = @_; my ( $dir, $suffix, $template, $cardnumber, $source ) = @_;
my ( %counts, %direrrors );
$debug and warn "Entering sub handle_dir; passed \$dir=$dir, \$suffix=$suffix"; $debug and warn "Entering sub handle_dir; passed \$dir=$dir, \$suffix=$suffix";
if ($suffix =~ m/zip/i) { # If we were sent a zip file, process any included data/idlink.txt files if ($suffix =~ m/zip/i) { # If we were sent a zip file, process any included data/idlink.txt files
my ( $file, $filename ); my ( $file, $filename );
undef $cardnumber; undef $cardnumber;
$debug and warn "Passed a zip file."; $debug and warn "Passed a zip file.";
opendir my $dirhandle, $dir; opendir DIR, $dir;
while ( my $filename = readdir $dirhandle ) { while ( my $filename = readdir DIR ) {
$file = "$dir/$filename" if ($filename =~ m/datalink\.txt/i || $filename =~ m/idlink\.txt/i); $file = "$dir/$filename" if ($filename =~ m/datalink\.txt/i || $filename =~ m/idlink\.txt/i);
} }
unless (open (FILE, $file)) { unless (open (FILE, $file)) {
warn "Opening $dir/$file failed!"; warn "Opening $dir/$file failed!";
$errors{'OPNLINK'} = $file; $direrrors{'OPNLINK'} = $file;
return $errors; # This error is fatal to the import of this directory contents, so bail and return the error to the caller return \%direrrors; # This error is fatal to the import of this directory contents, so bail and return the error to the caller
}; };
while (my $line = <FILE>) { while (my $line = <FILE>) {
@ -181,8 +181,8 @@ sub handle_dir {
$debug and warn "Delimeter is \'$delim\'"; $debug and warn "Delimeter is \'$delim\'";
unless ( $delim eq "," || $delim eq "\t" ) { unless ( $delim eq "," || $delim eq "\t" ) {
warn "Unrecognized or missing field delimeter. Please verify that you are using either a ',' or a 'tab'"; warn "Unrecognized or missing field delimeter. Please verify that you are using either a ',' or a 'tab'";
$errors{'DELERR'} = 1; # This error is fatal to the import of this directory contents, so bail and return the error to the caller $direrrors{'DELERR'} = 1; # This error is fatal to the import of this directory contents, so bail and return the error to the caller
return $errors; return \%direrrors;
} }
($cardnumber, $filename) = split $delim, $line; ($cardnumber, $filename) = split $delim, $line;
$cardnumber =~ s/[\"\r\n]//g; # remove offensive characters $cardnumber =~ s/[\"\r\n]//g; # remove offensive characters
@ -192,7 +192,7 @@ sub handle_dir {
%counts = handle_file($cardnumber, $source, $template, %counts); %counts = handle_file($cardnumber, $source, $template, %counts);
} }
close FILE; close FILE;
closedir ($dirhandle); closedir DIR;
} else { } else {
%counts = handle_file($cardnumber, $source, $template, %counts); %counts = handle_file($cardnumber, $source, $template, %counts);
} }
@ -205,14 +205,14 @@ sub handle_file {
$debug and warn "Entering sub handle_file; passed \$cardnumber=$cardnumber, \$source=$source"; $debug and warn "Entering sub handle_file; passed \$cardnumber=$cardnumber, \$source=$source";
$count{filenames} = () if !$count{filenames}; $count{filenames} = () if !$count{filenames};
$count{source} = $source if !$count{source}; $count{source} = $source if !$count{source};
my %filerrors;
my $filename;
if ($filetype eq 'image') {
$filename = $uploadfilename;
} else {
$filename = $1 if ($source && $source =~ /\/([^\/]+)$/);
}
if ($cardnumber && $source) { # Now process any imagefiles if ($cardnumber && $source) { # Now process any imagefiles
my %filerrors;
my $filename;
if ($filetype eq 'image') {
$filename = $uploadfilename;
} else {
$filename = $1 if ($source =~ /\/([^\/]+)$/);
}
$debug and warn "Source: $source"; $debug and warn "Source: $source";
my $size = (stat($source))[7]; my $size = (stat($source))[7];
if ($size > 550000) { # This check is necessary even with image resizing to avoid possible security/performance issues... if ($size > 550000) { # This check is necessary even with image resizing to avoid possible security/performance issues...
@ -227,6 +227,7 @@ sub handle_file {
$srcimage = GD::Image->new(*IMG); $srcimage = GD::Image->new(*IMG);
close (IMG); close (IMG);
if (defined $srcimage) { if (defined $srcimage) {
my $imgfile;
my $mimetype = 'image/png'; # GD autodetects three basic image formats: PNG, JPEG, XPM; we will convert all to PNG which is lossless... my $mimetype = 'image/png'; # GD autodetects three basic image formats: PNG, JPEG, XPM; we will convert all to PNG which is lossless...
# Check the pixel size of the image we are about to import... # Check the pixel size of the image we are about to import...
my ($width, $height) = $srcimage->getBounds(); my ($width, $height) = $srcimage->getBounds();
@ -285,7 +286,7 @@ sub handle_file {
$template->param( ERRORS => 1 ); $template->param( ERRORS => 1 );
} }
} else { } else {
warn "Opening $dir/$filename failed!"; warn "Opening $source failed!";
$filerrors{'OPNERR'} = 1; $filerrors{'OPNERR'} = 1;
push my @filerrors, \%filerrors; push my @filerrors, \%filerrors;
push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber }; push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber };