- 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.";
- $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;
- if (open (IMG, "$source")) {
- $image->Read(file=>\*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.
+ 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( IMG, "$source" ) ) {
+ $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();
+ $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...";
+ # 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 ) );
+ $debug
+ and warn "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();
+ $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) {
+ 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 );