Bug 17573: Remove itemtype-related warnings from DecreaseLoanHighHolds.t
[koha.git] / patroncards / image-manage.pl
blob78f0463e60cb6f6c460459dbc0391b2430206620
1 #!/usr/bin/perl
3 use warnings;
4 use strict;
6 use CGI qw ( -utf8 );
7 use Graphics::Magick;
8 use POSIX qw(ceil);
9 use autouse 'Data::Dumper' => qw(Dumper);
11 use C4::Context;
12 use C4::Auth;
13 use C4::Output;
14 use C4::Debug;
15 use C4::Creators;
16 use C4::Patroncards;
18 my $cgi = CGI->new;
20 my ($template, $loggedinuser, $cookie) = get_template_and_user({
21 template_name => "patroncards/image-manage.tt",
22 query => $cgi,
23 type => "intranet",
24 authnotrequired => 0,
25 flagsrequired => {tools => 'batch_upload_patron_images'}, # FIXME: establish flag for patron card creator
26 debug => 0,
27 });
29 my $image_name = $cgi->param('image_name') || '';
30 my $file_name = $cgi->param('uploadfile') || '';
31 my $upload_file = $cgi->upload('uploadfile') || '';
32 my $op = $cgi->param('op') || 'none';
33 my @image_ids = $cgi->multi_param('image_id') if $cgi->param('image_id');
35 my $source_file = "$file_name"; # otherwise we end up with what amounts to a pointer to a filehandle rather than a user-friendly filename
37 my $display_columns = { image => [ #{db column => {label => 'col label', is link? }},
38 {image_id => {label => 'ID', link_field => 0}},
39 {image_name => {label => 'Name', link_field => 0}},
40 {_delete => {label => 'Delete', link_field => 0}},
41 {select => {label => 'Select', value => 'image_id'}},
44 my $table = html_table($display_columns->{'image'}, get_image(undef, "image_id, image_name"));
46 my $image_limit = C4::Context->preference('ImageLimit') || '';
47 my $errstr = ''; # NOTE: For error codes see error-messages.inc
49 if ($op eq 'upload') {
50 if (!$upload_file) {
51 warn sprintf('An error occurred while attempting to upload file %s.', $source_file);
52 $errstr = 301;
53 $template->param(
54 IMPORT_SUCCESSFUL => 0,
55 SOURCE_FILE => $source_file,
56 IMAGE_NAME => $image_name,
57 TABLE => $table,
58 error => $errstr,
61 else {
62 my $image = Graphics::Magick->new;
63 eval{$image->Read($cgi->tmpFileName($file_name));};
64 if ($@) {
65 warn sprintf('An error occurred while creating the image object: %s',$@);
66 $errstr = 202;
67 $template->param(
68 IMPORT_SUCCESSFUL => 0,
69 SOURCE_FILE => $source_file,
70 IMAGE_NAME => $image_name,
71 TABLE => $table,
72 error => $errstr,
75 else {
76 my $errstr = '';
77 my $size = $image->Get('filesize');
78 $errstr = 302 if $size > 500000;
79 $image->Set(magick => 'png'); # convert all images to png as this is a lossless format which is important for resizing operations later on
80 my $err = put_image($image_name, $image->ImageToBlob()) || '0';
81 $errstr = 101 if $err == 1;
82 $errstr = 303 if $err == 202;
83 if ($errstr) {
84 $template->param(
85 IMPORT_SUCCESSFUL => 0,
86 SOURCE_FILE => $source_file,
87 IMAGE_NAME => $image_name,
88 TABLE => $table,
89 error => $errstr,
90 image_limit => $image_limit,
93 else {
94 $table = html_table($display_columns->{'image'}, get_image(undef, "image_id, image_name")); # refresh table data after successfully performing save operation
95 $template->param(
96 IMPORT_SUCCESSFUL => 1,
97 SOURCE_FILE => $source_file,
98 IMAGE_NAME => $image_name,
99 TABLE => $table,
105 elsif ($op eq 'delete') {
106 my $err = '';
107 my $errstr = '';
108 if (@image_ids) {
109 $err = rm_image(\@image_ids);
110 $errstr = 102 if $err;
112 else {
113 warn sprintf('No image ids passed in to delete.');
114 $errstr = 202;
116 if ($errstr) {
117 $template->param(
118 DELETE_SUCCESSFULL => 0,
119 IMAGE_IDS => join(', ', @image_ids),
120 TABLE => $table,
121 error => $errstr,
122 image_ids => join(',',@image_ids),
125 else {
126 $table = html_table($display_columns->{'image'}, get_image(undef, "image_id, image_name")); # refresh table data after successfully performing delete operation
127 $template->param(
128 DELETE_SUCCESSFULL => 1,
129 TABLE => $table,
133 elsif ($op eq 'none') {
134 $template->param(
135 IMPORT_SUCCESSFUL => 0,
136 SOURCE_FILE => $source_file,
137 IMAGE_NAME => $image_name,
138 TABLE => $table,
141 else { # to trap unsupported operations
142 warn sprintf('Image upload interface called an unsupported operation: %s',$op);
143 $errstr = 201;
144 $template->param(
145 IMPORT_SUCCESSFUL => 0,
146 SOURCE_FILE => $source_file,
147 IMAGE_NAME => $image_name,
148 TABLE => $table,
149 error => $errstr,
153 output_html_with_http_headers $cgi, $cookie, $template->output;
155 __END__
157 =head1 NAME
159 image-upload.pl - Script for handling uploading of single images and importing them into the database.
161 =head1 SYNOPSIS
163 image-upload.pl
165 =head1 DESCRIPTION
167 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.
169 =head1 AUTHOR
171 Chris Nighswonger <cnighswonger AT foundations DOT edu>
173 =head1 COPYRIGHT
175 Copyright 2009 Foundations Bible College.
177 =head1 LICENSE
179 This file is part of Koha.
181 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
182 Foundation; either version 2 of the License, or (at your option) any later version.
184 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,
185 Fifth Floor, Boston, MA 02110-1301 USA.
187 =head1 DISCLAIMER OF WARRANTY
189 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
190 A PARTICULAR PURPOSE. See the GNU General Public License for more details.
192 =cut