- my ($cardnumber, $source, %count) = @_;
- warn "Entering sub handle_file; passed \$cardnumber=$cardnumber, \$source=$source" if $DEBUG;
- my $mimemap = {
- "gif" => "image/gif",
- "jpg" => "image/jpeg",
- "jpeg" => "image/jpeg",
- "png" => "image/png"
- };
- $count{filenames} = () if !$count{filenames};
- $count{source} = $source if !$count{source};
- if ($cardnumber && $source) { # Now process any imagefiles
- my %filerrors;
- warn "Source: $source" if $DEBUG;
- if (open (IMG, "$source")) {
- #binmode (IMG); # Not sure if we need this or not -fbcit
- my $imgfile;
- while (<IMG>) {
- $imgfile .= $_;
- }
- if ($filetype eq 'image') {
- $filename = $uploadfilename;
- } else {
- $filename = $1 if ($source =~ /\/([^\/]+)$/);
- }
- warn "$filename is " . length($imgfile) . " bytes";
- if (length($imgfile) > 100000) {
- warn "$filename is TOO BIG!!! I refuse to beleagur my database with that much data. Try reducing the pixel dimensions and I\'ll reconsider.";
- $filerrors{'OVRSIZ'} = 1;
- push my @filerrors, \%filerrors;
- push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber };
- $template->param( ERRORS => 1 );
- return %count;
+ my ( $cardnumber, $source, $template, %count ) = @_;
+ $logger->debug("Entering sub handle_file; passed \$cardnumber=$cardnumber, \$source=$source");
+ $count{filenames} = () if !$count{filenames};
+ $count{source} = $source if !$count{source};
+ $count{count} = 0 unless exists $count{count};
+ my %filerrors;
+ my $filename;
+ if ( $filetype eq 'image' ) {
+ $filename = $uploadfilename;
+ }
+ else {
+ $filename = $1 if ( $source && $source =~ /\/([^\/]+)$/ );
+ }
+ if ( $cardnumber && $source ) {
+ # Now process any imagefiles
+ $logger->debug("Source: $source");
+ my $size = ( stat($source) )[7];
+ 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 );
+ # this one is fatal so bail here...
+ return %count;
+ }
+ my ( $srcimage, $image );
+ if ( open( my $fh, '<', $source ) ) {
+ $srcimage = GD::Image->new($fh);
+ close($fh);
+ 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();
+ $logger->debug("$filename is $width pix X $height pix.");
+ if ( $width > 200 || $height > 300 ) {
+ # MAX pixel dims are 200 X 300...
+ $logger->debug("$filename exceeds the maximum pixel dimensions of 200 X 300. Resizing...");
+ # Percent we will reduce the image dimensions by...
+ my $percent_reduce;
+ if ( $width > 200 ) {
+ # If the width is oversize, scale based on width overage...
+ $percent_reduce = sprintf( "%.5f", ( 140 / $width ) );
+ }
+ else {
+ # otherwise scale based on height overage.
+ $percent_reduce = sprintf( "%.5f", ( 200 / $height ) );
+ }
+ my $width_reduce =
+ sprintf( "%.0f", ( $width * $percent_reduce ) );
+ my $height_reduce =
+ sprintf( "%.0f", ( $height * $percent_reduce ) );
+ $logger->debug("Reducing $filename by "
+ . ( $percent_reduce * 100 )
+ . "\% or to $width_reduce pix X $height_reduce pix");
+ #'1' creates true color image...
+ $image = GD::Image->new( $width_reduce, $height_reduce, 1 );
+ $image->copyResampled( $srcimage, 0, 0, 0, 0, $width_reduce,
+ $height_reduce, $width, $height );
+ $imgfile = $image->png();
+ $logger->debug("$filename is "
+ . length($imgfile)
+ . " bytes after resizing.");
+ undef $image;
+ undef $srcimage; # This object can get big...
+ }
+ else {
+ $image = $srcimage;
+ $imgfile = $image->png();
+ $logger->debug("$filename is " . length($imgfile) . " bytes.");
+ undef $image;
+ undef $srcimage; # This object can get big...
+ }
+ $logger->debug("Image is of mimetype $mimetype");
+ if ($mimetype) {
+ my $patron = Koha::Patrons->find({ cardnumber => $cardnumber });
+ if ( $patron ) {
+ my $image = $patron->image;
+ $image ||= Koha::Patron::Image->new({ borrowernumber => $patron->borrowernumber });
+ $image->set({
+ mimetype => $mimetype,
+ imagefile => $imgfile,
+ });
+ eval { $image->store };
+ if ( $@ ) {
+ # 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
+ warn "Database returned error: $@";
+ $filerrors{'DBERR'} = 1;
+ push my @filerrors, \%filerrors;
+ push @{ $count{filenames} },
+ {
+ filerrors => \@filerrors,
+ source => $filename,
+ cardnumber => $cardnumber
+ };
+ $template->param( ERRORS => 1 );
+ } else {
+ $count{count}++;
+ push @{ $count{filenames} },
+ { source => $filename, cardnumber => $cardnumber };
+ }
+ } else {
+ warn "Patron with the cardnumber '$cardnumber' does not exist";
+ $filerrors{'CARDNUMBER_DOES_NOT_EXIST'} = 1;
+ push my @filerrors, \%filerrors;
+ push @{ $count{filenames} },
+ {
+ filerrors => \@filerrors,
+ source => $filename,
+ cardnumber => $cardnumber
+ };
+ $template->param( ERRORS => 1 );
+ }
+ }
+ else {
+ 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 );
+ }