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

(-)a/tools/picture-upload.pl (-166 / +261 lines)
Lines 42-53 my ($template, $loggedinuser, $cookie) Link Here
42
					debug => 0,
42
					debug => 0,
43
					});
43
					});
44
44
45
my $filetype            = $input->param('filetype');
45
my $filetype       = $input->param('filetype');
46
my $cardnumber          = $input->param('cardnumber');
46
my $cardnumber     = $input->param('cardnumber');
47
my $uploadfilename      = $input->param('uploadfile');
47
my $uploadfilename = $input->param('uploadfile');
48
my $uploadfile          = $input->upload('uploadfile');
48
my $uploadfile     = $input->upload('uploadfile');
49
my $borrowernumber      = $input->param('borrowernumber');
49
my $borrowernumber = $input->param('borrowernumber');
50
my $op                  = $input->param('op');
50
my $op             = $input->param('op');
51
51
52
#FIXME: This code is really in the rough. The variables need to be re-scoped as the two subs depend on global vars to operate.
52
#FIXME: This code is really in the rough. The variables need to be re-scoped as the two subs depend on global vars to operate.
53
#       Other parts of this code could be optimized as well, I think. Perhaps the file upload could be done with YUI's upload
53
#       Other parts of this code could be optimized as well, I think. Perhaps the file upload could be done with YUI's upload
Lines 74-157 $debug and warn "Operation requested: $op"; Link Here
74
74
75
my ( $total, $handled, @counts, $tempfile, $tfh, %errors );
75
my ( $total, $handled, @counts, $tempfile, $tfh, %errors );
76
76
77
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 ) {
78
    my $dirname = File::Temp::tempdir( CLEANUP => 1);
78
    # 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 );
79
    $debug and warn "dirname = $dirname";
80
    $debug and warn "dirname = $dirname";
80
    my $filesuffix;
81
    my $filesuffix;
81
    if ( $uploadfilename =~ m/(\..+)$/i ) {
82
    if ( $uploadfilename =~ m/(\..+)$/i ) {
82
        $filesuffix = $1;
83
        $filesuffix = $1;
83
    }
84
    }
84
    ( $tfh, $tempfile ) = File::Temp::tempfile( SUFFIX => $filesuffix, UNLINK => 1 );
85
    ( $tfh, $tempfile ) =
86
      File::Temp::tempfile( SUFFIX => $filesuffix, UNLINK => 1 );
85
    $debug and warn "tempfile = $tempfile";
87
    $debug and warn "tempfile = $tempfile";
86
    my ( @directories, $results );
88
    my ( @directories, $results );
87
89
88
    $errors{'NOTZIP'} = 1 if ( $uploadfilename !~ /\.zip$/i && $filetype =~ m/zip/i );
90
    $errors{'NOTZIP'} = 1
91
      if ( $uploadfilename !~ /\.zip$/i && $filetype =~ m/zip/i );
89
    $errors{'NOWRITETEMP'} = 1 unless ( -w $dirname );
92
    $errors{'NOWRITETEMP'} = 1 unless ( -w $dirname );
90
    $errors{'EMPTYUPLOAD'} = 1 unless ( length( $uploadfile ) > 0 );
93
    $errors{'EMPTYUPLOAD'} = 1 unless ( length($uploadfile) > 0 );
91
94
92
    if ( %errors ) {
95
    if (%errors) {
93
        $template->param( ERRORS => [ \%errors ] );
96
        $template->param( ERRORS => [ \%errors ] );
94
        output_html_with_http_headers $input, $cookie, $template->output;
97
        output_html_with_http_headers $input, $cookie, $template->output;
95
        exit;
98
        exit;
96
    }
99
    }
97
	while ( <$uploadfile> ) {
100
    while (<$uploadfile>) {
98
	    print $tfh $_;
101
        print $tfh $_;
102
    }
103
    close $tfh;
104
    if ( $filetype eq 'zip' ) {
105
        unless ( system( "unzip", $tempfile, '-d', $dirname ) == 0 ) {
106
            $errors{'UZIPFAIL'} = $uploadfilename;
107
            $template->param( ERRORS => [ \%errors ] );
108
            # This error is fatal to the import, so bail out here
109
            output_html_with_http_headers $input, $cookie, $template->output;
110
            exit;
99
        }
111
        }
100
        close $tfh;
112
        push @directories, "$dirname";
101
        if ( $filetype eq 'zip' ) {
113
        foreach my $recursive_dir (@directories) {
102
            unless (system("unzip", $tempfile,  '-d', $dirname) == 0) {
114
            opendir RECDIR, $recursive_dir;
103
                $errors{'UZIPFAIL'} = $uploadfilename;
115
            while ( my $entry = readdir RECDIR ) {
104
	        $template->param( ERRORS => [ \%errors ] );
116
                push @directories, "$recursive_dir/$entry"
105
                output_html_with_http_headers $input, $cookie, $template->output;   # This error is fatal to the import, so bail out here
117
                  if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ );
106
                exit;
107
            }
108
            push @directories, "$dirname";
109
            foreach my $recursive_dir ( @directories ) {
110
                opendir RECDIR, $recursive_dir;
111
                while ( my $entry = readdir RECDIR ) {
112
	        push @directories, "$recursive_dir/$entry" if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ );
113
                $debug and warn "$recursive_dir/$entry";
118
                $debug and warn "$recursive_dir/$entry";
114
                }
115
                closedir RECDIR;
116
            }
117
            foreach my $dir ( @directories ) {
118
                $results = handle_dir( $dir, $filesuffix, $template );
119
                $handled++ if $results == 1;
120
            }
119
            }
121
            $total = scalar @directories;
120
            closedir RECDIR;
122
        } else {       #if ($filetype eq 'zip' )
123
            $results = handle_dir( $dirname, $filesuffix, $template, $cardnumber, $tempfile );
124
            $handled = 1;
125
            $total = 1;
126
        }
121
        }
