version 1.1.1.1, 2004/07/23 17:58:24
|
version 1.4, 2004/11/18 20:10:17
|
Line 1
|
Line 1
|
#!/usr/bin/perl |
#!/usr/bin/perl |
|
|
|
# Copyright (C) 2003,2004 Robert Casties, IT-Group MPIWG |
|
# |
|
# This program is free software; you can redistribute it and/or modify it |
|
# under the terms of the GNU General Public License as published by the Free |
|
# Software Foundation; either version 2 of the License, or (at your option) |
|
# any later version. |
|
# |
|
# Please read license.txt for the full details. A copy of the GPL may be found |
|
# at http://www.gnu.org/copyleft/lgpl.html |
|
# |
|
# You should have received a copy of the GNU General Public License along with |
|
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple |
|
# Place, Suite 330, Boston, MA 02111-1307 USA |
|
|
|
use strict; |
|
use sigtrap qw(die normal-signals); |
|
|
|
# MPIWG libraries |
|
use lib '/usr/local/mpiwg/scripts'; |
|
use MPIWGlib; |
|
|
|
|
$| = 1; # unblock IO |
$| = 1; # unblock IO |
|
|
$version = "V0.7 (ROC 23.12.2003)"; |
my $version = "V0.9.3 (ROC 18.11.2004)"; |
|
|
$debug = 0; |
$debug = 0; |
$simulate = 0; |
|
|
|
$do_descend = 1; |
my $simulate = 0; |
|
|
@source_base_dirs = ("/docuserver/images"); |
my $do_descend = 1; |
$dest_base_dir = "/docuserver/scaled/small"; |
|
$dir_perm = 0775; |
|
$file_perm = 0664; |
|
|
|
umask 000; # to make shure we can actually use these perms |
my $dir_perm = 0775; |
|
my $file_perm = 0664; |
|
|
$dont_overwrite = 1; # don't overwrite already converted files |
umask 000; # to make shure we can actually use these perms |
|
|
@imgfile_ext = ("tif", "tiff", "gif", "jpg", "png"); |
my $overwrite = 0; # overwrite already converted files |
|
|
$target_size = 2048; # pixel of longest side |
# image file extensions and formats |
$scale_relative = 0; # scale by relative factor instead of destination size |
my %img_type_ext = ("tif" => "TIFF", "tiff" => "TIFF", "gif" => "GIF", |
$jpeg_quality = 75; # default JPEG compression quality |
"jpg" => "JPEG", "png" => "PNG"); |
|
# destination image file extensions |
|
my %target_ext_type = ("TIFF" => "jpg", "JPEG" => "jpg"); |
|
|
|
# default scale settings |
|
my $scalesize = 2048; # pixel of longest side |
|
my $scale_relative = 0; # scale by relative factor instead of destination size |
|
my $jpeg_quality = 75; # default JPEG compression quality |
|
my $use_encoder = 0; # autodetect encoder |
|
|
|
# programs to use |
|
my $identifier; |
|
my $tiffinfo; |
|
my $jpegloader; |
|
my $tiffloader; |
|
my $quantizer; |
|
my $scaler; |
|
my $jpegwriter; |
|
my $pngwriter; |
|
my $converter; |
|
|
########################################################################## |
########################################################################## |
# subroutines |
# subroutines |
Line 39 sub checksoft {
|
Line 77 sub checksoft {
|
|
|
$identifier = findfile(\@softdirs, "identify") |
$identifier = findfile(\@softdirs, "identify") |
or die("ABORT: neccessary external program not found: identify"); |
or die("ABORT: neccessary external program not found: identify"); |
|
$tiffinfo = findfile(\@softdirs, "tiffinfo") |
|
or die("ABORT: neccessary external program not found: tiffinfo"); |
$jpegloader = findfile(\@softdirs, "jpegtopnm") |
$jpegloader = findfile(\@softdirs, "jpegtopnm") |
or die("ABORT: neccessary external program not found: jpegtopnm"); |
or die("ABORT: neccessary external program not found: jpegtopnm"); |
$tiffloader = findfile(\@softdirs, "tifftopnm") |
$tiffloader = findfile(\@softdirs, "tifftopnm") |
Line 59 sub checksoft {
|
Line 99 sub checksoft {
|
|
|
|
|
# |
# |
# dprint($message) |
|
# |
|
# print if $debug = 1 |
|
# |
|
sub dprint { |
|
my ($msg) = @_; |
|
|
|
if ($debug) { |
|
print "$msg"; |
|
} |
|
} |
|
|
|
|
|
|
|
# |
|
# findir(\@basedirs, $subdir) |
# findir(\@basedirs, $subdir) |
# |
# |
# check directories in @basedirs+$subdir and return the first existing basedir |
# check directories in @basedirs+$subdir and return the first existing basedir |
Line 106 sub findfile {
|
Line 131 sub findfile {
|
} |
} |
|
|
|
|
|
sub cleanpath { |
|
my ($path, $startslash) = @_; |
|
|
|
if ($path =~ /^(\/)*(.*?)\/*$/) { |
|
if ($startslash) { |
|
print "$path --> $1$2\n"; |
|
return $1 . $2; |
|
} else { |
|
print "$path --> $2\n"; |
|
return $2; |
|
} |
|
} |
|
print "hä? $path\n"; |
|
return $path; |
|
} |
|
|
|
# |
|
# ($basename, $extension) = splitfn($filename) |
|
# |
|
# split filename into base and (lowercase) extension |
|
# |
|
sub splitfn { |
|
my ($filepath) = @_; |
|
if ($filepath =~ /^(.*)\.(\w+)$/) { |
|
return ($1, lc($2)); |
|
} |
|
return; |
|
} |
|
|
|
|
# |
# |
# mmkdir($dirname) |
# mmkdir($dirname) |
# |
# |
Line 116 sub mmkdir {
|
Line 171 sub mmkdir {
|
my $newdir; |
my $newdir; |
|
|
# does the directory already exist? |
# does the directory already exist? |
if (-d $dir) { |
if (-d $dirname) { |
chmod $dir_perm, $dir or do { |
chmod $dir_perm, $dirname or do { |
print "ERROR: unable to change permission on $dir!\n"; |
logger('WARNING', "unable to change permission on $dirname!"); |
return 0; |
|
}; |
}; |
return 1; |
return 1; |
} |
} |
Line 129 sub mmkdir {
|
Line 183 sub mmkdir {
|
my $dir = join("/", @dirlist); |
my $dir = join("/", @dirlist); |
# test backwards which directories exist |
# test backwards which directories exist |
while (not -d $dir) { |
while (not -d $dir) { |
|
last unless ($dir); |
# move missing elements from the end of @dirlist to @newlist |
# move missing elements from the end of @dirlist to @newlist |
unshift @newlist, pop @dirlist; |
unshift @newlist, pop @dirlist; |
$dir = join("/", @dirlist); |
$dir = join("/", @dirlist); |
Line 138 sub mmkdir {
|
Line 193 sub mmkdir {
|
push @dirlist, $newdir; |
push @dirlist, $newdir; |
$dir = join("/", @dirlist); |
$dir = join("/", @dirlist); |
mkdir "$dir", $dir_perm or do { |
mkdir "$dir", $dir_perm or do { |
print "ERROR: unable to create $dir!\n"; |
logger('ERROR', "unable to create $dir!"); |
return 0; |
return 0; |
} |
} |
} |
} |
Line 146 sub mmkdir {
|
Line 201 sub mmkdir {
|
} |
} |
|
|
# |
# |
# dir_ok($dirname) |
# ($type, $width, $height) = identify($filepath) |
# |
# |
# check directory name against evil |
sub identify { |
# |
my ($filepath) = @_; |
sub dir_ok { |
my $pictype = ""; |
my($dirname) = @_; |
my $picwidth = 0; |
|
my $picheight = 0; |
if ($dirname eq "") { |
my $bitdepth = 0; |
print "ERROR: DIR mustn't be empty!\n"; |
# use quickident first |
return 0; |
$pictype = quickident($filepath); |
|
# optimize tiff identification |
|
if (($pictype)&&($pictype eq 'TIFF')) { |
|
logger('DEBUG', "running tiffinfo $tiffinfo"); |
|
if (open(IDENT, "nice -10 $tiffinfo '$filepath' 2>/dev/null |")) { |
|
while (<IDENT>) { |
|
chomp; |
|
if (/Image Width:\s*(\d+)\s*Image Length:\s*(\d+)/) { |
|
$picwidth = $1 if ($1 > $picwidth); |
|
$picheight = $2 if ($2 > $picheight); |
|
next; |
} |
} |
if ($dirname =~ /\.\./) { |
if (/Bits\/Sample:\s*(\d+)/) { |
print "ERROR: DIR mustn't backref!\n"; |
$bitdepth = $1 if ($1 > $bitdepth); |
return 0; |
next; |
} |
} |
if ($dirname =~ /[|<>]+/) { |
|
print "ERROR: DIR mustn't be special!\n"; |
|
return 0; |
|
} |
} |
return 1; |
if ($picwidth) { |
|
logger('DEBUG', "TIFF $picwidth x $picheight"); |
|
return ($pictype, $picwidth, $picheight, $bitdepth); |
|
} |
|
} |
|
} |
|
# run ident to get image type and dimensions |
|
logger('DEBUG', "running identifier $identifier"); |
|
if (open(IDENT, "nice -10 $identifier -ping -format '%w %h %m\n' '$filepath' 2>/dev/null |")) { |
|
my @id = <IDENT>; |
|
my $picinfo = $id[0]; |
|
close IDENT; |
|
chomp $picinfo; |
|
logger('DEBUG', "PIC is '$picinfo'"); |
|
if ($picinfo =~ /^(\d+) (\d+) (\w+)$/) { |
|
$picwidth = $1; |
|
$picheight = $2; |
|
$pictype = $3; |
|
} |
|
} else { |
|
logger('DEBUG', "unable to identify $filepath!"); |
|
} |
|
return ($pictype, $picwidth, $picheight, $bitdepth); |
|
} |
|
|
|
# |
|
# $type = quickident($filepath); |
|
# |
|
sub quickident { |
|
my ($filepath) = @_; |
|
logger('DEBUG', "running quickident"); |
|
# look at file extension |
|
my ($filebase, $fileext) = splitfn($filepath); |
|
if ($fileext) { |
|
return $img_type_ext{$fileext}; |
|
} |
|
return; |
} |
} |
|
|
|
|
# |
# |
# convert_file($filename) |
# $error = scale_jpeg(\$args); |
# |
# |
# convert file |
# scale JPEG images to JPEG using netpbm tools |
# |
# |
sub convert_file { |
# args needed: $srcdir, $filename, $destdir, |
my($basedir, $filename) = @_; |
# $scalesize, $scale_rel, $picwidth, $picheight |
my $newfn; |
# |
my $pictype; |
sub scale_jpeg { |
my $picwidth; |
my ($args) = @_; |
my $picheight; |
|
my $scaleopt = 0.3; |
|
|
|
if (not (( -f "$basedir/$filename") && (-r _))) { |
my $srcdir = $$args{'srcdir'}; |
print "ERROR: unable to read file '$basedir/$filename'\n;"; |
my $filename = $$args{'filename'}; |
|
my $destdir = $$args{'destdir'}; |
|
my $scalesize = $$args{'scalesize'}; |
|
my $scale_rel = $$args{'scale_rel'}; |
|
my $scaleopt; |
|
|
|
# convert jpg -> jpg |
|
my ($basename, $fileext) = splitfn($filename); |
|
my $newfn = $basename . ".jpg"; |
|
logger('INFO', "Convert(jpg): $filename -> $newfn"); |
|
return 1 if ($simulate); |
|
|
|
if ($scale_rel) { |
|
# scale relative -- no size needed, only scaling factor |
|
$scaleopt = $scalesize; |
|
} else { |
|
# scale to size -- size needed |
|
my $pictype = $$args{'pictype'}; |
|
my $picwidth = $$args{'picwidth'}; |
|
my $picheight = $$args{'picheight'}; |
|
if (! $picwidth) { |
|
($pictype, $picwidth, $picheight) = identify("$srcdir/$filename"); |
|
if ((! $pictype)||($picwidth == 0)||($picheight == 0)) { |
|
logger('ERROR', "unable to identify $srcdir/$filename!"); |
|
return 1; |
|
} |
|
} |
|
if ($picheight > $picwidth) { |
|
$scaleopt = $scalesize / $picheight; |
|
logger('DEBUG', "PIC is portrait"); |
|
} else { |
|
$scaleopt = $scalesize / $picwidth; |
|
logger('DEBUG', "PIC is landscape"); |
|
} |
|
if ($scaleopt >= 1) { |
|
$scaleopt = 1; |
|
logger('DEBUG', "PIC is already smaller"); |
|
} |
|
} |
|
|
|
if (!$scaleopt) { |
|
logger('ERROR', "unable to calculate scaling options!"); |
|
return 1; |
|
} |
|
|
|
# convert |
|
logger('DEBUG', "nice -10 $jpegloader '$srcdir/$filename' 2>/dev/null | nice -10 $scaler $scaleopt 2>/dev/null | nice -10 $jpegwriter > '$destdir/$newfn' 2>/dev/null"); |
|
return 0 if ($simulate); |
|
if (system("nice -10 $jpegloader '$srcdir/$filename' 2>/dev/null | nice -10 $scaler $scaleopt 2>/dev/null | nice -10 $jpegwriter > '$destdir/$newfn' 2>/dev/null") != 0) { |
|
logger('ERROR', "error converting '$srcdir/$filename'!"); |
|
unlink "$destdir/$newfn"; |
|
return 1; |
|
} |
|
|
|
# change permissions |
|
chmod $file_perm, "$destdir/$newfn" or |
|
logger('WARNING', "unable to set permission on '$destdir/$newfn'"); |
|
|
|
if (! -s "$destdir/$newfn") { |
|
# file broken (size 0) |
|
logger('ERROR', "created file '$destdir/$newfn' broken -- will be removed!"); |
|
unlink "$destdir/$newfn"; |
|
return 1; |
|
} |
return 0; |
return 0; |
} |
} |
|
|
|
|
# |
# |
# run ident first to get image type and dimensions |
# $error = scale_tiff_jpeg2(\$args); |
# calculate scaling factor based on destination size or factor |
|
# |
# |
if (open(IDENT, "nice -10 $identifier -ping -format '%w %h %m\n' '$basedir/$filename' 2>/dev/null|")) { |
# scale TIFF images to JPEG using ImageMagick convert |
my @id = <IDENT>; |
# |
my $picinfo = $id[0]; |
# args needed: $srcdir, $filename, $destdir, |
close IDENT; |
# $scalesize, $scale_rel, $picwidth, $picheight |
chomp $picinfo; |
# |
dprint "INFO: PIC is $picinfo\n"; |
sub scale_tiff_jpeg2 { |
if ($picinfo =~ /^(\d+) (\d+) (\w+)$/) { |
my ($args) = @_; |
$picwidth = $1; |
|
$picheight = $2; |
my $srcdir = $$args{'srcdir'}; |
$pictype = $3; |
my $filename = $$args{'filename'}; |
if ($scale_relative) { |
my $destdir = $$args{'destdir'}; |
$scaleopt = $target_size; |
my $scalesize = $$args{'scalesize'}; |
|
my $scale_rel = $$args{'scale_rel'}; |
|
my $scaleopt; |
|
|
|
my ($basename, $fileext) = splitfn($filename); |
|
my $newfn = $basename . ".jpg"; |
|
logger('INFO', "Convert(tiff2): $filename -> $newfn"); |
|
return 1 if ($simulate); |
|
|
|
if ($scale_rel) { |
|
# scale relative -- no size needed, only scaling factor |
|
$scaleopt = $scalesize; |
} else { |
} else { |
|
# scale to size -- size needed |
|
my $pictype = $$args{'pictype'}; |
|
my $picwidth = $$args{'picwidth'}; |
|
my $picheight = $$args{'picheight'}; |
|
if (! $picwidth) { |
|
($pictype, $picwidth, $picheight) = identify("$srcdir/$filename"); |
|
if ((! $pictype)||($picwidth == 0)||($picheight == 0)) { |
|
logger('ERROR', "unable to identify $srcdir/$filename!"); |
|
return 1; |
|
} |
|
} |
if ($picheight > $picwidth) { |
if ($picheight > $picwidth) { |
$scaleopt = $target_size / $picheight; |
$scaleopt = $scalesize / $picheight; |
dprint "INFO: PIC is portrait\n"; |
logger('DEBUG', "PIC is portrait"); |
} else { |
} else { |
$scaleopt = $target_size / $picwidth; |
$scaleopt = $scalesize / $picwidth; |
dprint "INFO: PIC is landscape\n"; |
logger('DEBUG', "PIC is landscape"); |
} |
} |
if ($scaleopt >= 1) { |
if ($scaleopt >= 1) { |
$scaleopt = 1; |
$scaleopt = 1; |
dprint "INFO: PIC is already smaller\n"; |
logger('DEBUG', "PIC is already smaller"); |
} |
} |
} |
} |
|
|
|
if (!$scaleopt) { |
|
logger('ERROR', "unable to calculate scaling options!"); |
|
return 1; |
} |
} |
|
|
|
if ($scale_rel) { |
|
my $per_scale = 100 * $scaleopt; |
|
logger('DEBUG', "nice -10 $converter -quality $jpeg_quality -scale $per_scale\% '$srcdir/$filename' '$destdir/$newfn' 2>/dev/null"); |
|
return 0 if ($simulate); |
|
if (system("nice -10 $converter -quality $jpeg_quality -scale $per_scale\% '$srcdir/$filename' '$destdir/$newfn' 2>/dev/null\n") != 0) { |
|
logger('ERROR', "error converting '$srcdir/$filename'!"); |
|
return 1; |
} |
} |
|
} else { |
|
logger('DEBUG', "nice -10 $converter -quality $jpeg_quality -scale ${scalesize}x${scalesize} '$srcdir/$filename' '$destdir/$newfn' 2>/dev/null"); |
|
return 0 if ($simulate); |
|
if (system("nice -10 $converter -quality $jpeg_quality -scale ${scalesize}x${scalesize} '$srcdir/$filename' '$destdir/$newfn' 2>/dev/null\n") != 0) { |
|
logger('ERROR', "error converting '$srcdir/$filename'!"); |
|
return 1; |
|
} |
|
} |
|
|
|
# change permissions |
|
chmod $file_perm, "$destdir/$newfn" or |
|
logger('WARNING', "unable to set permission on '$destdir/$newfn'"); |
|
|
|
if (! -s "$destdir/$newfn") { |
|
# file broken (size 0) |
|
logger('ERROR', "created file '$destdir/$newfn' broken -- will be removed!"); |
|
unlink "$destdir/$newfn"; |
|
return 1; |
|
} |
|
return 0; |
|
} |
|
|
|
|
# |
# |
# scale JPEG images to JPEG using netpbm tools |
# $error = scale_tiff_jpeg(\$args); |
# |
# |
if ($pictype eq 'JPEG') { |
# scale TIFF images to JPEG using netpbm tools |
|
# |
|
# args needed: $srcdir, $filename, $destdir, |
|
# $scalesize, $scale_rel, $picwidth, $picheight |
|
# |
|
sub scale_tiff_jpeg { |
|
my ($args) = @_; |
|
|
|
my $srcdir = $$args{'srcdir'}; |
|
my $filename = $$args{'filename'}; |
|
my $destdir = $$args{'destdir'}; |
|
my $scalesize = $$args{'scalesize'}; |
|
my $scale_rel = $$args{'scale_rel'}; |
|
my $scaleopt; |
|
|
# convert jpg -> jpg |
# convert jpg -> jpg |
$newfn = $filename; |
my ($basename, $fileext) = splitfn($filename); |
$newfn =~ s/\.\w+$/.jpg/; |
my $newfn = $basename . ".jpg"; |
if (-f "$dest_base_dir/$newfn") { |
logger('INFO', "Convert(tiff1): $filename -> $newfn"); |
dprint "INFO CONV file exists: $newfn\n"; |
return 1 if ($simulate); |
if ($dont_overwrite) { |
|
print "INFO: File already converted: $newfn\n"; |
if ($scale_rel) { |
|
# scale relative -- no size needed, only scaling factor |
|
$scaleopt = $scalesize; |
|
} else { |
|
# scale to size -- size needed |
|
my $pictype = $$args{'pictype'}; |
|
my $picwidth = $$args{'picwidth'}; |
|
my $picheight = $$args{'picheight'}; |
|
if (! $picwidth) { |
|
($pictype, $picwidth, $picheight) = identify("$srcdir/$filename"); |
|
if ((! $pictype)||($picwidth == 0)||($picheight == 0)) { |
|
logger('ERROR', "unable to identify $srcdir/$filename!"); |
return 1; |
return 1; |
} |
} |
} |
} |
print "INFO: Convert(jpg): $filename -> $newfn\n"; |
if ($picheight > $picwidth) { |
return 1 if ($simulate); |
$scaleopt = $scalesize / $picheight; |
dprint("nice -10 $jpegloader '$basedir/$filename' 2>/dev/null | nice -10 $scaler $scaleopt 2>/dev/null | nice -10 $jpegwriter > '$dest_base_dir/$newfn' 2>/dev/null\n"); |
logger('DEBUG', "PIC is portrait"); |
if (system("nice -10 $jpegloader '$basedir/$filename' 2>/dev/null | nice -10 $scaler $scaleopt 2>/dev/null | nice -10 $jpegwriter > '$dest_base_dir/$newfn' 2>/dev/null") != 0) { |
} else { |
return 0; |
$scaleopt = $scalesize / $picwidth; |
|
logger('DEBUG', "PIC is landscape"); |
|
} |
|
if ($scaleopt >= 1) { |
|
$scaleopt = 1; |
|
logger('DEBUG', "PIC is already smaller"); |
} |
} |
chmod $file_perm, "$dest_base_dir/$newfn" or |
} |
print "WARNING: unable to set permission on '$dest_base_dir/$newfn'\n"; |
|
|
if (!$scaleopt) { |
|
logger('ERROR', "unable to calculate scaling options!"); |
return 1; |
return 1; |
} |
} |
|
|
# |
# convert |
# scale TIFF images to JPEG using convert |
logger('DEBUG', "nice -10 $tiffloader '$srcdir/$filename' 2>/dev/null | nice -10 $scaler $scaleopt 2>/dev/null | nice -10 $jpegwriter --quality $jpeg_quality > '$destdir/$newfn' 2>/dev/null"); |
# (slower but netpbm doesn't always work) |
return 0 if ($simulate); |
# |
if (system("nice -10 $tiffloader '$srcdir/$filename' 2>/dev/null | nice -10 $scaler $scaleopt 2>/dev/null | nice -10 $jpegwriter --quality $jpeg_quality > '$destdir/$newfn' 2>/dev/null") != 0) { |
if ($pictype eq 'TIFF') { |
logger('ERROR', "error converting '$srcdir/$filename'!"); |
# convert tif -> jpg |
unlink "$destdir/$newfn"; |
$newfn = $filename; |
|
$newfn =~ s/\.\w+$/.jpg/; |
|
if (-f "$dest_base_dir/$newfn") { |
|
dprint "INFO: CONV file exists: $newfn\n"; |
|
if ($dont_overwrite) { |
|
print "INFO: File already converted: $newfn\n"; |
|
return 1; |
return 1; |
} |
} |
|
|
|
# change permissions |
|
chmod $file_perm, "$destdir/$newfn" or |
|
logger('WARNING', "unable to set permission on '$destdir/$newfn'"); |
|
|
|
if (! -s "$destdir/$newfn") { |
|
# file broken (size 0) |
|
logger('ERROR', "created file '$destdir/$newfn' broken -- will be removed!"); |
|
unlink "$destdir/$newfn"; |
|
return 1; |
} |
} |
print "INFO: Convert(tif): $filename -> $newfn\n"; |
|
if ($scale_relative) { |
|
my $per_scale = 100 * $scaleopt; |
|
dprint("nice -10 $converter -quality $jpeg_quality -scale $per_scale\% $basedir/$filename $dest_base_dir/$newfn 2>/dev/null\n"); |
|
return 1 if ($simulate); |
|
if (system("nice -10 $converter -quality $jpeg_quality -scale $per_scale\% '$basedir/$filename' '$dest_base_dir/$newfn' 2>/dev/null\n") != 0) { |
|
return 0; |
return 0; |
} |
} |
|
|
|
|
|
|
|
# |
|
# $error = scale_tiff_png(\$args); |
|
# |
|
# scale TIFF images to PNG using netpbm tools |
|
# |
|
# args needed: $srcdir, $filename, $destdir, |
|
# $scalesize, $scale_rel, $picwidth, $picheight |
|
# |
|
sub scale_tiff_png { |
|
my ($args) = @_; |
|
|
|
my $srcdir = $$args{'srcdir'}; |
|
my $filename = $$args{'filename'}; |
|
my $destdir = $$args{'destdir'}; |
|
my $scalesize = $$args{'scalesize'}; |
|
my $bitdepth = $$args{'bitdepth'}; |
|
my $scale_rel = $$args{'scale_rel'}; |
|
my $scaleopt; |
|
|
|
# convert jpg -> jpg |
|
my ($basename, $fileext) = splitfn($filename); |
|
my $newfn = $basename . ".png"; |
|
logger('INFO', "Convert(tiff3): $filename -> $newfn"); |
|
|
|
if ($scale_rel) { |
|
# scale relative -- no size needed, only scaling factor |
|
$scaleopt = $scalesize; |
|
} else { |
|
# scale to size -- size needed |
|
my $pictype = $$args{'pictype'}; |
|
my $picwidth = $$args{'picwidth'}; |
|
my $picheight = $$args{'picheight'}; |
|
if (! $picwidth) { |
|
($pictype, $picwidth, $picheight, $bitdepth) = identify("$srcdir/$filename"); |
|
if ((! $pictype)||($picwidth == 0)||($picheight == 0)) { |
|
logger('ERROR', "unable to identify $srcdir/$filename!"); |
|
return 1; |
|
} |
|
} |
|
if ($picheight > $picwidth) { |
|
$scaleopt = $scalesize / $picheight; |
|
logger('DEBUG', "PIC is portrait"); |
} else { |
} else { |
dprint("nice -10 $converter -quality $jpeg_quality -scale ${target_size}x${target_size} $basedir/$filename $dest_base_dir/$newfn 2>/dev/null\n"); |
$scaleopt = $scalesize / $picwidth; |
return 1 if ($simulate); |
logger('DEBUG', "PIC is landscape"); |
if (system("nice -10 $converter -quality $jpeg_quality -scale ${target_size}x${target_size} '$basedir/$filename' '$dest_base_dir/$newfn' 2>/dev/null\n") != 0) { |
} |
return 0; |
if ($scaleopt >= 1) { |
|
$scaleopt = 1; |
|
logger('DEBUG', "PIC is already smaller"); |
|
} |
|
} |
|
|
|
if (!$scaleopt) { |
|
logger('ERROR', "unable to calculate scaling options!"); |
|
return 1; |
} |
} |
|
|
|
# convert |
|
my $cmd = "nice -10 $tiffloader \'$srcdir/$filename\' 2>/dev/null "; |
|
if ($bitdepth == 1) { |
|
# antialiasing bilevel images |
|
$cmd .= "| nice -10 $quantizer 2 2 2>/dev/null "; |
} |
} |
chmod $file_perm, "$dest_base_dir/$newfn" or |
$cmd .= "| nice -10 $scaler $scaleopt 2>/dev/null | nice -10 $pngwriter > '$destdir/$newfn' 2>/dev/null"; |
print "WARNING: unable to set permission on '$newfn'\n;"; |
logger('DEBUG', "$cmd"); |
|
return 0 if ($simulate); |
|
if (system($cmd) != 0) { |
|
logger('ERROR', "error converting '$srcdir/$filename'!"); |
|
unlink "$destdir/$newfn"; |
return 1; |
return 1; |
} |
} |
|
|
|
# change permissions |
|
chmod $file_perm, "$destdir/$newfn" or |
|
logger('WARNING', "unable to set permission on '$destdir/$newfn'"); |
|
|
|
if (! -s "$destdir/$newfn") { |
|
# file broken (size 0) |
|
logger('ERROR', "created file '$destdir/$newfn' broken -- will be removed!"); |
|
unlink "$destdir/$newfn"; |
|
return 1; |
|
} |
|
return 0; |
|
} |
|
|
|
|
# |
# |
# convert TIFF to PNG using netpbm tools (not used any more) |
# $error = convert_file($srcdir, $filename, $destdir); |
|
# |
|
# convert file |
# |
# |
if ($pictype eq 'TIFF_old') { |
sub convert_file { |
# convert tif -> png |
my($srcdir, $filename, $destdir) = @_; |
$newfn = $filename; |
my $filebase; |
$newfn =~ s/\.\w+$/.png/; |
my $fileext; |
if (-f "$dest_base_dir/$newfn") { |
my $newfn; |
dprint "INFO: CONV file exists: $newfn\n"; |
my $pictype; |
if ($dont_overwrite) { |
my $picwidth; |
print "INFO: File already converted: $newfn\n"; |
my $picheight; |
|
my $bitdepth; |
|
my $error = 0; |
|
|
|
logger('DEBUG', "convert_file ($srcdir, $filename, $destdir)"); |
|
|
|
if (not (( -f "$srcdir/$filename") && (-r _))) { |
|
logger('ERROR', "unable to read file '$srcdir/$filename'"); |
return 1; |
return 1; |
} |
} |
|
|
|
# get base name and extension |
|
if ($filename =~ /^(.*)\.(\w+)$/) { |
|
$filebase = $1; |
|
$fileext = $2; |
} |
} |
print "INFO: Convert(tif): $filename -> $newfn\n"; |
|
return 1 if ($simulate); |
# |
dprint("nice -10 $tiffloader $basedir/$filename 2>/dev/null | nice -10 $quantizer 2 2 2>/dev/null | nice -10 $scaler $scaleopt 2>/dev/null | nice -10 $pngwriter > $dest_base_dir/$newfn 2>/dev/null\n"); |
# quick check if target image exists |
if (system("nice -10 $tiffloader $basedir/$filename 2>/dev/null | nice -10 $quantizer 2 2 2>/dev/null | nice -10 $scaler $scaleopt 2>/dev/null | nice -10 $pngwriter > $dest_base_dir/$newfn 2>/dev/null") != 0) { |
# |
|
$pictype = quickident("$srcdir/$filename"); |
|
if ($pictype) { |
|
my $newext = $target_ext_type{$pictype}; |
|
if ($newext) { |
|
$newfn = $filebase . ".$newext"; |
|
# check if file exists |
|
if (-f "$destdir/$newfn") { |
|
logger('DEBUG', "CONV file exists: $newfn"); |
|
if (! $overwrite) { |
|
logger('INFO', "File already converted: $newfn"); |
return 0; |
return 0; |
} |
} |
chmod $file_perm, "$dest_base_dir/$newfn" or |
|
print "WARNING: unable to set permission on '$newfn'\n;"; |
|
return 1; |
|
} |
} |
|
} else { |
|
logger('DEBUG', "target extension for $pictype unknown!"); |
|
} |
|
} else { |
|
# quick ident failed -- do it slowly |
|
|
print "WARNING: unknown file type: '$basedir/$filename'\n;"; |
($pictype, $picwidth, $picheight, $bitdepth) = identify("$srcdir/$filename"); |
|
if ((! $pictype)||($picwidth == 0)||($picheight == 0)) { |
|
logger('WARNING', "unknown file type '$srcdir/$filename'"); |
return 0; |
return 0; |
} |
} |
|
} |
|
|
|
# collect arguments for the conversion |
|
my %args; |
|
$args{'srcdir'} = $srcdir; |
|
$args{'destdir'} = $destdir; |
|
$args{'filename'} = $filename; |
|
$args{'pictype'} = $pictype; |
|
$args{'picwidth'} = $picwidth; |
|
$args{'picheight'} = $picheight; |
|
$args{'bitdepth'} = $bitdepth; |
|
$args{'srcdir'} = $srcdir; |
|
$args{'scalesize'} = $scalesize; |
|
$args{'scale_rel'} = $scale_relative; |
|
|
|
# decide conversion based on image type and encoding preferences |
|
if ($pictype eq 'JPEG') { |
|
$args{'jpeg_qual'} = $jpeg_quality; |
|
#default encoder |
|
$error = scale_jpeg(\%args); |
|
} elsif ($pictype eq 'TIFF') { |
|
if ($use_encoder) { |
|
# use specific encoder |
|
if ($use_encoder eq 'tiff_jpeg') { |
|
$error = scale_tiff_jpeg(\%args); |
|
} elsif ($use_encoder eq 'tiff_jpeg2') { |
|
$error = scale_tiff_jpeg2(\%args); |
|
} elsif ($use_encoder eq 'tiff_png') { |
|
$error = scale_tiff_png(\%args); |
|
} |
|
} else { |
|
# default |
|
$error = scale_tiff_jpeg(\%args); |
|
} |
|
} else { |
|
logger('WARNING', "unknown file type: $pictype ($srcdir/$filename)"); |
|
} |
|
return $error; |
|
} |
|
|
|
|
# |
# |
Line 315 sub convert_file {
|
Line 704 sub convert_file {
|
# Descend recursively through $dirname and work on all files |
# Descend recursively through $dirname and work on all files |
# |
# |
sub walk_convert_dir { |
sub walk_convert_dir { |
my($workdir) = @_; |
my($srcdir, $workdir, $destdir) = @_; |
my $errcnt = 0; |
my $errcnt = 0; |
my $newfn; |
my $newfn; |
|
|
my $basedir = findir(\@source_base_dirs, $workdir); |
opendir WORKDIR, "$srcdir/$workdir" or do { |
|
logger('ERROR', "Unable to open directory $srcdir/$workdir!"); |
opendir WORKDIR, "$basedir/$workdir" or do { |
|
print "ERROR: Unable to open directory $basedir/$workdir!\n"; |
|
return 0; |
return 0; |
}; |
}; |
|
|
Line 332 sub walk_convert_dir {
|
Line 719 sub walk_convert_dir {
|
|
|
if ($do_descend) { |
if ($do_descend) { |
foreach (sort @dirlist) { |
foreach (sort @dirlist) { |
if (/^[.]+$/) { |
next if (/^[.]+$/); |
next; |
next if ($junk_files{$_}); |
} |
if (-d "$srcdir/$workdir/$_") { |
if (-d "$basedir/$workdir/$_") { |
walk_convert_dir($srcdir, "$workdir/$_", $destdir); |
walk_convert_dir("$workdir/$_"); |
|
} |
} |
} |
} |
} |
} |
|
|
print "INFO: Working on $workdir\n"; |
logger('INFO', "Working on $workdir"); |
print "INFO: Reading from $basedir.\n"; |
logger('INFO', "Reading from $srcdir/$workdir."); |
print "INFO: Writing to $dest_base_dir\n"; |
logger('INFO', "Writing to $destdir/$workdir"); |
|
|
|
# create destination directory |
if (not ($simulate)) { |
if (not ($simulate)) { |
mmkdir("$dest_base_dir/$workdir") or do { |
mmkdir("$destdir/$workdir") or do { |
print "ERROR: unable to create directory '$dest_base_dir/$workdir'\n;"; |
logger("ERROR", "unable to create directory '$destdir/$workdir'"); |
$errcnt++; |
$errcnt++; |
return 0; |
return 0; |
}; |
}; |
if ($dont_overwrite == 0) { |
|
foreach (@imgfile_ext) { |
|
system("rm -f $dest_base_dir/$workdir/*.$_"); |
|
} |
|
} |
|
} |
} |
|
|
foreach (sort @dirlist) { |
foreach (sort @dirlist) { |
|
# skip dot-directories |
if (/^[.]+.*$/) { |
if (/^[.]+.*$/) { |
next; |
next; |
} |
} |
if (-f "$basedir/$workdir/$_") { |
if (-f "$srcdir/$workdir/$_") { |
if (convert_file($basedir, "$workdir/$_") == 0) { |
$errcnt += convert_file("$srcdir/$workdir", "$_", "$destdir/$workdir"); |
$errcnt++; |
|
} |
|
} |
} |
} |
} |
|
|
if ($errcnt) { |
if ($errcnt) { |
print "INFO: There were errors converting $workdir!\n"; |
logger('INFO', "There were $errcnt errors converting '$workdir'!"); |
} else { |
} else { |
print "INFO: Finished converting $workdir!\n"; |
logger('INFO', "Finished converting $workdir!"); |
} |
} |
|
|
return 1; |
return 1; |
Line 385 sub walk_convert_dir {
|
Line 766 sub walk_convert_dir {
|
# Convert directory "from_dir" and its subdirectories |
# Convert directory "from_dir" and its subdirectories |
# |
# |
sub convert_dir { |
sub convert_dir { |
my ($workdir) = @_; |
my ($srcdir, $workdir, $destdir) = @_; |
|
|
print "INFO: ** Converting Scans **\n"; |
logger('INFO', "** Converting Scans **"); |
print "INFO: Starting in directory '$workdir'\n"; |
logger('INFO', "Starting in directory '$srcdir/$workdir'"); |
|
|
dir_ok($workdir) or die("ABORT: Illegal directory name '$workdir'!\n"); |
walk_convert_dir($srcdir, $workdir, $destdir); |
|
|
walk_convert_dir($workdir); |
|
|
|
# touch source directory so digilib rescans the thumbnails |
# touch source directory so digilib rescans the thumbnails |
#print "DEBUG:/usr/bin/touch $source_base_dirs[0]/$workdir\n"; |
#logger('DEBUG', "/usr/bin/touch $source_base_dirs[0]/$workdir"); |
system("/usr/bin/touch $source_base_dirs[0]/$workdir"); |
system("/usr/bin/touch '$srcdir/$workdir'"); |
|
|
print "DONE: ** Finished converting scans **\n"; |
logger('DONE', "** Finished converting scans **"); |
return 1; |
return 1; |
} |
} |
|
|
Line 410 sub convert_dir {
|
Line 789 sub convert_dir {
|
############################################################### |
############################################################### |
## Main |
## Main |
|
|
if ($#ARGV < 0) { |
if ($#ARGV < 3) { |
print "Scale-O-Mat $version\n"; |
print "Scale-O-Mat $version\n"; |
print " use: scaleomat.pl hires-dir dest-base size [quality] [--replace]\n"; |
print " use: scaleomat.pl -src=src-base -dest=dest-base -dir=workdir [...]\n"; |
print " - if hires-dir starts with '/' then it's absolute.\n"; |
print " reads from scr-base/workdir and writes to dest-base/workdir\n"; |
print " - if size starts with 'x' then it's magnification factor.\n"; |
print " -scaleto=destination size\n"; |
print " - quality is JPEG quality (0-100)\n"; |
print " -scaleby=magnification factor.\n"; |
print " - --replace replaces existing files (default=skip).\n"; |
print " -jpegqual=JPEG quality (0-100)\n"; |
|
print " -replace=yes replaces existing files (default=skip).\n"; |
|
print " -encoder=tiff_png|tiff_jpeg|tiff_jpeg2\n"; |
exit 1; |
exit 1; |
} |
} |
|
|
# test software installation |
# test software installation |
checksoft; |
checksoft(); |
|
|
# parameter 1 is destination dir |
# read command line parameters |
if ($#ARGV > 0) { |
my $args = parseargs(); |
$dest_base_dir = $ARGV[1]; |
|
} |
# source dir |
|
my $srcdir = cleanpath($$args{'src'}, 1); |
|
|
|
# destination dir |
|
my $destdir = cleanpath($$args{'dest'}, 1); |
|
|
|
# working dir |
|
my $workdir = cleanpath($$args{'dir'}); |
|
|
# parameter 2 is destination size (or factor when starting with "x") |
# destination size |
if ($#ARGV > 1) { |
if ($$args{'scaleby'}) { |
if ($ARGV[2] =~ /^x([\d.]+)/) { |
|
$scale_relative = 1; |
$scale_relative = 1; |
$target_size = $1; |
$scalesize = $$args{'scaleby'}; |
print "INFO: scaling relative by factor $target_size\n"; |
logger('INFO', "Scaling relative by factor $scalesize"); |
} else { |
} |
|
if ($$args{'scaleto'}) { |
$scale_relative = 0; |
$scale_relative = 0; |
$target_size = $ARGV[2]; |
$scalesize = $$args{'scaleto'}; |
print "INFO: scaling absolute to size $target_size\n"; |
logger('INFO', "Scaling absolute to size $scalesize"); |
} |
} |
|
|
|
# JPEG quality |
|
if ($$args{'jpegqual'}) { |
|
logger('INFO', "JPEG quality set to '$$args{'jpegqual'}'!"); |
|
$jpeg_quality = $$args{'jpegqual'}; |
} |
} |
|
|
# optional parameters are JPEG quality or --replace |
# force encoder |
if ($#ARGV > 2) { |
if ($$args{'encoder'}) { |
for ($i = 3; $i <= $#ARGV; $i++) { |
logger('INFO', "Using encoder '$$args{'encoder'}'!"); |
$s = $ARGV[$i]; |
$use_encoder = $$args{'encoder'}; |
if ($s eq "--replace") { |
|
print "INFO: set to overwrite existing files!\n"; |
|
$dont_overwrite = 0; |
|
} else { |
|
print "INFO: JPEG quality set to '$s'!\n"; |
|
$jpeg_quality = $s; |
|
} |
} |
|
|
|
# Overwrite |
|
if ($$args{'replace'}) { |
|
logger('INFO', "Set to overwrite existing files!"); |
|
$overwrite = 1; |
} |
} |
|
|
|
# debug |
|
if ($$args{'debug'}) { |
|
logger('INFO', "Set debug level to $$args{'debug'}!"); |
|
$debug = $$args{'debug'}; |
} |
} |
|
|
# convert all files in the directory |
# simulate |
my $srcdir = $ARGV[0]; |
if ($$args{'simulate'}) { |
if ($srcdir =~ /^\//) { |
logger('INFO', "Set to simulate operation only ($$args{'simulate'})!"); |
# if source dir starts with / then ist's absolute |
$simulate = $$args{'simulate'}; |
$source_base_dirs[0] = "/"; |
|
} |
} |
convert_dir($srcdir); |
|
|
convert_dir($srcdir, $workdir, $destdir); |