X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=tools%2Fpicture-upload.pl;h=bfb233e6e25c97b540d86459d655f04291fa118c;hb=3414c117cdbe983c9c4dd8cbf3843bd5419bd0d8;hp=68684fbee0f196fa5da3290fbe662bb9830a0c3e;hpb=fc6ccb1a616c96e8cddf57efd2195a0bec7bc976;p=koha_fer diff --git a/tools/picture-upload.pl b/tools/picture-upload.pl index 68684fbee0..bfb233e6e2 100755 --- a/tools/picture-upload.pl +++ b/tools/picture-upload.pl @@ -19,16 +19,18 @@ # # +#use strict; +#use warnings; FIXME - Bug 2505 + use File::Temp; use File::Copy; use CGI; -use Image::Magick; +use GD; use C4::Context; use C4::Auth; use C4::Output; use C4::Members; use C4::Debug; -#use Data::Dumper; my $input = new CGI; @@ -37,7 +39,7 @@ my ($template, $loggedinuser, $cookie) query => $input, type => "intranet", authnotrequired => 0, - flagsrequired => {management => 1, tools => 'batch_upload_patron_images'}, + flagsrequired => { tools => 'batch_upload_patron_images'}, debug => 0, }); @@ -52,11 +54,11 @@ my $op = $input->param('op'); # Other parts of this code could be optimized as well, I think. Perhaps the file upload could be done with YUI's upload # coded. -fbcit -$debug and warn "Params are: filetype=$filetype, cardnumber=$cardnumber, uploadfile=$uploadfilename"; +$debug and warn "Params are: filetype=$filetype, cardnumber=$cardnumber, borrowernumber=$borrowernumber, uploadfile=$uploadfilename"; =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 @@ -76,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 ) { + my $filesuffix = $1; + } ( $tfh, $tempfile ) = File::Temp::tempfile( SUFFIX => $filesuffix, UNLINK => 1 ); $debug and warn "tempfile = $tempfile"; my ( @directories, $errors ); @@ -91,10 +96,9 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope while ( <$uploadfile> ) { print $tfh $_; } - 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 @@ -106,9 +110,9 @@ 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 ); @@ -124,15 +128,18 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope if ( %$results || %errors ) { $template->param( ERRORS => [ \%$results ] ); } else { - $debug and warn "Total files processed: $total"; - warn "Errors in \$errors." if $errors; + my $filecount; + map {$filecount += $_->{count}} @counts; + $debug and warn "Total directories processed: $total"; + $debug and warn "Total files processed: $filecount"; $template->param( - TOTAL => $total, - HANDLED => $handled, - COUNTS => \@counts, - TCOUNTS => scalar(@counts), + TOTAL => $total, + HANDLED => $handled, + COUNTS => \@counts, + TCOUNTS => ($filecount > 0 ? $filecount : undef), ); - } + $template->param( borrowernumber => $borrowernumber ) if $borrowernumber; + } } } elsif ( ($op eq 'Upload') && !$uploadfile ) { warn "Problem uploading file or no file uploaded."; @@ -140,11 +147,9 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope $template->param(filetype => $filetype); } elsif ( $op eq 'Delete' ) { my $dberror = RmPatronImage($cardnumber); + $debug and warn "Patron image deleted for $cardnumber"; warn "Database returned $dberror" if $dberror; -} elsif ( $op eq 'Cancel' ) { - print $input->redirect ("/cgi-bin/koha/tools/picture-upload.pl"); } - if ( $borrowernumber && !$errors && !$template->param('ERRORS') ) { print $input->redirect ("/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber"); } else { @@ -155,14 +160,14 @@ sub handle_dir { my ( $dir, $suffix ) = @_; my $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 + 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 ) { $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 @@ -211,76 +216,92 @@ 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... - warn "$filename is TOO BIG!!! I refuse to beleagur my database with that much data. Try reducing the pixel dimensions and I\'ll reconsider."; + 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 }; $template->param( ERRORS => 1 ); return %count; # this one is fatal so bail here... } - my $image = Image::Magick->new; + my ($srcimage, $image); if (open (IMG, "$source")) { - $image->Read(file=>\*IMG); + $srcimage = GD::Image->new(*IMG); close (IMG); - my $mimetype = $image->Get('mime'); - # Check the pixel size of the image we are about to import... - my ($height, $width) = $image->Get('height', 'width'); - $debug and warn "$filename is $width pix X $height pix."; - if ($width > 140 || $height > 200) { # MAX pixel dims are 140 X 200... - warn "$filename exceeds the maximum pixel dimensions of 140 X 200. Resizing..."; - my $percent_reduce; # Percent we will reduce the image dimensions by... - if ($width > 140) { - $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. + if (defined $srcimage) { + 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 > 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 > 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. + } + my $width_reduce = sprintf("%.0f", ($width * $percent_reduce)); + my $height_reduce = sprintf("%.0f", ($height * $percent_reduce)); + $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->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->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; + if ($mimetype) { + $dberror = PutPatronImage( $cardnumber, $mimetype, $imgfile ); } - my $width_reduce = sprintf("%.0f", ($width * $percent_reduce)); - my $height_reduce = sprintf("%.0f", ($height * $percent_reduce)); - warn "Reducing $filename by " . ($percent_reduce * 100) . "\% or to $width_reduce pix X $height_reduce pix"; - $image->Resize(width=>$width_reduce, height=>$height_reduce); - my @img = $image->ImageToBlob(); - $imgfile = $img[0]; - warn "$filename is " . length($imgfile) . " bytes after resizing."; - undef $image; # 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 - $count{count}++; - push @{ $count{filenames} }, { source => $filename, cardnumber => $cardnumber }; - } elsif ( $dberror ) { - warn "Database returned error: $dberror"; - ($dberror =~ /patronimage_fk1/) ? $filerrors{'IMGEXISTS'} = 1 : $filerrors{'DBERR'} = 1; - push my @filerrors, \%filerrors; - push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber }; - $template->param( ERRORS => 1 ); - } elsif ( !$mimetype ) { - warn "Unable to determine mime type of $filename. Please verify mimetype and add to \%mimemap if necessary."; - $filerrors{'MIMERR'} = 1; - push my @filerrors, \%filerrors; - push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber }; - $template->param( ERRORS => 1 ); - } - } else { - warn "Opening $dir/$filename failed!"; - $filerrors{'OPNERR'} = 1; - push my @filerrors, \%filerrors; - push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber }; - $template->param( ERRORS => 1 ); - } + 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 ) { + warn "Database returned error: $dberror"; + ($dberror =~ /patronimage_fk1/) ? $filerrors{'IMGEXISTS'} = 1 : $filerrors{'DBERR'} = 1; + push my @filerrors, \%filerrors; + push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber }; + $template->param( ERRORS => 1 ); + } elsif ( !$mimetype ) { + warn "Unable to determine mime type of $filename. Please verify mimetype."; + $filerrors{'MIMERR'} = 1; + push my @filerrors, \%filerrors; + push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber }; + $template->param( ERRORS => 1 ); + } + } else { + warn "Contents of $filename corrupted!"; + # $count{count}--; + $filerrors{'CORERR'} = 1; + push my @filerrors, \%filerrors; + push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber }; + $template->param( ERRORS => 1 ); + } + } else { + warn "Opening $dir/$filename failed!"; + $filerrors{'OPNERR'} = 1; + push my @filerrors, \%filerrors; + push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber }; + $template->param( ERRORS => 1 ); + } } 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 }; + push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber }; $template->param( ERRORS => 1 ); } - return %count; + return (%count); } -=back - =head1 AUTHORS Original contributor(s) undocumented