Bug 19410: (follow-up) Fix typo in POD
[koha.git] / tools / upload-cover-image.pl
blobdd73bbbe590821ca28f9aa05954dc5fb16b00fa6
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 strict;
41 use warnings;
43 use File::Temp;
44 use CGI qw ( -utf8 );
45 use GD;
46 use C4::Context;
47 use C4::Auth;
48 use C4::Output;
49 use C4::Images;
50 use Koha::UploadedFiles;
51 use C4::Log;
53 my $debug = 1;
55 my $input = new CGI;
57 my $fileID = $input->param('uploadedfileid');
58 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
60 template_name => "tools/upload-images.tt",
61 query => $input,
62 type => "intranet",
63 authnotrequired => 0,
64 flagsrequired => { tools => 'upload_local_cover_images' },
65 debug => 0,
69 my $filetype = $input->param('filetype');
70 my $biblionumber = $input->param('biblionumber');
71 #my $uploadfilename = $input->param('uploadfile'); # obsolete?
72 my $replace = !C4::Context->preference("AllowMultipleCovers")
73 || $input->param('replace');
74 my $op = $input->param('op');
75 my %cookies = parse CGI::Cookie($cookie);
76 my $sessionID = $cookies{'CGISESSID'}->value;
78 my $error;
80 $template->{VARS}->{'filetype'} = $filetype;
81 $template->{VARS}->{'biblionumber'} = $biblionumber;
83 my $total = 0;
85 if ($fileID) {
86 my $upload = Koha::UploadedFiles->find( $fileID );
87 if ( $filetype eq 'image' ) {
88 my $fh = $upload->file_handle;
89 my $srcimage = GD::Image->new($fh);
90 $fh->close if $fh;
91 if ( defined $srcimage ) {
92 my $dberror = PutImage( $biblionumber, $srcimage, $replace );
93 if ($dberror) {
94 $error = 'DBERR';
96 else {
97 $total = 1;
100 else {
101 $error = 'OPNIMG';
103 undef $srcimage;
105 else {
106 my $filename = $upload->full_path;
107 my $dirname = File::Temp::tempdir( CLEANUP => 1 );
108 unless ( system( "unzip", $filename, '-d', $dirname ) == 0 ) {
109 $error = 'UZIPFAIL';
111 else {
112 my @directories;
113 push @directories, "$dirname";
114 foreach my $recursive_dir (@directories) {
115 my $dir;
116 opendir $dir, $recursive_dir;
117 while ( my $entry = readdir $dir ) {
118 push @directories, "$recursive_dir/$entry"
119 if ( -d "$recursive_dir/$entry" and $entry !~ /^[._]/ );
121 closedir $dir;
123 foreach my $dir (@directories) {
124 my $file;
125 if ( -e "$dir/idlink.txt" ) {
126 $file = "$dir/idlink.txt";
128 elsif ( -e "$dir/datalink.txt" ) {
129 $file = "$dir/datalink.txt";
131 else {
132 next;
134 if ( open( FILE, $file ) ) {
135 while ( my $line = <FILE> ) {
136 my $delim =
137 ( $line =~ /\t/ ) ? "\t"
138 : ( $line =~ /,/ ) ? ","
139 : "";
141 #$debug and warn "Delimeter is \'$delim\'";
142 unless ( $delim eq "," || $delim eq "\t" ) {
143 warn
144 "Unrecognized or missing field delimeter. Please verify that you are using either a ',' or a 'tab'";
145 $error = 'DELERR';
147 else {
148 ( $biblionumber, $filename ) = split $delim, $line, 2;
149 $biblionumber =~
150 s/[\"\r\n]//g; # remove offensive characters
151 $filename =~ s/[\"\r\n]//g;
152 $filename =~ s/^\s+//;
153 $filename =~ s/\s+$//;
154 if (C4::Context->preference("CataloguingLog")) {
155 logaction('CATALOGUING', 'MODIFY', $biblionumber, "biblio cover image: $filename");
157 my $srcimage = GD::Image->new("$dir/$filename");
158 if ( defined $srcimage ) {
159 $total++;
160 my $dberror =
161 PutImage( $biblionumber, $srcimage,
162 $replace );
163 if ($dberror) {
164 $error = 'DBERR';
167 else {
168 $error = 'OPNIMG';
170 undef $srcimage;
173 close(FILE);
175 else {
176 $error = 'OPNLINK';
181 $template->{VARS}->{'total'} = $total;
182 $template->{VARS}->{'uploadimage'} = 1;
183 $template->{VARS}->{'error'} = $error;
184 $template->{VARS}->{'biblionumber'} = $biblionumber;
187 output_html_with_http_headers $input, $cookie, $template->output;
189 exit 0;
191 =head1 AUTHORS
193 Written by Jared Camins-Esakov of C & P Bibliography Services, in part based on
194 code by Koustubha Kale of Anant Corporation and Chris Nighswonger of Foundation
195 Bible College.
197 =cut