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

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

Return to bug 9312