Bug 25327: Regression tests
[koha.git] / tools / upload-cover-image.pl
blobff89afb1d6fe0a4a87e4a7c28df32db305322efe
1 #!/usr/bin/perl
3 # Copyright 2011 C & P Bibliography Services
5 # This file is part of Koha.
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.
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.
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>.
23 =head1 NAME
25 upload-cover-image.pl - Script for handling uploading of both single and bulk coverimages and importing them into the database.
27 =head1 SYNOPSIS
29 upload-cover-image.pl
31 =head1 DESCRIPTION
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.
38 =cut
40 use Modern::Perl;
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;
52 my $debug = 1;
54 my $input = new CGI;
56 my $fileID = $input->param('uploadedfileid');
57 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
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,
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;
77 my $error;
79 $template->{VARS}->{'filetype'} = $filetype;
80 $template->{VARS}->{'biblionumber'} = $biblionumber;
82 my $total = 0;
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';
95 else {
96 $total = 1;
99 else {
100 $error = 'OPNIMG';
102 undef $srcimage;
104 else {
105 my $filename = $upload->full_path;
106 my $dirname = File::Temp::tempdir( CLEANUP => 1 );
107 qx/unzip $filename -d $dirname/;
108 my $exit_code = $?;
109 unless ( $exit_code == 0 ) {
110 $error = 'UZIPFAIL';
112 else {
113 my @directories;
114 push @directories, "$dirname";
115 foreach my $recursive_dir (@directories) {
116 my $dir;
117 opendir $dir, $recursive_dir;
118 while ( my $entry = readdir $dir ) {
119 push @directories, "$recursive_dir/$entry"
120 if ( -d "$recursive_dir/$entry" and $entry !~ /^[._]/ );
122 closedir $dir;
124 foreach my $dir (@directories) {
125 my $file;
126 if ( -e "$dir/idlink.txt" ) {
127 $file = "$dir/idlink.txt";
129 elsif ( -e "$dir/datalink.txt" ) {
130 $file = "$dir/datalink.txt";
132 else {
133 next;
135 if ( open( FILE, $file ) ) {
136 while ( my $line = <FILE> ) {
137 my $delim =
138 ( $line =~ /\t/ ) ? "\t"
139 : ( $line =~ /,/ ) ? ","
140 : "";
142 #$debug and warn "Delimeter is \'$delim\'";
143 unless ( $delim eq "," || $delim eq "\t" ) {
144 warn
145 "Unrecognized or missing field delimeter. Please verify that you are using either a ',' or a 'tab'";
146 $error = 'DELERR';
148 else {
149 ( $biblionumber, $filename ) = split $delim, $line, 2;
150 $biblionumber =~
151 s/[\"\r\n]//g; # remove offensive characters
152 $filename =~ s/[\"\r\n]//g;
153 $filename =~ s/^\s+//;
154 $filename =~ s/\s+$//;
155 if (C4::Context->preference("CataloguingLog")) {
156 logaction('CATALOGUING', 'MODIFY', $biblionumber, "biblio cover image: $filename");
158 my $srcimage = GD::Image->new("$dir/$filename");
159 if ( defined $srcimage ) {
160 $total++;
161 my $dberror =
162 PutImage( $biblionumber, $srcimage,
163 $replace );
164 if ($dberror) {
165 $error = 'DBERR';
168 else {
169 $error = 'OPNIMG';
171 undef $srcimage;
174 close(FILE);
176 else {
177 $error = 'OPNLINK';
182 $template->{VARS}->{'total'} = $total;
183 $template->{VARS}->{'uploadimage'} = 1;
184 $template->{VARS}->{'error'} = $error;
185 $template->{VARS}->{'biblionumber'} = $biblionumber;
188 output_html_with_http_headers $input, $cookie, $template->output;
190 exit 0;
192 =head1 AUTHORS
194 Written by Jared Camins-Esakov of C & P Bibliography Services, in part based on
195 code by Koustubha Kale of Anant Corporation and Chris Nighswonger of Foundation
196 Bible College.
198 =cut