tools/upload-cover-image.pl

   1 #!/usr/bin/perl
   2 #
   3 # Copyright 2011 C & P Bibliography Services
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19 #
  20 #
  21 #
  22
  23 =head1 NAME
  24
  25 upload-cover-image.pl - Script for handling uploading of both single and bulk coverimages and importing them into the database.
  26
  27 =head1 SYNOPSIS
  28
  29 upload-cover-image.pl
  30
  31 =head1 DESCRIPTION
  32
  33 This script is called and presents the user with an interface allowing him/her to upload a single cover image or bulk cover images via a zip file.
  34 Images will be resized into thumbnails of 140x200 pixels and larger images of
  35 800x600 pixels. If the images that are uploaded are larger, they will be
  36 resized, maintaining aspect ratio.
  37
  38 =cut
  39
  40 use Modern::Perl;
  41
  42 use File::Temp;
  43 use CGI qw ( -utf8 );
  44 use GD;
  45 use C4::Context;
  46 use C4::Auth;
  47 use C4::Output;
  48 use C4::Images;
  49 use Koha::UploadedFiles;
  50 use C4::Log;
  51
  52 my $debug = 1;
  53
  54 my $input = new CGI;
  55
  56 my $fileID = $input->param('uploadedfileid');
  57 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
  58     {
  59         template_name   => "tools/upload-images.tt",
  60         query           => $input,
  61         type            => "intranet",
  62         authnotrequired => 0,
  63         flagsrequired   => { tools => 'upload_local_cover_images' },
  64         debug           => 0,
  65     }
  66 );
  67
  68 my $filetype       = $input->param('filetype');
  69 my $biblionumber   = $input->param('biblionumber');
  70 #my $uploadfilename = $input->param('uploadfile'); # obsolete?
  71 my $replace        = !C4::Context->preference("AllowMultipleCovers")
  72   || $input->param('replace');
  73 my $op        = $input->param('op');
  74 my %cookies   = parse CGI::Cookie($cookie);
  75 my $sessionID = $cookies{'CGISESSID'}->value;
  76
  77 my $error;
  78
  79 $template->{VARS}->{'filetype'}     = $filetype;
  80 $template->{VARS}->{'biblionumber'} = $biblionumber;
  81
  82 my $total = 0;
  83
  84 if ($fileID) {
  85     my $upload = Koha::UploadedFiles->find( $fileID );
  86     if ( $filetype eq 'image' ) {
  87         my $fh       = $upload->file_handle;
  88         my $srcimage = GD::Image->new($fh);
  89         $fh->close if $fh;
  90         if ( defined $srcimage ) {
  91             my $dberror = PutImage( $biblionumber, $srcimage, $replace );
  92             if ($dberror) {
  93                 $error = 'DBERR';
  94             }
  95             else {
  96                 $total = 1;
  97             }
  98         }
  99         else {
 100             $error = 'OPNIMG';
 101         }
 102         undef $srcimage;
 103     }
 104     else {
 105         my $filename = $upload->full_path;
 106         my $dirname = File::Temp::tempdir( CLEANUP => 1 );
 107         unless ( system( "unzip", $filename, '-d', $dirname ) == 0 ) {
 108             $error = 'UZIPFAIL';
 109         }
 110         else {
 111             my @directories;
 112             push @directories, "$dirname";
 113             foreach my $recursive_dir (@directories) {
 114                 my $dir;
 115                 opendir $dir, $recursive_dir;
 116                 while ( my $entry = readdir $dir ) {
 117                     push @directories, "$recursive_dir/$entry"
 118                       if ( -d "$recursive_dir/$entry" and $entry !~ /^[._]/ );
 119                 }
 120                 closedir $dir;
 121             }
 122             foreach my $dir (@directories) {
 123                 my $file;
 124                 if ( -e "$dir/idlink.txt" ) {
 125                     $file = "$dir/idlink.txt";
 126                 }
 127                 elsif ( -e "$dir/datalink.txt" ) {
 128                     $file = "$dir/datalink.txt";
 129                 }
 130                 else {
 131                     next;
 132                 }
 133                 if ( open( FILE, $file ) ) {
 134                     while ( my $line = <FILE> ) {
 135                         my $delim =
 136                             ( $line =~ /\t/ ) ? "\t"
 137                           : ( $line =~ /,/ )  ? ","
 138                           :                     "";
 139
 140                         #$debug and warn "Delimeter is \'$delim\'";
 141                         unless ( $delim eq "," || $delim eq "\t" ) {
 142                             warn
 143 "Unrecognized or missing field delimeter. Please verify that you are using either a ',' or a 'tab'";
 144                             $error = 'DELERR';
 145                         }
 146                         else {
 147                             ( $biblionumber, $filename ) = split $delim, $line, 2;
 148                             $biblionumber =~
 149                               s/[\"\r\n]//g;    # remove offensive characters
 150                             $filename =~ s/[\"\r\n]//g;
 151                             $filename =~ s/^\s+//;
 152                             $filename =~ s/\s+$//;
 153                             if (C4::Context->preference("CataloguingLog")) {
 154                                 logaction('CATALOGUING', 'MODIFY', $biblionumber, "biblio cover image: $filename");
 155                             }
 156                             my $srcimage = GD::Image->new("$dir/$filename");
 157                             if ( defined $srcimage ) {
 158                                 $total++;
 159                                 my $dberror =
 160                                   PutImage( $biblionumber, $srcimage,
 161                                     $replace );
 162                                 if ($dberror) {
 163                                     $error = 'DBERR';
 164                                 }
 165                             }
 166                             else {
 167                                 $error = 'OPNIMG';
 168                             }
 169                             undef $srcimage;
 170                         }
 171                     }
 172                     close(FILE);
 173                 }
 174                 else {
 175                     $error = 'OPNLINK';
 176                 }
 177             }
 178         }
 179     }
 180     $template->{VARS}->{'total'}        = $total;
 181     $template->{VARS}->{'uploadimage'}  = 1;
 182     $template->{VARS}->{'error'}        = $error;
 183     $template->{VARS}->{'biblionumber'} = $biblionumber;
 184 }
 185
 186 output_html_with_http_headers $input, $cookie, $template->output;
 187
 188 exit 0;
 189
 190 =head1 AUTHORS
 191
 192 Written by Jared Camins-Esakov of C & P Bibliography Services, in part based on
 193 code by Koustubha Kale of Anant Corporation and Chris Nighswonger of Foundation
 194 Bible College.
 195
 196 =cut