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

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

Return to bug 9312