package C4::Images;
+
+# Copyright (C) 2011 C & P Bibliography Services
+# Jared Camins-Esakov <jcamins@cpbibliograpy.com>
+#
+# 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;
use C4::Context;
use GD;
-use vars qw($debug $VERSION @ISA @EXPORT);
+use vars qw($debug $noimage $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.07.00.049;
+ 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;
+
+ $noimage = pack( "H*",
+ '47494638396101000100800000FFFFFF'
+ . '00000021F90401000000002C00000000'
+ . '010001000002024401003B' );
}
=head2 PutImage
=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;
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) {
- warn "Database error!";
- return undef;
- } else {
- return $imagedata;
+ if ( !$imagedata ) {
+ $imagedata->{'thumbnail'} = $noimage;
+ $imagedata->{'imagefile'} = $noimage;
+ }
+ if ( $sth->err ) {
+ warn "Database error!" if $debug;
}
+ return $imagedata;
}
=head2 ListImagesForBiblio
=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) {
- push @imagenumbers, $row->{'imagenumber'};
- }
- return @imagenumbers;
- } else {
- return undef;
+ while ( my $row = $sth->fetchrow_hashref ) {
+ push @imagenumbers, $row->{'imagenumber'};
}
+ return @imagenumbers;
}
=head2 DelImage
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;
}
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;
}
}
+=head2 NoImage
+
+ C4::Images->NoImage;
+
+Returns the gif to be used when there is no image matching the request, and
+its mimetype (image/gif).
+
+=cut
+
+sub NoImage {
+ return $noimage, 'image/gif';
+}
+
1;
projects / koha.git / blobdiff