X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FImages.pm;h=209cde05c47aabad6bd7ccce37fcf0d350fb8c64;hb=587e2e920e6314dd800aea106c4e2d61ef27d39d;hp=99d01987911281cd7547b1615feae0e6a8502200;hpb=e901c4f24cc7d53b7f879ba9b5c467b10ae30e88;p=koha_gimpoz diff --git a/C4/Images.pm b/C4/Images.pm index 99d0198791..209cde05c4 100644 --- a/C4/Images.pm +++ b/C4/Images.pm @@ -1,4 +1,23 @@ package C4::Images; + +# Copyright (C) 2011 C & P Bibliography Services +# Jared Camins-Esakov +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + use strict; use warnings; use 5.010; @@ -9,17 +28,18 @@ use GD; use vars qw($debug $VERSION @ISA @EXPORT); BEGIN { - # set the version for version checking - $VERSION = 3.03; - require Exporter; - @ISA = qw(Exporter); - @EXPORT = qw( - &PutImage - &RetrieveImage - &ListImagesForBiblio - &DelImage + + # set the version for version checking + $VERSION = 3.03; + require Exporter; + @ISA = qw(Exporter); + @EXPORT = qw( + &PutImage + &RetrieveImage + &ListImagesForBiblio + &DelImage ); - $debug = $ENV{KOHA_DEBUG} || $ENV{DEBUG} || 0; + $debug = $ENV{KOHA_DEBUG} || $ENV{DEBUG} || 0; } =head2 PutImage @@ -31,27 +51,33 @@ Stores binary image data and thumbnail in database, optionally replacing existin =cut sub PutImage { - my ($biblionumber, $srcimage, $replace) = @_; + my ( $biblionumber, $srcimage, $replace ) = @_; return -1 unless defined($srcimage); if ($replace) { - foreach (ListImagesForBiblio($biblionumber)) { + foreach ( ListImagesForBiblio($biblionumber) ) { DelImage($_); } } my $dbh = C4::Context->dbh; - my $query = "INSERT INTO biblioimages (biblionumber, mimetype, imagefile, thumbnail) VALUES (?,?,?,?);"; + my $query = +"INSERT INTO biblioimages (biblionumber, mimetype, imagefile, thumbnail) VALUES (?,?,?,?);"; my $sth = $dbh->prepare($query); - 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 $thumbnail = _scale_image($srcimage, 140, 200); # MAX pixel dims are 140 X 200 for thumbnail... - my $fullsize = _scale_image($srcimage, 600, 800); # MAX pixel dims are 600 X 800 for full-size image... + 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 $thumbnail = _scale_image( $srcimage, 140, 200 ) + ; # MAX pixel dims are 140 X 200 for thumbnail... + my $fullsize = _scale_image( $srcimage, 600, 800 ) + ; # MAX pixel dims are 600 X 800 for full-size image... $debug and warn "thumbnail is " . length($thumbnail) . " bytes."; - $sth->execute($biblionumber,$mimetype,$fullsize->png(),$thumbnail->png()); + $sth->execute( $biblionumber, $mimetype, $fullsize->png(), + $thumbnail->png() ); my $dberror = $sth->errstr; warn "Error returned inserting $biblionumber.$mimetype." if $sth->errstr; undef $thumbnail; @@ -70,14 +96,16 @@ sub RetrieveImage { my ($imagenumber) = @_; my $dbh = C4::Context->dbh; - my $query = 'SELECT mimetype, imagefile, thumbnail FROM biblioimages WHERE imagenumber = ?'; + my $query = +'SELECT mimetype, imagefile, thumbnail FROM biblioimages WHERE imagenumber = ?'; my $sth = $dbh->prepare($query); $sth->execute($imagenumber); my $imagedata = $sth->fetchrow_hashref; - if ($sth->err) { + if ( $sth->err ) { warn "Database error!"; return undef; - } else { + } + else { return $imagedata; } } @@ -89,22 +117,22 @@ Gets a list of all images associated with a particular biblio. =cut - sub ListImagesForBiblio { my ($biblionumber) = @_; my @imagenumbers; - my $dbh = C4::Context->dbh; + my $dbh = C4::Context->dbh; my $query = 'SELECT imagenumber FROM biblioimages WHERE biblionumber = ?'; - my $sth = $dbh->prepare($query); + my $sth = $dbh->prepare($query); $sth->execute($biblionumber); warn "Database error!" if $sth->errstr; - if (!$sth->errstr && $sth->rows > 0) { - while (my $row = $sth->fetchrow_hashref) { + if ( !$sth->errstr && $sth->rows > 0 ) { + while ( my $row = $sth->fetchrow_hashref ) { push @imagenumbers, $row->{'imagenumber'}; } return @imagenumbers; - } else { + } + else { return undef; } } @@ -120,9 +148,9 @@ Removes the image with the supplied imagenumber. sub DelImage { my ($imagenumber) = @_; warn "Imagenumber passed to DelImage is $imagenumber" if $debug; - my $dbh = C4::Context->dbh; + my $dbh = C4::Context->dbh; my $query = "DELETE FROM biblioimages WHERE imagenumber = ?;"; - my $sth = $dbh->prepare($query); + my $sth = $dbh->prepare($query); $sth->execute($imagenumber); my $dberror = $sth->errstr; warn "Database error!" if $sth->errstr; @@ -130,24 +158,36 @@ sub DelImage { } sub _scale_image { - my ($image, $maxwidth, $maxheight) = @_; - my ($width, $height) = $image->getBounds(); + my ( $image, $maxwidth, $maxheight ) = @_; + my ( $width, $height ) = $image->getBounds(); $debug and warn "image is $width pix X $height pix."; - if ($width > $maxwidth || $height > $maxheight) { + if ( $width > $maxwidth || $height > $maxheight ) { + # $debug and warn "$filename exceeds the maximum pixel dimensions of $maxwidth X $maxheight. Resizing..."; - my $percent_reduce; # Percent we will reduce the image dimensions by... - if ($width > $maxwidth) { - $percent_reduce = sprintf("%.5f",($maxwidth/$width)); # If the width is oversize, scale based on width overage... - } else { - $percent_reduce = sprintf("%.5f",($maxheight/$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 image by " . ($percent_reduce * 100) . "\% or to $width_reduce pix X $height_reduce pix"; - my $newimage = GD::Image->new($width_reduce, $height_reduce, 1); #'1' creates true color image... - $newimage->copyResampled($image,0,0,0,0,$width_reduce,$height_reduce,$width,$height); + my $percent_reduce; # Percent we will reduce the image dimensions by... + if ( $width > $maxwidth ) { + $percent_reduce = + sprintf( "%.5f", ( $maxwidth / $width ) ) + ; # If the width is oversize, scale based on width overage... + } + else { + $percent_reduce = + sprintf( "%.5f", ( $maxheight / $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 image by " + . ( $percent_reduce * 100 ) + . "\% or to $width_reduce pix X $height_reduce pix"; + my $newimage = GD::Image->new( $width_reduce, $height_reduce, 1 ) + ; #'1' creates true color image... + $newimage->copyResampled( $image, 0, 0, 0, 0, $width_reduce, + $height_reduce, $width, $height ); return $newimage; - } else { + } + else { return $image; } }