Koha-community/Koha
13
7
Fork 0
Code Issues Releases Wiki Activity

[4/30] Modifications to picture upload script to accommodate image sizes up to 200 X 300 pixel dimesions.

Browse source 
This also changes the storage image format to PNG which is lossless (an important factor when using these
images for patroncards).

NOTE: In the end, this script was *not* used for uploading images for patron cards. However, these changes
are left as an improvement upon this script which is used for patron image uploads.

This script could be greatly reduced in size by using Graphics::Magick and working along the same lines
as the upload code found in patroncards/image-manage.pl
This commit is contained in:
Chris Nighswonger 2009-09-23 10:32:12 -04:00
parent 278007e847
commit 3b1d56ccb5
1 changed files with 13 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
tools/picture-upload.pl
View file

@ -104,9 +104,9 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope
while ( my $entry = readdir $dir ) {
push @directories, "$recursive_dir/$entry" if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ );
$debug and warn "$recursive_dir/$entry";
}
}
closedir $dir;
}
}
my $results;
foreach my $dir ( @directories ) {
$results = handle_dir( $dir, $filesuffix );
@ -133,7 +133,7 @@ if ( ($op eq 'Upload') && $uploadfile ) { # Case is important in these ope
TCOUNTS => ($filecount > 0 ? $filecount : undef),
);
$template->param( borrowernumber => $borrowernumber ) if $borrowernumber;
}
}
}
} elsif ( ($op eq 'Upload') && !$uploadfile ) {
warn "Problem uploading file or no file uploaded.";
@ -154,14 +154,14 @@ sub handle_dir {
my ( $dir, $suffix ) = @_;
my $source;
$debug and warn "Entering sub handle_dir; passed \$dir=$dir, \$suffix=$suffix";
if ($suffix =~ m/zip/i) { # If we were sent a zip file, process any included data/idlink.txt files
if ($suffix =~ m/zip/i) { # If we were sent a zip file, process any included data/idlink.txt files
my ( $file, $filename, $cardnumber );
$debug and warn "Passed a zip file.";
opendir my $dirhandle, $dir;
while ( my $filename = readdir $dirhandle ) {
$file = "$dir/$filename" if ($filename =~ m/datalink\.txt/i || $filename =~ m/idlink\.txt/i);
}
unless (open (FILE, $file)) {
unless (open (FILE, $file)) {
warn "Opening $dir/$file failed!";
$errors{'OPNLINK'} = $file;
return $errors; # This error is fatal to the import of this directory contents, so bail and return the error to the caller
@ -210,7 +210,7 @@ sub handle_file {
}
$debug and warn "Source: $source";
my $size = (stat($source))[7];
if ($size > 100000) { # This check is necessary even with image resizing to avoid possible security/performance issues...
if ($size > 200000) { # This check is necessary even with image resizing to avoid possible security/performance issues...
$filerrors{'OVRSIZ'} = 1;
push my @filerrors, \%filerrors;
push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber };
@ -222,14 +222,14 @@ sub handle_file {
$srcimage = GD::Image->new(*IMG);
close (IMG);
if (defined $srcimage) {
my $mimetype = 'image/jpeg'; # GD autodetects three basic image formats: PNG, JPEG, XPM; we will convert all to JPEG...
my $mimetype = 'image/png'; # GD autodetects three basic image formats: PNG, JPEG, XPM; we will convert all to PNG which is lossless...
# Check the pixel size of the image we are about to import...
my ($width, $height) = $srcimage->getBounds();
$debug and warn "$filename is $width pix X $height pix.";
if ($width > 140 || $height > 200) { # MAX pixel dims are 140 X 200...
$debug and warn "$filename exceeds the maximum pixel dimensions of 140 X 200. Resizing...";
if ($width > 200 || $height > 300) { # MAX pixel dims are 200 X 300...
$debug and warn "$filename exceeds the maximum pixel dimensions of 200 X 300. Resizing...";
my $percent_reduce; # Percent we will reduce the image dimensions by...
if ($width > 140) {
if ($width > 200) {
$percent_reduce = sprintf("%.5f",(140/$width)); # If the width is oversize, scale based on width overage...
} else {
$percent_reduce = sprintf("%.5f",(200/$height)); # otherwise scale based on height overage.
@ -239,13 +239,13 @@ sub handle_file {
$debug and warn "Reducing $filename by " . ($percent_reduce * 100) . "\% or to $width_reduce pix X $height_reduce pix";
$image = GD::Image->new($width_reduce, $height_reduce, 1); #'1' creates true color image...
$image->copyResampled($srcimage,0,0,0,0,$width_reduce,$height_reduce,$width,$height);
$imgfile = $image->jpeg(100);
$imgfile = $image->png();
$debug and warn "$filename is " . length($imgfile) . " bytes after resizing.";
undef $image;
undef $srcimage; # This object can get big...
} else {
$image = $srcimage;
$imgfile = $image->jpeg();
$imgfile = $image->png();
$debug and warn "$filename is " . length($imgfile) . " bytes.";
undef $image;
undef $srcimage; # This object can get big...
@ -285,7 +285,7 @@ sub handle_file {
}
} else { # The need for this seems a bit unlikely, however, to maximize error trapping it is included
warn "Missing " . ($cardnumber ? "filename" : ($filename ? "cardnumber" : "cardnumber and filename"));
$filerrors{'CRDFIL'} = ($cardnumber ? "filename" : ($filename ? "cardnumber" : "cardnumber and filename"));
$filerrors{'CRDFIL'} = ($cardnumber ? "filename" : ($filename ? "cardnumber" : "cardnumber and filename"));
push my @filerrors, \%filerrors;
push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber };
$template->param( ERRORS => 1 );