Bug 26265: (QA follow-up) Remove g option from regex, add few dirs
[koha-equinox.git] / patroncards / image-manage.pl
1 #!/usr/bin/perl
2
3 use Modern::Perl;
4
5 use CGI qw ( -utf8 );
6 use Graphics::Magick;
7 use POSIX qw(ceil);
8
9 use C4::Context;
10 use C4::Auth;
11 use C4::Output;
12 use C4::Debug;
13 use C4::Creators;
14 use C4::Patroncards;
15
16 my $cgi = CGI->new;
17
18 my ($template, $loggedinuser, $cookie) = get_template_and_user({
19                     template_name       => "patroncards/image-manage.tt",
20                     query               => $cgi,
21                     type                => "intranet",
22                     authnotrequired     => 0,
23                     flagsrequired       => {tools => 'batch_upload_patron_images'}, # FIXME: establish flag for patron card creator
24                     debug               => 0,
25                     });
26
27 my $file_name = $cgi->param('uploadfile') || '';
28 my $image_name = $cgi->param('image_name') || $file_name;
29 my $upload_file = $cgi->upload('uploadfile') || '';
30 my $op = $cgi->param('op') || 'none';
31 my @image_ids = $cgi->multi_param('image_id') if $cgi->param('image_id');
32
33 my $source_file = "$file_name"; # otherwise we end up with what amounts to a pointer to a filehandle rather than a user-friendly filename
34
35 my $display_columns = { image =>    [  #{db column      => {label => 'col label', is link?          }},
36                                         {image_id       => {label => 'ID',      link_field      => 0}},
37                                         {image_name     => {label => 'Name',    link_field      => 0}},
38                                         {_delete        => {label => 'Delete', link_field => 0}},
39                                         {select         => {label => 'Select',  value           => 'image_id'}},
40                                     ],
41 };
42 my $table = html_table($display_columns->{'image'}, get_image(undef, "image_id, image_name"));
43
44 my $image_limit = C4::Context->preference('ImageLimit') || '';
45 my $errstr = '';        # NOTE: For error codes see error-messages.inc
46
47 if ($op eq 'upload') {
48     # Checking for duplicate image name
49     my $dbh = C4::Context->dbh;
50     my $query = "SELECT COUNT(*) FROM creator_images WHERE image_name=?";
51     my ( $exists ) = $dbh->selectrow_array( $query, undef, $image_name );
52     if ( $exists ) {
53         $errstr = 304;
54         $template->param(
55             IMPORT_SUCCESSFUL => 0,
56             SOURCE_FILE => $source_file,
57             IMAGE_NAME => $image_name,
58             TABLE => $table,
59             error => $errstr,
60         );
61     } else {
62         if (!$upload_file) {
63             warn sprintf('An error occurred while attempting to upload file %s.', $source_file);
64             $errstr = 301;
65             $template->param(
66                 IMPORT_SUCCESSFUL => 0,
67                 SOURCE_FILE => $source_file,
68                 IMAGE_NAME => $image_name,
69                 TABLE => $table,
70                 error => $errstr,
71             );
72         }
73         else {
74             my $image = Graphics::Magick->new;
75             eval{$image->Read($cgi->tmpFileName($file_name));};
76             if ($@) {
77                 warn sprintf('An error occurred while creating the image object: %s',$@);
78                 $errstr = 202;
79                 $template->param(
80                     IMPORT_SUCCESSFUL => 0,
81                     SOURCE_FILE => $source_file,
82                     IMAGE_NAME => $image_name,
83                     TABLE => $table,
84                     error => $errstr,
85                 );
86             }
87             else {
88                 my $errstr = '';
89                 my $size = $image->Get('filesize');
90                 $errstr =  302 if $size > 500000;
91                 $image->Set(magick => 'png'); # convert all images to png as this is a lossless format which is important for resizing operations later on
92                 my $err = put_image($image_name, $image->ImageToBlob()) || '0';
93                 $errstr = 101 if $err == 1;
94                 $errstr = 303 if $err == 202;
95                 if ($errstr) {
96                     $template->param(
97                         IMPORT_SUCCESSFUL => 0,
98                         SOURCE_FILE => $source_file,
99                         IMAGE_NAME => $image_name,
100                         TABLE => $table,
101                         error => $errstr,
102                         image_limit => $image_limit,
103                     );
104                 }
105                 else {
106                     $table = html_table($display_columns->{'image'}, get_image(undef, "image_id, image_name"));  # refresh table data after successfully performing save operation
107                     $template->param(
108                         IMPORT_SUCCESSFUL => 1,
109                         SOURCE_FILE => $source_file,
110                         IMAGE_NAME => $image_name,
111                         TABLE => $table,
112                     );
113                 }
114             }
115         }
116     }
117 }
118 elsif ($op eq 'delete') {
119     my $err = '';
120     my $errstr = '';
121     if (@image_ids) {
122         $err = rm_image(\@image_ids);
123         $errstr = 102 if $err;
124     }
125     else {
126         warn sprintf('No image ids passed in to delete.');
127         $errstr = 202;
128     }
129     if ($errstr) {
130         $template->param(
131             DELETE_SUCCESSFULL => 0,
132             IMAGE_IDS => join(', ', @image_ids),
133             TABLE => $table,
134             error => $errstr,
135             image_ids => join(',',@image_ids),
136         );
137     }
138     else {
139         $table = html_table($display_columns->{'image'}, get_image(undef, "image_id, image_name"));  # refresh table data after successfully performing delete operation
140         $template->param(
141             DELETE_SUCCESSFULL => 1,
142             TABLE => $table,
143         );
144     }
145 }
146 elsif ($op eq 'none') {
147     $template->param(
148         IMPORT_SUCCESSFUL => 0,
149         SOURCE_FILE => $source_file,
150         IMAGE_NAME => $image_name,
151         TABLE => $table,
152     );
153 }
154 else { # to trap unsupported operations
155     warn sprintf('Image upload interface called an unsupported operation: %s',$op);
156     $errstr = 201;
157     $template->param(
158         IMPORT_SUCCESSFUL => 0,
159         SOURCE_FILE => $source_file,
160         IMAGE_NAME => $image_name,
161         TABLE => $table,
162         error => $errstr,
163     );
164 }
165
166 output_html_with_http_headers $cgi, $cookie, $template->output;
167
168 __END__
169
170 =head1 NAME
171
172 image-upload.pl - Script for handling uploading of single images and importing them into the database.
173
174 =head1 SYNOPSIS
175
176 image-upload.pl
177
178 =head1 DESCRIPTION
179
180 This script is called and presents the user with an interface allowing him/her to upload a single image file. Files greater than 500K will be refused.
181
182 =head1 AUTHOR
183
184 Chris Nighswonger <cnighswonger AT foundations DOT edu>
185
186 =head1 COPYRIGHT
187
188 Copyright 2009 Foundations Bible College.
189
190 =head1 LICENSE
191
192 This file is part of Koha.
193
194 Koha is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software
195 Foundation; either version 2 of the License, or (at your option) any later version.
196
197 You should have received a copy of the GNU General Public License along with Koha; if not, write to the Free Software Foundation, Inc., 51 Franklin Street,
198 Fifth Floor, Boston, MA 02110-1301 USA.
199
200 =head1 DISCLAIMER OF WARRANTY
201
202 Koha is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
203 A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
204
205 =cut