View | Details | Raw Unified | Return to bug 9312
Collapse All | Expand All

(-)a/tools/picture-upload.pl (-30 / +30 lines)
Lines 19-26 Link Here
19
#
19
#
20
#
20
#
21
21
22
#use strict;
22
use Modern::Perl;
23
#use warnings; FIXME - Bug 2505
24
23
25
use File::Temp;
24
use File::Temp;
26
use File::Copy;
25
use File::Copy;
Lines 73-79 Files greater than 100K will be refused. Images should be 140x200 pixels. If the Link Here
73
72
74
$debug and warn "Operation requested: $op";
73
$debug and warn "Operation requested: $op";
75
74
76
my ( $total, $handled, @counts, $tempfile, $tfh );
75
my ( $total, $handled, @counts, $tempfile, $tfh, %errors );
77
76
78
if ( ($op eq 'Upload') && $uploadfile ) {       # Case is important in these operational values as the template must use case to be visually pleasing!
77
if ( ($op eq 'Upload') && $uploadfile ) {       # Case is important in these operational values as the template must use case to be visually pleasing!
79
    my $dirname = File::Temp::tempdir( CLEANUP => 1);
78
    my $dirname = File::Temp::tempdir( CLEANUP => 1);
Lines 84-98 if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope Link Here
84
    }
83
    }
85
    ( $tfh, $tempfile ) = File::Temp::tempfile( SUFFIX => $filesuffix, UNLINK => 1 );
84
    ( $tfh, $tempfile ) = File::Temp::tempfile( SUFFIX => $filesuffix, UNLINK => 1 );
86
    $debug and warn "tempfile = $tempfile";
85
    $debug and warn "tempfile = $tempfile";
87
    my ( @directories, $errors );
86
    my ( @directories, $results );
88
87
89
    $errors{'NOTZIP'} = 1 if ( $uploadfilename !~ /\.zip$/i && $filetype =~ m/zip/i );
88
    $errors{'NOTZIP'} = 1 if ( $uploadfilename !~ /\.zip$/i && $filetype =~ m/zip/i );
90
    $errors{'NOWRITETEMP'} = 1 unless ( -w $dirname );
89
    $errors{'NOWRITETEMP'} = 1 unless ( -w $dirname );
91
    $errors{'EMPTYUPLOAD'} = 1 unless ( length( $uploadfile ) > 0 );
90
    $errors{'EMPTYUPLOAD'} = 1 unless ( length( $uploadfile ) > 0 );
92
91
93
    if ( %errors ) {
92
    if ( %errors ) {
94
	$template->param( ERRORS => [ \%errors ] );
93
        $template->param( ERRORS => [ \%errors ] );
95
    } else {
94
        output_html_with_http_headers $input, $cookie, $template->output;
95
        exit;
96
    }
96
	while ( <$uploadfile> ) {
97
	while ( <$uploadfile> ) {
97
	    print $tfh $_;
98
	    print $tfh $_;
98
        }
99
        }
Lines 105-119 if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope Link Here
105
                exit;
106
                exit;
106
            }
107
            }
107
            push @directories, "$dirname";
108
            push @directories, "$dirname";
108
            foreach $recursive_dir ( @directories ) {
109
            foreach my $recursive_dir ( @directories ) {
109
                opendir $dir, $recursive_dir;
110
                opendir RECDIR, $recursive_dir;
110
                while ( my $entry = readdir $dir ) {
111
                while ( my $entry = readdir RECDIR ) {
111
	        push @directories, "$recursive_dir/$entry" if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ );
112
	        push @directories, "$recursive_dir/$entry" if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ );
112
                $debug and warn "$recursive_dir/$entry";
113
                $debug and warn "$recursive_dir/$entry";
113
                }
114
                }
114
                closedir $dir;
115
                closedir RECDIR;
115
            }
116
            }
116
            my $results;
117
            foreach my $dir ( @directories ) {
117
            foreach my $dir ( @directories ) {
118
                $results = handle_dir( $dir, $filesuffix, $template );
118
                $results = handle_dir( $dir, $filesuffix, $template );
119
                $handled++ if $results == 1;
119
                $handled++ if $results == 1;
Lines 126-132 if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope Link Here
126
        }
126
        }
