3 # Copyright (C) 2011 C & P Bibliography Services
4 # Jared Camins-Esakov <jcamins@cpbibliograpy.com>
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
28 use vars qw($debug $VERSION @ISA @EXPORT);
32 # set the version for version checking
42 $debug = $ENV{KOHA_DEBUG} || $ENV{DEBUG} || 0;
47 PutImage($biblionumber, $srcimage, $replace);
49 Stores binary image data and thumbnail in database, optionally replacing existing images for the given biblio.
54 my ( $biblionumber, $srcimage, $replace ) = @_;
56 return -1 unless defined($srcimage);
59 foreach ( ListImagesForBiblio($biblionumber) ) {
64 my $dbh = C4::Context->dbh;
66 "INSERT INTO biblioimages (biblionumber, mimetype, imagefile, thumbnail) VALUES (?,?,?,?);";
67 my $sth = $dbh->prepare($query);
69 my $mimetype = 'image/png'
70 ; # GD autodetects three basic image formats: PNG, JPEG, XPM; we will convert all to PNG which is lossless...
72 # Check the pixel size of the image we are about to import...
73 my $thumbnail = _scale_image( $srcimage, 140, 200 )
74 ; # MAX pixel dims are 140 X 200 for thumbnail...
75 my $fullsize = _scale_image( $srcimage, 600, 800 )
76 ; # MAX pixel dims are 600 X 800 for full-size image...
77 $debug and warn "thumbnail is " . length($thumbnail) . " bytes.";
79 $sth->execute( $biblionumber, $mimetype, $fullsize->png(),
81 my $dberror = $sth->errstr;
82 warn "Error returned inserting $biblionumber.$mimetype." if $sth->errstr;
89 my ($imagedata, $error) = RetrieveImage($imagenumber);
91 Retrieves the specified image.
96 my ($imagenumber) = @_;
98 my $dbh = C4::Context->dbh;
100 'SELECT mimetype, imagefile, thumbnail FROM biblioimages WHERE imagenumber = ?';
101 my $sth = $dbh->prepare($query);
102 $sth->execute($imagenumber);
103 my $imagedata = $sth->fetchrow_hashref;
105 warn "Database error!";
113 =head2 ListImagesForBiblio
114 my (@images) = ListImagesForBiblio($biblionumber);
116 Gets a list of all images associated with a particular biblio.
120 sub ListImagesForBiblio {
121 my ($biblionumber) = @_;
124 my $dbh = C4::Context->dbh;
125 my $query = 'SELECT imagenumber FROM biblioimages WHERE biblionumber = ?';
126 my $sth = $dbh->prepare($query);
127 $sth->execute($biblionumber);
128 warn "Database error!" if $sth->errstr;
129 if ( !$sth->errstr && $sth->rows > 0 ) {
130 while ( my $row = $sth->fetchrow_hashref ) {
131 push @imagenumbers, $row->{'imagenumber'};
133 return @imagenumbers;
142 my ($dberror) = DelImage($imagenumber);
144 Removes the image with the supplied imagenumber.
149 my ($imagenumber) = @_;
150 warn "Imagenumber passed to DelImage is $imagenumber" if $debug;
151 my $dbh = C4::Context->dbh;
152 my $query = "DELETE FROM biblioimages WHERE imagenumber = ?;";
153 my $sth = $dbh->prepare($query);
154 $sth->execute($imagenumber);
155 my $dberror = $sth->errstr;
156 warn "Database error!" if $sth->errstr;
161 my ( $image, $maxwidth, $maxheight ) = @_;
162 my ( $width, $height ) = $image->getBounds();
163 $debug and warn "image is $width pix X $height pix.";
164 if ( $width > $maxwidth || $height > $maxheight ) {
166 # $debug and warn "$filename exceeds the maximum pixel dimensions of $maxwidth X $maxheight. Resizing...";
167 my $percent_reduce; # Percent we will reduce the image dimensions by...
168 if ( $width > $maxwidth ) {
170 sprintf( "%.5f", ( $maxwidth / $width ) )
171 ; # If the width is oversize, scale based on width overage...
175 sprintf( "%.5f", ( $maxheight / $height ) )
176 ; # otherwise scale based on height overage.
178 my $width_reduce = sprintf( "%.0f", ( $width * $percent_reduce ) );
179 my $height_reduce = sprintf( "%.0f", ( $height * $percent_reduce ) );
181 and warn "Reducing image by "
182 . ( $percent_reduce * 100 )
183 . "\% or to $width_reduce pix X $height_reduce pix";
184 my $newimage = GD::Image->new( $width_reduce, $height_reduce, 1 )
185 ; #'1' creates true color image...
186 $newimage->copyResampled( $image, 0, 0, 0, 0, $width_reduce,
187 $height_reduce, $width, $height );