C4/Images.pm

   1 package C4::Images;
   2
   3 # Copyright (C) 2011 C & P Bibliography Services
   4 # Jared Camins-Esakov <jcamins@cpbibliograpy.com>
   5 #
   6 # This file is part of Koha.
   7 #
   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.
  12 #
  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.
  17 #
  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>.
  20
  21 use strict;
  22 use warnings;
  23 use 5.010;
  24
  25 use C4::Context;
  26 use GD;
  27
  28 use vars qw($debug $noimage @ISA @EXPORT);
  29
  30 BEGIN {
  31
  32     # set the version for version checking
  33     require Exporter;
  34     @ISA    = qw(Exporter);
  35     @EXPORT = qw(
  36       &PutImage
  37       &RetrieveImage
  38       &ListImagesForBiblio
  39       &DelImage
  40     );
  41     $debug = $ENV{KOHA_DEBUG} || $ENV{DEBUG} || 0;
  42
  43     $noimage = pack( "H*",
  44             '47494638396101000100800000FFFFFF'
  45           . '00000021F90401000000002C00000000'
  46           . '010001000002024401003B' );
  47 }
  48
  49 =head2 PutImage
  50
  51     PutImage($biblionumber, $srcimage, $replace);
  52
  53 Stores binary image data and thumbnail in database, optionally replacing existing images for the given biblio.
  54
  55 =cut
  56
  57 sub PutImage {
  58     my ( $biblionumber, $srcimage, $replace ) = @_;
  59
  60     return -1 unless defined($srcimage);
  61
  62     if ($replace) {
  63         foreach ( ListImagesForBiblio($biblionumber) ) {
  64             DelImage($_);
  65         }
  66     }
  67
  68     my $dbh = C4::Context->dbh;
  69     my $query =
  70 "INSERT INTO biblioimages (biblionumber, mimetype, imagefile, thumbnail) VALUES (?,?,?,?);";
  71     my $sth = $dbh->prepare($query);
  72
  73     my $mimetype = 'image/png'
  74       ; # GD autodetects three basic image formats: PNG, JPEG, XPM; we will convert all to PNG which is lossless...
  75
  76     # Check the pixel size of the image we are about to import...
  77     my $thumbnail = _scale_image( $srcimage, 140, 200 )
  78       ;    # MAX pixel dims are 140 X 200 for thumbnail...
  79     my $fullsize = _scale_image( $srcimage, 600, 800 )
  80       ;    # MAX pixel dims are 600 X 800 for full-size image...
  81     $debug and warn "thumbnail is " . length($thumbnail) . " bytes.";
  82
  83     $sth->execute( $biblionumber, $mimetype, $fullsize->png(),
  84         $thumbnail->png() );
  85     my $dberror = $sth->errstr;
  86     warn "Error returned inserting $biblionumber.$mimetype." if $sth->errstr;
  87     undef $thumbnail;
  88     undef $fullsize;
  89     return $dberror;
  90 }
  91
  92 =head2 RetrieveImage
  93     my ($imagedata, $error) = RetrieveImage($imagenumber);
  94
  95 Retrieves the specified image.
  96
  97 =cut
  98
  99 sub RetrieveImage {
 100     my ($imagenumber) = @_;
 101
 102     my $dbh = C4::Context->dbh;
 103     my $query =
 104 'SELECT imagenumber, mimetype, imagefile, thumbnail FROM biblioimages WHERE imagenumber = ?';
 105     my $sth = $dbh->prepare($query);
 106     $sth->execute($imagenumber);
 107     my $imagedata = $sth->fetchrow_hashref;
 108     if ( !$imagedata ) {
 109         $imagedata->{'thumbnail'} = $noimage;
 110         $imagedata->{'imagefile'} = $noimage;
 111     }
 112     if ( $sth->err ) {
 113         warn "Database error!" if $debug;
 114     }
 115     return $imagedata;
 116 }
 117
 118 =head2 ListImagesForBiblio
 119     my (@images) = ListImagesForBiblio($biblionumber);
 120
 121 Gets a list of all images associated with a particular biblio.
 122
 123 =cut
 124
 125 sub ListImagesForBiblio {
 126     my ($biblionumber) = @_;
 127
 128     my @imagenumbers;
 129     my $dbh   = C4::Context->dbh;
 130     my $query = 'SELECT imagenumber FROM biblioimages WHERE biblionumber = ?';
 131     my $sth   = $dbh->prepare($query);
 132     $sth->execute($biblionumber);
 133     while ( my $row = $sth->fetchrow_hashref ) {
 134         push @imagenumbers, $row->{'imagenumber'};
 135     }
 136     return @imagenumbers;
 137 }
 138
 139 =head2 DelImage
 140
 141     my ($dberror) = DelImage($imagenumber);
 142
 143 Removes the image with the supplied imagenumber.
 144
 145 =cut
 146
 147 sub DelImage {
 148     my ($imagenumber) = @_;
 149     warn "Imagenumber passed to DelImage is $imagenumber" if $debug;
 150     my $dbh   = C4::Context->dbh;
 151     my $query = "DELETE FROM biblioimages WHERE imagenumber = ?;";
 152     my $sth   = $dbh->prepare($query);
 153     $sth->execute($imagenumber);
 154     my $dberror = $sth->errstr;
 155     warn "Database error!" if $sth->errstr;
 156     return $dberror;
 157 }
 158
 159 sub _scale_image {
 160     my ( $image, $maxwidth, $maxheight ) = @_;
 161     my ( $width, $height ) = $image->getBounds();
 162     $debug and warn "image is $width pix X $height pix.";
 163     if ( $width > $maxwidth || $height > $maxheight ) {
 164
 165 #        $debug and warn "$filename exceeds the maximum pixel dimensions of $maxwidth X $maxheight. Resizing...";
 166         my $percent_reduce;  # Percent we will reduce the image dimensions by...
 167         if ( $width > $maxwidth ) {
 168             $percent_reduce =
 169               sprintf( "%.5f", ( $maxwidth / $width ) )
 170               ;    # If the width is oversize, scale based on width overage...
 171         }
 172         else {
 173             $percent_reduce =
 174               sprintf( "%.5f", ( $maxheight / $height ) )
 175               ;    # otherwise scale based on height overage.
 176         }
 177         my $width_reduce  = sprintf( "%.0f", ( $width * $percent_reduce ) );
 178         my $height_reduce = sprintf( "%.0f", ( $height * $percent_reduce ) );
 179         $debug
 180           and warn "Reducing image by "
 181           . ( $percent_reduce * 100 )
 182           . "\% or to $width_reduce pix X $height_reduce pix";
 183         my $newimage = GD::Image->new( $width_reduce, $height_reduce, 1 )
 184           ;        #'1' creates true color image...
 185         $newimage->copyResampled( $image, 0, 0, 0, 0, $width_reduce,
 186             $height_reduce, $width, $height );
 187         return $newimage;
 188     }
 189     else {
 190         return $image;
 191     }
 192 }
 193
 194 =head2 NoImage
 195
 196     C4::Images->NoImage;
 197
 198 Returns the gif to be used when there is no image matching the request, and
 199 its mimetype (image/gif).
 200
 201 =cut
 202
 203 sub NoImage {
 204     return $noimage, 'image/gif';
 205 }
 206
 207 1;