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 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
  11 # version.
  12 #
  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.
  16 #
  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.
  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 $VERSION @ISA @EXPORT);
  29
  30 BEGIN {
  31
  32     # set the version for version checking
  33     $VERSION = 3.03;
  34     require Exporter;
  35     @ISA    = qw(Exporter);
  36     @EXPORT = qw(
  37       &PutImage
  38       &RetrieveImage
  39       &ListImagesForBiblio
  40       &DelImage
  41     );
  42     $debug = $ENV{KOHA_DEBUG} || $ENV{DEBUG} || 0;
  43 }
  44
  45 =head2 PutImage
  46
  47     PutImage($biblionumber, $srcimage, $replace);
  48
  49 Stores binary image data and thumbnail in database, optionally replacing existing images for the given biblio.
  50
  51 =cut
  52
  53 sub PutImage {
  54     my ( $biblionumber, $srcimage, $replace ) = @_;
  55
  56     return -1 unless defined($srcimage);
  57
  58     if ($replace) {
  59         foreach ( ListImagesForBiblio($biblionumber) ) {
  60             DelImage($_);
  61         }
  62     }
  63
  64     my $dbh = C4::Context->dbh;
  65     my $query =
  66 "INSERT INTO biblioimages (biblionumber, mimetype, imagefile, thumbnail) VALUES (?,?,?,?);";
  67     my $sth = $dbh->prepare($query);
  68
  69     my $mimetype = 'image/png'
  70       ; # GD autodetects three basic image formats: PNG, JPEG, XPM; we will convert all to PNG which is lossless...
  71
  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.";
  78
  79     $sth->execute( $biblionumber, $mimetype, $fullsize->png(),
  80         $thumbnail->png() );
  81     my $dberror = $sth->errstr;
  82     warn "Error returned inserting $biblionumber.$mimetype." if $sth->errstr;
  83     undef $thumbnail;
  84     undef $fullsize;
  85     return $dberror;
  86 }
  87
  88 =head2 RetrieveImage
  89     my ($imagedata, $error) = RetrieveImage($imagenumber);
  90
  91 Retrieves the specified image.
  92
  93 =cut
  94
  95 sub RetrieveImage {
  96     my ($imagenumber) = @_;
  97
  98     my $dbh = C4::Context->dbh;
  99     my $query =
 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;
 104     if ( $sth->err ) {
 105         warn "Database error!";
 106         return undef;
 107     }
 108     else {
 109         return $imagedata;
 110     }
 111 }
 112
 113 =head2 ListImagesForBiblio
 114     my (@images) = ListImagesForBiblio($biblionumber);
 115
 116 Gets a list of all images associated with a particular biblio.
 117
 118 =cut
 119
 120 sub ListImagesForBiblio {
 121     my ($biblionumber) = @_;
 122
 123     my @imagenumbers;
 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'};
 132         }
 133         return @imagenumbers;
 134     }
 135     else {
 136         return undef;
 137     }
 138 }
 139
 140 =head2 DelImage
 141
 142     my ($dberror) = DelImage($imagenumber);
 143
 144 Removes the image with the supplied imagenumber.
 145
 146 =cut
 147
 148 sub DelImage {
 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;
 157     return $dberror;
 158 }
 159
 160 sub _scale_image {
 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 ) {
 165
 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 ) {
 169             $percent_reduce =
 170               sprintf( "%.5f", ( $maxwidth / $width ) )
 171               ;    # If the width is oversize, scale based on width overage...
 172         }
 173         else {
 174             $percent_reduce =
 175               sprintf( "%.5f", ( $maxheight / $height ) )
 176               ;    # otherwise scale based on height overage.
 177         }
 178         my $width_reduce  = sprintf( "%.0f", ( $width * $percent_reduce ) );
 179         my $height_reduce = sprintf( "%.0f", ( $height * $percent_reduce ) );
 180         $debug
 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 );
 188         return $newimage;
 189     }
 190     else {
 191         return $image;
 192     }
 193 }
 194
 195 1;