127
122
        foreach my $dir (@directories) {
128
        if ( %$results || %errors ) {
123
            $results = handle_dir( $dir, $filesuffix, $template );
129
            $template->param( ERRORS => [ $results ] );
124
            $handled++ if $results == 1;
130
        } else {
131
			my $filecount;
132
			map {$filecount += $_->{count}} @counts;
133
            $debug and warn "Total directories processed: $total";
134
            $debug and warn "Total files processed: $filecount";
135
            $template->param(
136
		 	TOTAL => $total,
137
		 	HANDLED => $handled,
138
		 	COUNTS => \@counts,
139
			TCOUNTS => ($filecount > 0 ? $filecount : undef),
140
            );
141
			$template->param( borrowernumber => $borrowernumber ) if $borrowernumber;
142
        }
125
        }
143
} elsif ( ($op eq 'Upload') && !$uploadfile ) {
126
        $total = scalar @directories;
127
    }
128
    else {
129
        #if ($filetype eq 'zip' )
130
        $results = handle_dir( $dirname, $filesuffix, $template, $cardnumber,
131
            $tempfile );
132
        $handled = 1;
133
        $total   = 1;
134
    }
135
136
    if ( %$results || %errors ) {
137
        $template->param( ERRORS => [$results] );
138
    }
139
    else {
140
        my $filecount;
141
        map { $filecount += $_->{count} } @counts;
142
        $debug and warn "Total directories processed: $total";
143
        $debug and warn "Total files processed: $filecount";
144
        $template->param(
145
            TOTAL   => $total,
146
            HANDLED => $handled,
147
            COUNTS  => \@counts,
148
            TCOUNTS => ( $filecount > 0 ? $filecount : undef ),
149
        );
150
        $template->param( borrowernumber => $borrowernumber )
151
          if $borrowernumber;
152
    }
153
}
154
elsif ( ( $op eq 'Upload' ) && !$uploadfile ) {
144
    warn "Problem uploading file or no file uploaded.";
155
    warn "Problem uploading file or no file uploaded.";
145
    $template->param(cardnumber => $cardnumber);
156
    $template->param( cardnumber => $cardnumber );
146
    $template->param(filetype => $filetype);
157
    $template->param( filetype   => $filetype );
147
} elsif ( $op eq 'Delete' ) {
158
}
148
    my $dberror = RmPatronImage($borrowernumber);
