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

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

Return to bug 9312