X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=tools%2Fpicture-upload.pl;h=b2aa18a89c7ce9fb21ecdec02f4ccebf6c5361a2;hb=01c101a6b9b60b685abca58fddfccb1087b4dbce;hp=d5b36b16a0ca3fabce0547025a701cb832121d51;hpb=04c4be5b487a85a3a3c5bc767bd5c1a148429539;p=koha_fer diff --git a/tools/picture-upload.pl b/tools/picture-upload.pl index d5b36b16a0..b2aa18a89c 100755 --- a/tools/picture-upload.pl +++ b/tools/picture-upload.pl @@ -19,6 +19,9 @@ # # +#use strict; +#use warnings; FIXME - Bug 2505 + use File::Temp; use File::Copy; use CGI; @@ -55,7 +58,7 @@ $debug and warn "Params are: filetype=$filetype, cardnumber=$cardnumber, borrowe =head1 NAME -picture-upload.p. - Script for handling uploading of both single and bulk patronimages and importing them into the database. +picture-upload.pl - Script for handling uploading of both single and bulk patronimages and importing them into the database. =head1 SYNOPSIS @@ -75,7 +78,10 @@ my ( $total, $handled, @counts, $tempfile, $tfh ); 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); $debug and warn "dirname = $dirname"; - my $filesuffix = $1 if $uploadfilename =~ m/(\..+)$/i; + my $filesuffix; + if ( $uploadfilename =~ m/(\..+)$/i ) { + $filesuffix = $1; + } ( $tfh, $tempfile ) = File::Temp::tempfile( SUFFIX => $filesuffix, UNLINK => 1 ); $debug and warn "tempfile = $tempfile"; my ( @directories, $errors ); @@ -92,7 +98,7 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope } close $tfh; if ( $filetype eq 'zip' ) { - unless (system("unzip $tempfile -d $dirname") == 0) { + unless (system("unzip", $tempfile, '-d', $dirname) == 0) { $errors{'UZIPFAIL'} = $uploadfilename; $template->param( ERRORS => [ \%errors ] ); output_html_with_http_headers $input, $cookie, $template->output; # This error is fatal to the import, so bail out here @@ -104,17 +110,17 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope while ( my $entry = readdir $dir ) { push @directories, "$recursive_dir/$entry" if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ ); $debug and warn "$recursive_dir/$entry"; - } + } closedir $dir; - } + } my $results; foreach my $dir ( @directories ) { - $results = handle_dir( $dir, $filesuffix ); + $results = handle_dir( $dir, $filesuffix, $template ); $handled++ if $results == 1; } $total = scalar @directories; } else { #if ($filetype eq 'zip' ) - $results = handle_dir( $dirname, $filesuffix ); + $results = handle_dir( $dirname, $filesuffix, $template, $cardnumber, $tempfile ); $handled = 1; $total = 1; } @@ -133,14 +139,14 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope TCOUNTS => ($filecount > 0 ? $filecount : undef), ); $template->param( borrowernumber => $borrowernumber ) if $borrowernumber; - } + } } } elsif ( ($op eq 'Upload') && !$uploadfile ) { warn "Problem uploading file or no file uploaded."; $template->param(cardnumber => $cardnumber); $template->param(filetype => $filetype); } elsif ( $op eq 'Delete' ) { - my $dberror = RmPatronImage($cardnumber); + my $dberror = RmPatronImage($borrowernumber); $debug and warn "Patron image deleted for $cardnumber"; warn "Database returned $dberror" if $dberror; } @@ -151,17 +157,17 @@ if ( $borrowernumber && !$errors && !$template->param('ERRORS') ) { } sub handle_dir { - my ( $dir, $suffix ) = @_; - my $source; + my ( $dir, $suffix, $template, $cardnumber, $source ) = @_; $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 ); + 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 ) { $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!"; $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 @@ -183,20 +189,19 @@ sub handle_dir { $filename =~ s/[\"\r\n\s]//g; $debug and warn "Cardnumber: $cardnumber Filename: $filename"; $source = "$dir/$filename"; - %counts = handle_file($cardnumber, $source, %counts); + %counts = handle_file($cardnumber, $source, $template, %counts); } close FILE; closedir ($dirhandle); } else { - $source = $tempfile; - %counts = handle_file($cardnumber, $source, %counts); + %counts = handle_file($cardnumber, $source, $template, %counts); } push @counts, \%counts; return 1; } sub handle_file { - my ($cardnumber, $source, %count) = @_; + my ($cardnumber, $source, $template, %count) = @_; $debug and warn "Entering sub handle_file; passed \$cardnumber=$cardnumber, \$source=$source"; $count{filenames} = () if !$count{filenames}; $count{source} = $source if !$count{source}; @@ -210,7 +215,7 @@ sub handle_file { } $debug and warn "Source: $source"; my $size = (stat($source))[7]; - if ($size > 100000) { # 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... $filerrors{'OVRSIZ'} = 1; push my @filerrors, \%filerrors; push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber }; @@ -222,14 +227,14 @@ sub handle_file { $srcimage = GD::Image->new(*IMG); close (IMG); if (defined $srcimage) { - my $mimetype = 'image/jpeg'; # GD autodetects three basic image formats: PNG, JPEG, XPM; we will convert all to JPEG... + 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(); $debug and warn "$filename is $width pix X $height pix."; - if ($width > 140 || $height > 200) { # MAX pixel dims are 140 X 200... - $debug and warn "$filename exceeds the maximum pixel dimensions of 140 X 200. Resizing..."; + if ($width > 200 || $height > 300) { # MAX pixel dims are 200 X 300... + $debug and warn "$filename exceeds the maximum pixel dimensions of 200 X 300. Resizing..."; my $percent_reduce; # Percent we will reduce the image dimensions by... - if ($width > 140) { + if ($width > 200) { $percent_reduce = sprintf("%.5f",(140/$width)); # If the width is oversize, scale based on width overage... } else { $percent_reduce = sprintf("%.5f",(200/$height)); # otherwise scale based on height overage. @@ -239,20 +244,23 @@ sub handle_file { $debug and warn "Reducing $filename by " . ($percent_reduce * 100) . "\% or to $width_reduce pix X $height_reduce pix"; $image = GD::Image->new($width_reduce, $height_reduce, 1); #'1' creates true color image... $image->copyResampled($srcimage,0,0,0,0,$width_reduce,$height_reduce,$width,$height); - $imgfile = $image->jpeg(100); + $imgfile = $image->png(); $debug and warn "$filename is " . length($imgfile) . " bytes after resizing."; undef $image; undef $srcimage; # This object can get big... } else { $image = $srcimage; - $imgfile = $image->jpeg(); + $imgfile = $image->png(); $debug and warn "$filename is " . length($imgfile) . " bytes."; undef $image; undef $srcimage; # This object can get big... } $debug and warn "Image is of mimetype $mimetype"; - my $dberror = PutPatronImage($cardnumber,$mimetype, $imgfile) if $mimetype; - if ( !$dberror && $mimetype ) { # Errors from here on are fatal only to the import of a particular image, so don't bail, just note the error and keep going + my $dberror; + if ($mimetype) { + $dberror = PutPatronImage( $cardnumber, $mimetype, $imgfile ); + } + if ( !$dberror && $mimetype ) { # Errors from here on are fatal only to the import of a particular image, so don't bail, just note the error and keep going $count{count}++; push @{ $count{filenames} }, { source => $filename, cardnumber => $cardnumber }; } elsif ( $dberror ) { @@ -285,7 +293,7 @@ sub handle_file { } } else { # The need for this seems a bit unlikely, however, to maximize error trapping it is included warn "Missing " . ($cardnumber ? "filename" : ($filename ? "cardnumber" : "cardnumber and filename")); - $filerrors{'CRDFIL'} = ($cardnumber ? "filename" : ($filename ? "cardnumber" : "cardnumber and filename")); + $filerrors{'CRDFIL'} = ($cardnumber ? "filename" : ($filename ? "cardnumber" : "cardnumber and filename")); push my @filerrors, \%filerrors; push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber }; $template->param( ERRORS => 1 ); @@ -293,8 +301,6 @@ sub handle_file { return (%count); } -=back - =head1 AUTHORS Original contributor(s) undocumented