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