From 1a0d425c7ccd48c3c173e499e3b66c9b5c3ed8e5 Mon Sep 17 00:00:00 2001
From: Fridolyn SOMERS <fridolyn.somers@biblibre.com>
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: Chris Cormack <chris@bigballofwax.co.nz>
---
 tools/picture-upload.pl | 59 +++++++++++++++++++++++++------------------------
 1 file changed, 30 insertions(+), 29 deletions(-)

diff --git a/tools/picture-upload.pl b/tools/picture-upload.pl
index eae06cb..fa1ae34 100755
--- a/tools/picture-upload.pl
+++ b/tools/picture-upload.pl
@@ -19,8 +19,7 @@
 #
 #
 
-#use strict;
-#use warnings; FIXME - Bug 2505
+use Modern::Perl;
 
 use File::Temp;
 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";
 
-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!
     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 );
     $debug and warn "tempfile = $tempfile";
-    my ( @directories, $errors );
+    my ( @directories, $results );
 
     $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 $_;
         }
@@ -105,15 +106,14 @@ if ( ($op eq 'Upload') && $uploadfile ) {       # Case is important in these ope
                 exit;
             }
             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, $template );
                 $handled++ if $results == 1;
@@ -126,7 +126,7 @@ if ( ($op eq 'Upload') && $uploadfile ) {       # Case is important in these ope
         }
 
         if ( %$results || %errors ) {
-            $template->param( ERRORS => [ \%$results ] );
+            $template->param( ERRORS => [ $results ] );
         } else {
 			my $filecount;
 			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;
         }
-    }
 } elsif ( ($op eq 'Upload') && !$uploadfile ) {
     warn "Problem uploading file or no file uploaded.";
     $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";
     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;
@@ -158,19 +157,20 @@ if ( $borrowernumber && !$errors && !$template->param('ERRORS') ) {
 
 sub handle_dir {
     my ( $dir, $suffix, $template, $cardnumber, $source ) = @_;
+    my ( %counts, %direrrors );
     $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 );
         undef $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
+                $direrrors{'OPNLINK'} = $file;
+		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>) {
@@ -181,8 +181,8 @@ sub handle_dir {
             $debug and warn "Delimeter is \'$delim\'";
             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;
+                $direrrors{'DELERR'} = 1;      # This error is fatal to the import of this directory contents, so bail and return the error to the caller
+                return \%direrrors;
             }
 	    ($cardnumber, $filename) = split $delim, $line;
 	    $cardnumber =~ s/[\"\r\n]//g;  # remove offensive characters
@@ -192,7 +192,7 @@ sub handle_dir {
             %counts = handle_file($cardnumber, $source, $template, %counts);
         }
         close FILE;
-        closedir ($dirhandle);
+        closedir DIR;
     } else {
         %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";
     $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...
@@ -227,6 +227,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();
@@ -285,7 +286,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 };
-- 
2.1.0