9 use vars qw($debug $VERSION @ISA @EXPORT);
12 # set the version for version checking
22 $debug = $ENV{KOHA_DEBUG} || $ENV{DEBUG} || 0;
27 PutImage($biblionumber, $srcimage, $replace);
29 Stores binary image data and thumbnail in database, optionally replacing existing images for the given biblio.
34 my ($biblionumber, $srcimage, $replace) = @_;
36 return -1 unless defined($srcimage);
39 foreach (ListImagesForBiblio($biblionumber)) {
44 my $dbh = C4::Context->dbh;
45 my $query = "INSERT INTO biblioimages (biblionumber, mimetype, imagefile, thumbnail) VALUES (?,?,?,?);";
46 my $sth = $dbh->prepare($query);
48 my $mimetype = 'image/png'; # GD autodetects three basic image formats: PNG, JPEG, XPM; we will convert all to PNG which is lossless...
49 # Check the pixel size of the image we are about to import...
50 my $thumbnail = _scale_image($srcimage, 140, 200); # MAX pixel dims are 140 X 200 for thumbnail...
51 my $fullsize = _scale_image($srcimage, 600, 800); # MAX pixel dims are 600 X 800 for full-size image...
52 $debug and warn "thumbnail is " . length($thumbnail) . " bytes.";
54 $sth->execute($biblionumber,$mimetype,$fullsize->png(),$thumbnail->png());
55 my $dberror = $sth->errstr;
56 warn "Error returned inserting $biblionumber.$mimetype." if $sth->errstr;
63 my ($imagedata, $error) = RetrieveImage($imagenumber);
65 Retrieves the specified image.
70 my ($imagenumber) = @_;
72 my $dbh = C4::Context->dbh;
73 my $query = 'SELECT mimetype, imagefile, thumbnail FROM biblioimages WHERE imagenumber = ?';
74 my $sth = $dbh->prepare($query);
75 $sth->execute($imagenumber);
76 my $imagedata = $sth->fetchrow_hashref;
78 warn "Database error!";
85 =head2 ListImagesForBiblio
86 my (@images) = ListImagesForBiblio($biblionumber);
88 Gets a list of all images associated with a particular biblio.
93 sub ListImagesForBiblio {
94 my ($biblionumber) = @_;
97 my $dbh = C4::Context->dbh;
98 my $query = 'SELECT imagenumber FROM biblioimages WHERE biblionumber = ?';
99 my $sth = $dbh->prepare($query);
100 $sth->execute($biblionumber);
101 warn "Database error!" if $sth->errstr;
102 if (!$sth->errstr && $sth->rows > 0) {
103 while (my $row = $sth->fetchrow_hashref) {
104 push @imagenumbers, $row->{'imagenumber'};
106 return @imagenumbers;
114 my ($dberror) = DelImage($imagenumber);
116 Removes the image with the supplied imagenumber.
121 my ($imagenumber) = @_;
122 warn "Imagenumber passed to DelImage is $imagenumber" if $debug;
123 my $dbh = C4::Context->dbh;
124 my $query = "DELETE FROM biblioimages WHERE imagenumber = ?;";
125 my $sth = $dbh->prepare($query);
126 $sth->execute($imagenumber);
127 my $dberror = $sth->errstr;
128 warn "Database error!" if $sth->errstr;
133 my ($image, $maxwidth, $maxheight) = @_;
134 my ($width, $height) = $image->getBounds();
135 $debug and warn "image is $width pix X $height pix.";
136 if ($width > $maxwidth || $height > $maxheight) {
137 # $debug and warn "$filename exceeds the maximum pixel dimensions of $maxwidth X $maxheight. Resizing...";
138 my $percent_reduce; # Percent we will reduce the image dimensions by...
139 if ($width > $maxwidth) {
140 $percent_reduce = sprintf("%.5f",($maxwidth/$width)); # If the width is oversize, scale based on width overage...
142 $percent_reduce = sprintf("%.5f",($maxheight/$height)); # otherwise scale based on height overage.
144 my $width_reduce = sprintf("%.0f", ($width * $percent_reduce));
145 my $height_reduce = sprintf("%.0f", ($height * $percent_reduce));
146 $debug and warn "Reducing image by " . ($percent_reduce * 100) . "\% or to $width_reduce pix X $height_reduce pix";
147 my $newimage = GD::Image->new($width_reduce, $height_reduce, 1); #'1' creates true color image...
148 $newimage->copyResampled($image,0,0,0,0,$width_reduce,$height_reduce,$width,$height);