159
elsif ( $op eq 'Delete' ) {
149
	$debug and warn "Patron image deleted for $cardnumber";
160
    my $dberror = RmPatronImage($cardnumber);
161
    $debug and warn "Patron image deleted for $cardnumber";
150
    warn "Database returned $dberror" if $dberror;
162
    warn "Database returned $dberror" if $dberror;
151
}
163
}
152
if ( $borrowernumber && !%errors && !$template->param('ERRORS') ) {
164
if ( $borrowernumber && !%errors && !$template->param('ERRORS') ) {
153
    print $input->redirect ("/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber");
165
    print $input->redirect(
154
} else {
166
        "/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber");
167
}
168
else {
155
    output_html_with_http_headers $input, $cookie, $template->output;
169
    output_html_with_http_headers $input, $cookie, $template->output;
156
}
170
}
157
171
Lines 159-302 sub handle_dir { Link Here
159
    my ( $dir, $suffix, $template, $cardnumber, $source ) = @_;
173
    my ( $dir, $suffix, $template, $cardnumber, $source ) = @_;
160
    my ( %counts, %direrrors );
174
    my ( %counts, %direrrors );
161
    $debug and warn "Entering sub handle_dir; passed \$dir=$dir, \$suffix=$suffix";
175
    $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
176
    if ( $suffix =~ m/zip/i ) {
177
        # If we were sent a zip file, process any included data/idlink.txt files
163
        my ( $file, $filename );
178
        my ( $file, $filename );
164
        undef $cardnumber;
179
        undef $cardnumber;
165
        $debug and warn "Passed a zip file.";
180
        $debug and warn "Passed a zip file.";
166
        opendir DIR, $dir;
181
        opendir DIR, $dir;
167
        while ( my $filename = readdir DIR ) {
182
        while ( my $filename = readdir DIR ) {
168
            $file = "$dir/$filename" if ($filename =~ m/datalink\.txt/i || $filename =~ m/idlink\.txt/i);
183
            $file = "$dir/$filename"
184
              if ( $filename =~ m/datalink\.txt/i
185
                || $filename =~ m/idlink\.txt/i );
186
        }
187
        unless ( open( FILE, $file ) ) {
188
            warn "Opening $dir/$file failed!";
189
            $direrrors{'OPNLINK'} = $file;
190
            # This error is fatal to the import of this directory contents
191
            # so bail and return the error to the caller
192
            return \%direrrors;
169
        }
193
        }
170
        unless (open (FILE, $file)) {
171
		warn "Opening $dir/$file failed!";
172
                $direrrors{'OPNLINK'} = $file;
173
		return \%direrrors; # This error is fatal to the import of this directory contents, so bail and return the error to the caller
174
        };
175
194
176
        while (my $line = <FILE>) {
195
        while ( my $line = <FILE> ) {
177
            $debug and warn "Reading contents of $file";
196
            $debug and warn "Reading contents of $file";
178
	    chomp $line;
197
            chomp $line;
179
            $debug and warn "Examining line: $line";
198
            $debug and warn "Examining line: $line";
180
	    my $delim = ($line =~ /\t/) ? "\t" : ($line =~ /,/) ? "," : "";
199
            my $delim = ( $line =~ /\t/ ) ? "\t" : ( $line =~ /,/ ) ? "," : "";
181
            $debug and warn "Delimeter is \'$delim\'";
200
            $debug and warn "Delimeter is \'$delim\'";
182
            unless ( $delim eq "," || $delim eq "\t" ) {
201
            unless ( $delim eq "," || $delim eq "\t" ) {
183
                warn "Unrecognized or missing field delimeter. Please verify that you are using either a ',' or a 'tab'";
202
                warn "Unrecognized or missing field delimeter. Please verify that you are using either a ',' or a 'tab'";
184
                $direrrors{'DELERR'} = 1;      # This error is fatal to the import of this directory contents, so bail and return the error to the caller
203
                $direrrors{'DELERR'} = 1;
204
                # This error is fatal to the import of this directory contents
205
                # so bail and return the error to the caller
185
                return \%direrrors;
206
                return \%direrrors;
186
            }
207
            }
187
	    ($cardnumber, $filename) = split $delim, $line;
208
            ( $cardnumber, $filename ) = split $delim, $line;
188
	    $cardnumber =~ s/[\"\r\n]//g;  # remove offensive characters
209
            $cardnumber =~ s/[\"\r\n]//g; # remove offensive characters
189
	    $filename   =~ s/[\"\r\n\s]//g;
210
            $filename   =~ s/[\"\r\n\s]//g;
190
            $debug and warn "Cardnumber: $cardnumber Filename: $filename";
211
            $debug and warn "Cardnumber: $cardnumber Filename: $filename";
191
            $source = "$dir/$filename";
212
            $source = "$dir/$filename";
192
            %counts = handle_file($cardnumber, $source, $template, %counts);
213
            %counts = handle_file( $cardnumber, $source, $template, %counts );
193
        }
214
        }
194
        close FILE;
215
        close FILE;
195
        closedir DIR;
216
        closedir DIR;
196
    } else {
197
        %counts = handle_file($cardnumber, $source, $template, %counts);
198
    }
217
    }
199
push @counts, \%counts;
218
    else {
200
return 1;
219
        %counts = handle_file( $cardnumber, $source, $template, %counts );
220
    }
221
    push @counts, \%counts;
222
    return 1;
201
}
223
}
202
224
203
sub handle_file {
225
sub handle_file {
204
    my ($cardnumber, $source, $template, %count) = @_;
226
    my ( $cardnumber, $source, $template, %count ) = @_;
205
    $debug and warn "Entering sub handle_file; passed \$cardnumber=$cardnumber, \$source=$source";
227
    $debug and warn "Entering sub handle_file; passed \$cardnumber=$cardnumber, \$source=$source";
206
    $count{filenames} = () if !$count{filenames};
228
    $count{filenames} = ()      if !$count{filenames};
207
    $count{source} = $source if !$count{source};
229
    $count{source}    = $source if !$count{source};
208
    my %filerrors;
230
    my %filerrors;
209
    my $filename;
231
    my $filename;
210
    if ($filetype eq 'image') {
232
    if ( $filetype eq 'image' ) {
211
        $filename = $uploadfilename;
233
        $filename = $uploadfilename;
212
    } else {
213
        $filename = $1 if ($source && $source =~ /\/([^\/]+)$/);
214
    }
234
    }
215
    if ($cardnumber && $source) {     # Now process any imagefiles
235
    else {
236
        $filename = $1 if ( $source && $source =~ /\/([^\/]+)$/ );
237
    }
238
    if ( $cardnumber && $source ) {
239
        # Now process any imagefiles
216
        $debug and warn "Source: $source";
240
        $debug and warn "Source: $source";
217
        my $size = (stat($source))[7];
241
        my $size = ( stat($source) )[7];
218
            if ($size > 550000) {    # This check is necessary even with image resizing to avoid possible security/performance issues...
242
        if ( $size > 550000 ) {
219
                $filerrors{'OVRSIZ'} = 1;
243
            # This check is necessary even with image resizing to avoid possible security/performance issues...
220
                push my @filerrors, \%filerrors;
244
            $filerrors{'OVRSIZ'} = 1;
221
                push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber };
245
            push my @filerrors, \%filerrors;
222
                $template->param( ERRORS => 1 );
246
            push @{ $count{filenames} },
223
                return %count;    # this one is fatal so bail here...
247
              {
224
            }
248
                filerrors  => \@filerrors,
225
        my ($srcimage, $image);
249
                source     => $filename,
226
        if (open (IMG, "$source")) {
250
                cardnumber => $cardnumber
251
              };
252
            $template->param( ERRORS => 1 );
253
            # this one is fatal so bail here...
254
            return %count;
255
        }
256
        my ( $srcimage, $image );
257
        if ( open( IMG, "$source" ) ) {
227
            $srcimage = GD::Image->new(*IMG);
258
            $srcimage = GD::Image->new(*IMG);
228
            close (IMG);
259
            close(IMG);
229
			if (defined $srcimage) {
260
            if ( defined $srcimage ) {
230
				my $imgfile;
261
                my $imgfile;
231
				my $mimetype = 'image/png';	# GD autodetects three basic image formats: PNG, JPEG, XPM; we will convert all to PNG which is lossless...
262
                my $mimetype = 'image/png';
232
				# Check the pixel size of the image we are about to import...
263
                # GD autodetects three basic image formats: PNG, JPEG, XPM
233
				my ($width, $height) = $srcimage->getBounds();
264
                # we will convert all to PNG which is lossless...
234
				$debug and warn "$filename is $width pix X $height pix.";
265
                # Check the pixel size of the image we are about to import...
235
				if ($width > 200 || $height > 300) {    # MAX pixel dims are 200 X 300...
266
                my ( $width, $height ) = $srcimage->getBounds();
236
					$debug and warn "$filename exceeds the maximum pixel dimensions of 200 X 300. Resizing...";
267
                $debug and warn "$filename is $width pix X $height pix.";
237
					my $percent_reduce;    # Percent we will reduce the image dimensions by...
268
                if ( $width > 200 || $height > 300 ) {
238
					if ($width > 200) {
269
                    # MAX pixel dims are 200 X 300...
239
						$percent_reduce = sprintf("%.5f",(140/$width));    # If the width is oversize, scale based on width overage...
270
                    $debug and warn "$filename exceeds the maximum pixel dimensions of 200 X 300. Resizing...";
240
					} else {
271
                    # Percent we will reduce the image dimensions by...
241
						$percent_reduce = sprintf("%.5f",(200/$height));    # otherwise scale based on height overage.
272
                    my $percent_reduce;
242
					}
273
                    if ( $width > 200 ) {
243
					my $width_reduce = sprintf("%.0f", ($width * $percent_reduce));
274
                        # If the width is oversize, scale based on width overage...
244
					my $height_reduce = sprintf("%.0f", ($height * $percent_reduce));
275
                        $percent_reduce = sprintf( "%.5f", ( 140 / $width ) );
245
					$debug and warn "Reducing $filename by " . ($percent_reduce * 100) . "\% or to $width_reduce pix X $height_reduce pix";
276
                    }
246
					$image = GD::Image->new($width_reduce, $height_reduce, 1); #'1' creates true color image...
277
                    else {
247
					$image->copyResampled($srcimage,0,0,0,0,$width_reduce,$height_reduce,$width,$height);
278
                        # otherwise scale based on height overage.
248
					$imgfile = $image->png();
279
                        $percent_reduce = sprintf( "%.5f", ( 200 / $height ) );
249
					$debug and warn "$filename is " . length($imgfile) . " bytes after resizing.";
280
                    }
250
					undef $image;
281
                    my $width_reduce =
251
					undef $srcimage;    # This object can get big...
282
                      sprintf( "%.0f", ( $width * $percent_reduce ) );
252
				} else {
283
                    my $height_reduce =
253
					$image = $srcimage;
284
                      sprintf( "%.0f", ( $height * $percent_reduce ) );
254
					$imgfile = $image->png();
285
                    $debug
255
					$debug and warn "$filename is " . length($imgfile) . " bytes.";
286
                      and warn "Reducing $filename by "
256
					undef $image;
287
                      . ( $percent_reduce * 100 )
257
					undef $srcimage;    # This object can get big...
288
                      . "\% or to $width_reduce pix X $height_reduce pix";
258
				}
289
                    #'1' creates true color image...
259
				$debug and warn "Image is of mimetype $mimetype";
290
                    $image = GD::Image->new( $width_reduce, $height_reduce, 1 );
291
                    $image->copyResampled( $srcimage, 0, 0, 0, 0, $width_reduce,
292
                        $height_reduce, $width, $height );
293
                    $imgfile = $image->png();
294
                    $debug
295
                      and warn "$filename is "
296
                      . length($imgfile)
297
                      . " bytes after resizing.";
298
                    undef $image;
299
                    undef $srcimage; # This object can get big...
300
                }
301
                else {
302
                    $image   = $srcimage;
303
                    $imgfile = $image->png();
304
                    $debug
305
                      and warn "$filename is " . length($imgfile) . " bytes.";
306
                    undef $image;
307
                    undef $srcimage; # This object can get big...
308
                }
309
                $debug and warn "Image is of mimetype $mimetype";
260
                my $dberror;
310
                my $dberror;
261
                if ($mimetype) {
311
                if ($mimetype) {
262
                    $dberror = PutPatronImage( $cardnumber, $mimetype, $imgfile );
312
                    $dberror =
313
                      PutPatronImage( $cardnumber, $mimetype, $imgfile );
314
                }
315
                if ( !$dberror && $mimetype ) {
316
                    # Errors from here on are fatal only to the import of a particular image
317
                    #so don't bail, just note the error and keep going
318
                    $count{count}++;
319
                    push @{ $count{filenames} },
320
                      { source => $filename, cardnumber => $cardnumber };
321
                }
322
                elsif ($dberror) {
323
                    warn "Database returned error: $dberror";
324
                    ( $dberror =~ /patronimage_fk1/ )
325
                      ? $filerrors{'IMGEXISTS'} = 1
326
                      : $filerrors{'DBERR'} = 1;
327
                    push my @filerrors, \%filerrors;
328
                    push @{ $count{filenames} },
329
                      {
330
                        filerrors  => \@filerrors,
331
                        source     => $filename,
332
                        cardnumber => $cardnumber
333
                      };
334
                    $template->param( ERRORS => 1 );
263
                }
335
                }
264
                if ( !$dberror && $mimetype ) { # Errors from here on are fatal only to the import of a particular image, so don't bail, just note the error and keep going
336
                elsif ( !$mimetype ) {
265
					$count{count}++;
337
                    warn "Unable to determine mime type of $filename. Please verify mimetype.";
266
					push @{ $count{filenames} }, { source => $filename, cardnumber => $cardnumber };
338
                    $filerrors{'MIMERR'} = 1;
267
				} elsif ( $dberror ) {
339
                    push my @filerrors, \%filerrors;
268
						warn "Database returned error: $dberror";
340
                    push @{ $count{filenames} },
269
						($dberror =~ /patronimage_fk1/) ? $filerrors{'IMGEXISTS'} = 1 : $filerrors{'DBERR'} = 1;
341
                      {
270
						push my @filerrors, \%filerrors;
342
                        filerrors  => \@filerrors,
271
						push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber };
343
                        source     => $filename,
272
						$template->param( ERRORS => 1 );
344
                        cardnumber => $cardnumber
273
				} elsif ( !$mimetype ) {
345
                      };
274
					warn "Unable to determine mime type of $filename. Please verify mimetype.";
346
                    $template->param( ERRORS => 1 );
275
					$filerrors{'MIMERR'} = 1;
347
                }
276
					push my @filerrors, \%filerrors;
348
            }
277
					push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber };
349
            else {
278
					$template->param( ERRORS => 1 );
350
                warn "Contents of $filename corrupted!";
279
				}
351
                #	$count{count}--;
280
			} else {
352
                $filerrors{'CORERR'} = 1;
281
				warn "Contents of $filename corrupted!";
353
                push my @filerrors, \%filerrors;
282
			#	$count{count}--;
354
                push @{ $count{filenames} },
283
				$filerrors{'CORERR'} = 1;
355
                  {
284
				push my @filerrors, \%filerrors;
356
                    filerrors  => \@filerrors,
285
				push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber };
357
                    source     => $filename,
286
				$template->param( ERRORS => 1 );
358
                    cardnumber => $cardnumber
287
			}
359
                  };
288
		} else {
360
                $template->param( ERRORS => 1 );
289
			warn "Opening $source failed!";
361
            }
290
			$filerrors{'OPNERR'} = 1;
362
        }
291
			push my @filerrors, \%filerrors;
363
        else {
292
			push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber };
364
            warn "Opening $source failed!";
293
			$template->param( ERRORS => 1 );
365
            $filerrors{'OPNERR'} = 1;
294
		}
366
            push my @filerrors, \%filerrors;
295
    } else {    # The need for this seems a bit unlikely, however, to maximize error trapping it is included
367
            push @{ $count{filenames} },
296
        warn "Missing " . ($cardnumber ? "filename" : ($filename ? "cardnumber" : "cardnumber and filename"));
368
              {
297
        $filerrors{'CRDFIL'} = ($cardnumber ? "filename" : ($filename ? "cardnumber" : "cardnumber and filename"));
369
                filerrors  => \@filerrors,
370
                source     => $filename,
371
                cardnumber => $cardnumber
372
              };
373
            $template->param( ERRORS => 1 );
374
        }
375
    }
376
    else {
377
        # The need for this seems a bit unlikely, however, to maximize error trapping it is included
378
        warn "Missing "
379
          . (
380
            $cardnumber
381
            ? "filename"
382
            : ( $filename ? "cardnumber" : "cardnumber and filename" )
383
          );
384
        $filerrors{'CRDFIL'} = (
385
            $cardnumber
386
            ? "filename"
387
            : ( $filename ? "cardnumber" : "cardnumber and filename" )
388
        );
298
        push my @filerrors, \%filerrors;
389
        push my @filerrors, \%filerrors;
299
		push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber };
390
        push @{ $count{filenames} },
391
          {
392
            filerrors  => \@filerrors,
393
            source     => $filename,
394
            cardnumber => $cardnumber
395
          };
300
        $template->param( ERRORS => 1 );
396
        $template->param( ERRORS => 1 );
301
    }
397
    }
302
    return (%count);
398
    return (%count);
303
- 

Return to bug 9312