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
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
27 use vars
qw($debug $noimage @ISA @EXPORT);
39 $debug = $ENV{KOHA_DEBUG
} || $ENV{DEBUG
} || 0;
41 $noimage = pack( "H*",
42 '47494638396101000100800000FFFFFF'
43 . '00000021F90401000000002C00000000'
44 . '010001000002024401003B' );
49 PutImage({ biblionumber => $biblionumber, itemnumber => $itemnumber, src_image => $srcimage, replace => $replace });
51 Stores binary image data and thumbnail in database, optionally replacing existing images for the given biblio or item.
58 my $biblionumber = $params->{biblionumber
};
59 my $itemnumber = $params->{itemnumber
};
60 my $srcimage = $params->{src_image
};
61 my $replace = $params->{replace
};
63 Koha
::Exceptions
::WrongParameter
->throw(
64 'PutImage cannot be called with both biblionumber and itemnumber')
65 if $biblionumber and $itemnumber;
67 Koha
::Exceptions
::WrongParameter
->throw(
68 'PutImage must be called with "replace" if itemnumber is passed. Only 1 cover per item is allowed.')
69 if $itemnumber and not $replace;
72 return -1 unless defined($srcimage);
74 if ($biblionumber && $replace) {
75 foreach ( ListImagesForBiblio
($biblionumber) ) {
80 my $dbh = C4
::Context
->dbh;
82 "INSERT INTO biblioimages (biblionumber, itemnumber, mimetype, imagefile, thumbnail) VALUES (?,?,?,?,?);";
83 my $sth = $dbh->prepare($query);
85 my $mimetype = 'image/png'
86 ; # GD autodetects three basic image formats: PNG, JPEG, XPM; we will convert all to PNG which is lossless...
88 # Check the pixel size of the image we are about to import...
89 my $thumbnail = _scale_image
( $srcimage, 140, 200 )
90 ; # MAX pixel dims are 140 X 200 for thumbnail...
91 my $fullsize = _scale_image
( $srcimage, 600, 800 )
92 ; # MAX pixel dims are 600 X 800 for full-size image...
93 $debug and warn "thumbnail is " . length($thumbnail) . " bytes.";
95 $sth->execute( $biblionumber, $itemnumber, $mimetype, $fullsize->png(),
97 my $dberror = $sth->errstr;
98 warn sprintf("Error returned inserting %s.%s.", ($biblionumber || $itemnumber, $mimetype)) if $sth->errstr;
105 my ($imagedata, $error) = RetrieveImage($imagenumber);
107 Retrieves the specified image.
112 my ($imagenumber) = @_;
114 my $dbh = C4
::Context
->dbh;
116 'SELECT imagenumber, mimetype, imagefile, thumbnail FROM biblioimages WHERE imagenumber = ?';
117 my $sth = $dbh->prepare($query);
118 $sth->execute($imagenumber);
119 my $imagedata = $sth->fetchrow_hashref;
121 $imagedata->{'thumbnail'} = $noimage;
122 $imagedata->{'imagefile'} = $noimage;
125 warn "Database error!" if $debug;
130 =head2 ListImagesForBiblio
131 my (@images) = ListImagesForBiblio($biblionumber);
133 Gets a list of all images associated with a particular biblio.
137 sub ListImagesForBiblio
{
138 my ($biblionumber) = @_;
141 my $dbh = C4
::Context
->dbh;
142 my $query = 'SELECT imagenumber FROM biblioimages WHERE biblionumber = ?';
143 my $sth = $dbh->prepare($query);
144 $sth->execute($biblionumber);
145 while ( my $row = $sth->fetchrow_hashref ) {
146 push @imagenumbers, $row->{'imagenumber'};
148 return @imagenumbers;
151 =head2 GetImageForItem
152 my $image = GetImageForItem($itemnumber);
154 Gets the image associated with a particular item.
158 sub GetImageForItem
{
159 my ($itemnumber) = @_;
161 my $dbh = C4
::Context
->dbh;
162 return $dbh->selectrow_array(
163 'SELECT imagenumber FROM biblioimages WHERE itemnumber = ?',
164 undef, $itemnumber );
169 my ($dberror) = DelImage($imagenumber);
171 Removes the image with the supplied imagenumber.
176 my ($imagenumber) = @_;
177 warn "Imagenumber passed to DelImage is $imagenumber" if $debug;
178 my $dbh = C4
::Context
->dbh;
179 my $query = "DELETE FROM biblioimages WHERE imagenumber = ?;";
180 my $sth = $dbh->prepare($query);
181 $sth->execute($imagenumber);
182 my $dberror = $sth->errstr;
183 warn "Database error!" if $sth->errstr;
188 my ( $image, $maxwidth, $maxheight ) = @_;
189 my ( $width, $height ) = $image->getBounds();
190 $debug and warn "image is $width pix X $height pix.";
191 if ( $width > $maxwidth || $height > $maxheight ) {
193 # $debug and warn "$filename exceeds the maximum pixel dimensions of $maxwidth X $maxheight. Resizing...";
194 my $percent_reduce; # Percent we will reduce the image dimensions by...
195 if ( $width > $maxwidth ) {
197 sprintf( "%.5f", ( $maxwidth / $width ) )
198 ; # If the width is oversize, scale based on width overage...
202 sprintf( "%.5f", ( $maxheight / $height ) )
203 ; # otherwise scale based on height overage.
205 my $width_reduce = sprintf( "%.0f", ( $width * $percent_reduce ) );
206 my $height_reduce = sprintf( "%.0f", ( $height * $percent_reduce ) );
208 and warn "Reducing image by "
209 . ( $percent_reduce * 100 )
210 . "\% or to $width_reduce pix X $height_reduce pix";
211 my $newimage = GD
::Image
->new( $width_reduce, $height_reduce, 1 )
212 ; #'1' creates true color image...
213 $newimage->copyResampled( $image, 0, 0, 0, 0, $width_reduce,
214 $height_reduce, $width, $height );
226 Returns the gif to be used when there is no image matching the request, and
227 its mimetype (image/gif).
232 return $noimage, 'image/gif';