127
127
128
        if ( %$results || %errors ) {
128
        if ( %$results || %errors ) {
129
            $template->param( ERRORS => [ \%$results ] );
129
            $template->param( ERRORS => [ $results ] );
130
        } else {
130
        } else {
131
			my $filecount;
131
			my $filecount;
132
			map {$filecount += $_->{count}} @counts;
132
			map {$filecount += $_->{count}} @counts;
Lines 140-146 if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope Link Here
140
            );
140
            );
141
			$template->param( borrowernumber => $borrowernumber ) if $borrowernumber;
141
			$template->param( borrowernumber => $borrowernumber ) if $borrowernumber;
142
        }
142
        }
143
    }
144
} elsif ( ($op eq 'Upload') && !$uploadfile ) {
143
} elsif ( ($op eq 'Upload') && !$uploadfile ) {
145
    warn "Problem uploading file or no file uploaded.";
144
    warn "Problem uploading file or no file uploaded.";
146
    $template->param(cardnumber => $cardnumber);
145
    $template->param(cardnumber => $cardnumber);
Lines 150-156 if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope Link Here
150
	$debug and warn "Patron image deleted for $cardnumber";
149
	$debug and warn "Patron image deleted for $cardnumber";
151
    warn "Database returned $dberror" if $dberror;
150
    warn "Database returned $dberror" if $dberror;
152
}
151
}
153
if ( $borrowernumber && !$errors && !$template->param('ERRORS') ) {
152
if ( $borrowernumber && !%errors && !$template->param('ERRORS') ) {
154
    print $input->redirect ("/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber");
153
    print $input->redirect ("/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber");
155
} else {
154
} else {
156
    output_html_with_http_headers $input, $cookie, $template->output;
155
    output_html_with_http_headers $input, $cookie, $template->output;
Lines 158-176 if ( $borrowernumber && !$errors && !$template->param('ERRORS') ) { Link Here
158
157
159
sub handle_dir {
158
sub handle_dir {
160
    my ( $dir, $suffix, $template, $cardnumber, $source ) = @_;
159
    my ( $dir, $suffix, $template, $cardnumber, $source ) = @_;
160
    my ( %counts, %direrrors );
161
    $debug and warn "Entering sub handle_dir; passed \$dir=$dir, \$suffix=$suffix";
161
    $debug and warn "Entering sub handle_dir; passed \$dir=$dir, \$suffix=$suffix";
162
    if ($suffix =~ m/zip/i) {     # If we were sent a zip file, process any included data/idlink.txt files
162
    if ($suffix =~ m/zip/i) {     # If we were sent a zip file, process any included data/idlink.txt files
163
        my ( $file, $filename );
163
        my ( $file, $filename );
164
        undef $cardnumber;
164
        undef $cardnumber;
165
        $debug and warn "Passed a zip file.";
165
        $debug and warn "Passed a zip file.";
166
        opendir my $dirhandle, $dir;
166
        opendir DIR, $dir;
167
        while ( my $filename = readdir $dirhandle ) {
167
        while ( my $filename = readdir DIR ) {
168
            $file = "$dir/$filename" if ($filename =~ m/datalink\.txt/i || $filename =~ m/idlink\.txt/i);
168
            $file = "$dir/$filename" if ($filename =~ m/datalink\.txt/i || $filename =~ m/idlink\.txt/i);
169
        }
169
        }
170
        unless (open (FILE, $file)) {
170
        unless (open (FILE, $file)) {
171
		warn "Opening $dir/$file failed!";
171
		warn "Opening $dir/$file failed!";
172
                $errors{'OPNLINK'} = $file;
172
                $direrrors{'OPNLINK'} = $file;
173
		return $errors; # This error is fatal to the import of this directory contents, so bail and return the error to the caller
173
		return \%direrrors; # This error is fatal to the import of this directory contents, so bail and return the error to the caller
174
        };
174
        };
175
175
176
        while (my $line = <FILE>) {
176
        while (my $line = <FILE>) {
Lines 181-188 sub handle_dir { Link Here
181
            $debug and warn "Delimeter is \'$delim\'";
181
            $debug and warn "Delimeter is \'$delim\'";
182
            unless ( $delim eq "," || $delim eq "\t" ) {
182
            unless ( $delim eq "," || $delim eq "\t" ) {
183
                warn "Unrecognized or missing field delimeter. Please verify that you are using either a ',' or a 'tab'";
183
                warn "Unrecognized or missing field delimeter. Please verify that you are using either a ',' or a 'tab'";
184
                $errors{'DELERR'} = 1;      # This error is fatal to the import of this directory contents, so bail and return the error to the caller
184
                $direrrors{'DELERR'} = 1;      # This error is fatal to the import of this directory contents, so bail and return the error to the caller
185
                return $errors;
185
                return \%direrrors;
186
            }
186
            }
187
	    ($cardnumber, $filename) = split $delim, $line;
187
	    ($cardnumber, $filename) = split $delim, $line;
188
	    $cardnumber =~ s/[\"\r\n]//g;  # remove offensive characters
188
	    $cardnumber =~ s/[\"\r\n]//g;  # remove offensive characters
Lines 192-198 sub handle_dir { Link Here
192
            %counts = handle_file($cardnumber, $source, $template, %counts);
192
            %counts = handle_file($cardnumber, $source, $template, %counts);
193
        }
193
        }
194
        close FILE;
194
        close FILE;
195
        closedir ($dirhandle);
195
        closedir DIR;
196
    } else {
196
    } else {
197
        %counts = handle_file($cardnumber, $source, $template, %counts);
197
        %counts = handle_file($cardnumber, $source, $template, %counts);
198
    }
198
    }
Lines 205-218 sub handle_file { Link Here
205
    $debug and warn "Entering sub handle_file; passed \$cardnumber=$cardnumber, \$source=$source";
205
    $debug and warn "Entering sub handle_file; passed \$cardnumber=$cardnumber, \$source=$source";
206
    $count{filenames} = () if !$count{filenames};
206
    $count{filenames} = () if !$count{filenames};
207
    $count{source} = $source if !$count{source};
207
    $count{source} = $source if !$count{source};
208
    my %filerrors;
209
    my $filename;
210
    if ($filetype eq 'image') {
211
        $filename = $uploadfilename;
212
    } else {
213
        $filename = $1 if ($source && $source =~ /\/([^\/]+)$/);
214
    }
208
    if ($cardnumber && $source) {     # Now process any imagefiles
215
    if ($cardnumber && $source) {     # Now process any imagefiles
209
        my %filerrors;
210
        my $filename;
211
        if ($filetype eq 'image') {
212
            $filename = $uploadfilename;
213
        } else {
214
            $filename = $1 if ($source =~ /\/([^\/]+)$/);
215
        }
216
        $debug and warn "Source: $source";
216
        $debug and warn "Source: $source";
217
        my $size = (stat($source))[7];
217
        my $size = (stat($source))[7];
218
            if ($size > 550000) {    # This check is necessary even with image resizing to avoid possible security/performance issues...
218
            if ($size > 550000) {    # This check is necessary even with image resizing to avoid possible security/performance issues...
Lines 227-232 sub handle_file { Link Here
227
            $srcimage = GD::Image->new(*IMG);
227
            $srcimage = GD::Image->new(*IMG);
228
            close (IMG);
228
            close (IMG);
229
			if (defined $srcimage) {
229
			if (defined $srcimage) {
230
				my $imgfile;
230
				my $mimetype = 'image/png';	# GD autodetects three basic image formats: PNG, JPEG, XPM; we will convert all to PNG which is lossless...
231
				my $mimetype = 'image/png';	# GD autodetects three basic image formats: PNG, JPEG, XPM; we will convert all to PNG which is lossless...
231
				# Check the pixel size of the image we are about to import...
232
				# Check the pixel size of the image we are about to import...
232
				my ($width, $height) = $srcimage->getBounds();
233
				my ($width, $height) = $srcimage->getBounds();
Lines 285-291 sub handle_file { Link Here
285
				$template->param( ERRORS => 1 );
286
				$template->param( ERRORS => 1 );
286
			}
287
			}
287
		} else {
288
		} else {
288
			warn "Opening $dir/$filename failed!";
289
			warn "Opening $source failed!";
289
			$filerrors{'OPNERR'} = 1;
290
			$filerrors{'OPNERR'} = 1;
290
			push my @filerrors, \%filerrors;
291
			push my @filerrors, \%filerrors;
291
			push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber };
292
			push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber };
292
- 

Return to bug 9312