Bug 25898: Prohibit indirect object notation
[koha.git] / tools / upload-cover-image.pl
blob82b0bb50b17e03d0c18fb9437842fe94c5f5017b
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 Koha::Biblios;
49 use Koha::CoverImages;
50 use Koha::Items;
51 use Koha::UploadedFiles;
52 use C4::Log;
54 my $debug = 1;
56 my $input = CGI->new;
58 my $fileID = $input->param('uploadedfileid');
59 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
61 template_name => "tools/upload-images.tt",
62 query => $input,
63 type => "intranet",
64 flagsrequired => { tools => 'upload_local_cover_images' },
65 debug => 0,
69 my $filetype = $input->param('filetype');
70 my $biblionumber = $input->param('biblionumber');
71 my $itemnumber = $input->param('itemnumber');
72 #my $uploadfilename = $input->param('uploadfile'); # obsolete?
73 my $replace = !C4::Context->preference("AllowMultipleCovers")
74 || $input->param('replace');
75 my $op = $input->param('op');
76 my %cookies = parse CGI::Cookie($cookie);
77 my $sessionID = $cookies{'CGISESSID'}->value;
79 my $error;
81 $template->param(
82 filetype => $filetype,
83 biblionumber => $biblionumber,
84 itemnumber => $itemnumber,
87 my $total = 0;
89 if ($fileID) {
90 my $upload = Koha::UploadedFiles->find( $fileID );
91 if ( $filetype eq 'image' ) {
92 my $fh = $upload->file_handle;
93 my $srcimage = GD::Image->new($fh);
94 $fh->close if $fh;
95 if ( defined $srcimage ) {
96 eval {
97 if ( $replace ) {
98 if ( $biblionumber ) {
99 Koha::Biblios->find($biblionumber)->cover_images->delete;
100 } elsif ( $itemnumber ) {
101 Koha::Items->find($itemnumber)->cover_images->delete;
105 Koha::CoverImage->new(
107 biblionumber => $biblionumber,
108 itemnumber => $itemnumber,
109 src_image => $srcimage
111 )->store;
114 if ($@) {
115 warn $@;
116 $error = 'DBERR';
118 else {
119 $total = 1;
122 else {
123 $error = 'OPNIMG';
125 undef $srcimage;
127 else {
128 my $filename = $upload->full_path;
129 my $dirname = File::Temp::tempdir( CLEANUP => 1 );
130 qx/unzip $filename -d $dirname/;
131 my $exit_code = $?;
132 unless ( $exit_code == 0 ) {
133 $error = 'UZIPFAIL';
135 else {
136 my @directories;
137 push @directories, "$dirname";
138 foreach my $recursive_dir (@directories) {
139 my $dir;
140 opendir $dir, $recursive_dir;
141 while ( my $entry = readdir $dir ) {
142 push @directories, "$recursive_dir/$entry"
143 if ( -d "$recursive_dir/$entry" and $entry !~ /^[._]/ );
145 closedir $dir;
147 foreach my $dir (@directories) {
148 my $file;
149 if ( -e "$dir/idlink.txt" ) {
150 $file = "$dir/idlink.txt";
152 elsif ( -e "$dir/datalink.txt" ) {
153 $file = "$dir/datalink.txt";
155 else {
156 next;
158 if ( open( my $fh, '<', $file ) ) {
159 while ( my $line = <$fh> ) {
160 my $delim =
161 ( $line =~ /\t/ ) ? "\t"
162 : ( $line =~ /,/ ) ? ","
163 : "";
165 #$debug and warn "Delimeter is \'$delim\'";
166 unless ( $delim eq "," || $delim eq "\t" ) {
167 warn
168 "Unrecognized or missing field delimeter. Please verify that you are using either a ',' or a 'tab'";
169 $error = 'DELERR';
171 else {
172 ( $biblionumber, $filename ) = split $delim, $line, 2;
173 $biblionumber =~
174 s/[\"\r\n]//g; # remove offensive characters
175 $filename =~ s/[\"\r\n]//g;
176 $filename =~ s/^\s+//;
177 $filename =~ s/\s+$//;
178 if (C4::Context->preference("CataloguingLog")) {
179 logaction('CATALOGUING', 'MODIFY', $biblionumber, "biblio cover image: $filename");
181 my $srcimage = GD::Image->new("$dir/$filename");
182 if ( defined $srcimage ) {
183 $total++;
184 eval {
185 if ( $replace ) {
186 if ( $biblionumber ) {
187 Koha::Biblios->find($biblionumber)->cover_images->delete;
188 } elsif ( $itemnumber ) {
189 Koha::Items->find($itemnumber)->cover_images->delete;
193 Koha::CoverImage->new(
195 biblionumber => $biblionumber,
196 itemnumber => $itemnumber,
197 src_image => $srcimage
199 )->store;
202 if ($@) {
203 $error = 'DBERR';
206 else {
207 $error = 'OPNIMG';
209 undef $srcimage;
212 close($fh);
214 else {
215 $error = 'OPNLINK';
221 $template->param(
222 total => $total,
223 uploadimage => 1,
224 error => $error,
225 biblionumber => $biblionumber || Koha::Items->find($itemnumber)->biblionumber,
226 itemnumber => $itemnumber,
230 output_html_with_http_headers $input, $cookie, $template->output;
232 exit 0;
234 =head1 AUTHORS
236 Written by Jared Camins-Esakov of C & P Bibliography Services, in part based on
237 code by Koustubha Kale of Anant Corporation and Chris Nighswonger of Foundation
238 Bible College.
240 =cut