From 9ce2f0730f1b6f8ea8f4a7c6827e38a82feaa240 Mon Sep 17 00:00:00 2001 From: Fridolyn SOMERS Date: Fri, 21 Dec 2012 14:31:52 +0100 Subject: [PATCH] Bug 9312: strict perl for picture-upload.pl 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: Galen Charlton --- tools/picture-upload.pl | 67 ++++++++++++++++++++++++---------------------- 1 files changed, 35 insertions(+), 32 deletions(-) diff --git a/tools/picture-upload.pl b/tools/picture-upload.pl index 4507fa1..fcebec6 100755 --- a/tools/picture-upload.pl +++ b/tools/picture-upload.pl @@ -19,8 +19,8 @@ # # -#use strict; -#use warnings; FIXME - Bug 2505 +use strict; +use warnings; use File::Temp; use File::Copy; @@ -74,6 +74,7 @@ Files greater than 100K will be refused. Images should be 140x200 pixels. If the $debug and warn "Operation requested: $op"; my ( $total, $handled, @counts, $tempfile, $tfh ); +my %errors; 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); @@ -84,15 +85,16 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope } ( $tfh, $tempfile ) = File::Temp::tempfile( SUFFIX => $filesuffix, UNLINK => 1 ); $debug and warn "tempfile = $tempfile"; - my ( @directories, $errors ); $errors{'NOTZIP'} = 1 if ( $uploadfilename !~ /\.zip$/i && $filetype =~ m/zip/i ); $errors{'NOWRITETEMP'} = 1 unless ( -w $dirname ); $errors{'EMPTYUPLOAD'} = 1 unless ( length( $uploadfile ) > 0 ); if ( %errors ) { - $template->param( ERRORS => [ \%errors ] ); - } else { + $template->param( ERRORS => [ \%errors ] ); + output_html_with_http_headers $input, $cookie, $template->output; + exit; + } while ( <$uploadfile> ) { print $tfh $_; } @@ -104,29 +106,29 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope output_html_with_http_headers $input, $cookie, $template->output; # This error is fatal to the import, so bail out here exit; } + my @directories; push @directories, "$dirname"; - foreach $recursive_dir ( @directories ) { - opendir $dir, $recursive_dir; - while ( my $entry = readdir $dir ) { + foreach my $recursive_dir ( @directories ) { + opendir RECDIR, $recursive_dir; + while ( my $entry = readdir RECDIR ) { push @directories, "$recursive_dir/$entry" if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ ); $debug and warn "$recursive_dir/$entry"; } - closedir $dir; + closedir RECDIR; } - my $results; foreach my $dir ( @directories ) { - $results = handle_dir( $dir, $filesuffix ); - $handled++ if $results == 1; + my $result = handle_dir( $dir, $filesuffix ); + $handled++ if $result == 1; } $total = scalar @directories; - } else { #if ($filetype eq 'zip' ) - $results = handle_dir( $dirname, $filesuffix ); - $handled = 1; + } else { + my $result = handle_dir( $dirname, $filesuffix ); + $handled = 1 if $result; $total = 1; } - if ( %$results || %errors ) { - $template->param( ERRORS => [ \%$results ] ); + if ( %errors ) { + $template->param( ERRORS => [ \%errors ] ); } else { my $filecount; map {$filecount += $_->{count}} @counts; @@ -140,7 +142,6 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope ); $template->param( borrowernumber => $borrowernumber ) if $borrowernumber; } - } } elsif ( ($op eq 'Upload') && !$uploadfile ) { warn "Problem uploading file or no file uploaded."; $template->param(cardnumber => $cardnumber); @@ -150,7 +151,7 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope $debug and warn "Patron image deleted for $cardnumber"; 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"); } else { output_html_with_http_headers $input, $cookie, $template->output; @@ -159,18 +160,19 @@ if ( $borrowernumber && !$errors && !$template->param('ERRORS') ) { sub handle_dir { my ( $dir, $suffix ) = @_; my $source; + my %counts; $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 my ( $file, $filename, $cardnumber ); $debug and warn "Passed a zip file."; - opendir my $dirhandle, $dir; - while ( my $filename = readdir $dirhandle ) { + opendir DIR, $dir; + while ( my $filename = readdir DIR ) { $file = "$dir/$filename" if ($filename =~ m/datalink\.txt/i || $filename =~ m/idlink\.txt/i); } unless (open (FILE, $file)) { warn "Opening $dir/$file failed!"; $errors{'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; # This error is fatal to the import of this directory contents, so bail and return the error to the caller }; while (my $line = ) { @@ -182,7 +184,7 @@ sub handle_dir { unless ( $delim eq "," || $delim eq "\t" ) { 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 - return $errors; + return; } ($cardnumber, $filename) = split $delim, $line; $cardnumber =~ s/[\"\r\n]//g; # remove offensive characters @@ -192,7 +194,7 @@ sub handle_dir { %counts = handle_file($cardnumber, $source, %counts); } close FILE; - closedir ($dirhandle); + closedir DIR; } else { $source = $tempfile; %counts = handle_file($cardnumber, $source, %counts); @@ -206,14 +208,14 @@ sub handle_file { $debug and warn "Entering sub handle_file; passed \$cardnumber=$cardnumber, \$source=$source"; $count{filenames} = () if !$count{filenames}; $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 - my %filerrors; - my $filename; - if ($filetype eq 'image') { - $filename = $uploadfilename; - } else { - $filename = $1 if ($source =~ /\/([^\/]+)$/); - } $debug and warn "Source: $source"; my $size = (stat($source))[7]; if ($size > 550000) { # This check is necessary even with image resizing to avoid possible security/performance issues... @@ -228,6 +230,7 @@ sub handle_file { $srcimage = GD::Image->new(*IMG); close (IMG); 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... # Check the pixel size of the image we are about to import... my ($width, $height) = $srcimage->getBounds(); @@ -286,7 +289,7 @@ sub handle_file { $template->param( ERRORS => 1 ); } } else { - warn "Opening $dir/$filename failed!"; + warn "Opening $source failed!"; $filerrors{'OPNERR'} = 1; push my @filerrors, \%filerrors; push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber }; -- 1.7.2.5