--- scaleomat/scaleomat.pl 2004/07/23 18:19:13 1.3 +++ scaleomat/scaleomat.pl 2005/04/27 09:58:12 1.10 @@ -1,6 +1,6 @@ #!/usr/bin/perl -# Copyright (C) 2003,2004 Robert Casties, IT-Group MPIWG +# Copyright (C) 2003-2005 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 @@ -15,6 +15,7 @@ # Place, Suite 330, Boston, MA 02111-1307 USA use strict; +use sigtrap qw(die normal-signals); # MPIWG libraries use lib '/usr/local/mpiwg/scripts'; @@ -23,7 +24,7 @@ use MPIWGlib; $| = 1; # unblock IO -my $version = "V0.9.2 (ROC 22.4.2004)"; +my $version = "V0.9.7 (ROC 27.4.2005)"; $debug = 0; @@ -37,18 +38,20 @@ my $file_perm = 0664; umask 000; # to make shure we can actually use these perms my $overwrite = 0; # overwrite already converted files +my $synchronise = 0; # delete unmatched destination files # image file extensions and formats my %img_type_ext = ("tif" => "TIFF", "tiff" => "TIFF", "gif" => "GIF", - "jpg" => "JPEG", "png" => "PNG"); + "jpg" => "JPEG", "png" => "PNG", "dcr" => "RAW"); # destination image file extensions my %target_ext_type = ("TIFF" => "jpg", "JPEG" => "jpg"); # default scale settings -my $scalesize = 2048; # pixel of longest side +my $scale_w = 2048; # width in pixel +my $scale_h = 2048; # height in pixel 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 +my $use_encoder = 0; # false: autodetect encoder # programs to use my $identifier; @@ -129,6 +132,24 @@ sub findfile { return; } +# +# $p = cleanpath($path, $startslash). +# +# returns a pathname with trailing and starting slash removed (if +# $startslash is true the starting slash is not removed) +# +sub cleanpath { + my ($path, $startslash) = @_; + + if ($path =~ /^(\/)*(.*?)\/*$/) { + if ($startslash) { + return $1 . $2; + } else { + return $2; + } + } + return $path; +} # # ($basename, $extension) = splitfn($filename) @@ -156,8 +177,7 @@ sub mmkdir { # does the directory already exist? if (-d $dirname) { chmod $dir_perm, $dirname or do { - logger('ERROR', "unable to change permission on $dirname!"); - return 0; + logger('WARNING', "unable to change permission on $dirname!"); }; return 1; } @@ -187,32 +207,36 @@ sub mmkdir { # # ($type, $width, $height) = identify($filepath) # +# returns type, width and height of the image using ImageMagick's identify +# sub identify { my ($filepath) = @_; - my $pictype; - my $picwidth; - my $picheight; + my $pictype = ""; + my $picwidth = 0; + my $picheight = 0; my $bitdepth = 0; # use quickident first $pictype = quickident($filepath); - # optimize tiff identification + # optimized tiff identification if (($pictype)&&($pictype eq 'TIFF')) { logger('DEBUG', "running tiffinfo $tiffinfo"); if (open(IDENT, "nice -10 $tiffinfo '$filepath' 2>/dev/null |")) { while () { chomp; + # we take the biggest values, because embedded thumbnails + # may also show up if (/Image Width:\s*(\d+)\s*Image Length:\s*(\d+)/) { - $picwidth = $1; - $picheight = $2; + $picwidth = $1 if ($1 > $picwidth); + $picheight = $2 if ($2 > $picheight); next; } if (/Bits\/Sample:\s*(\d+)/) { - $bitdepth = $1; + $bitdepth = $1 if ($1 > $bitdepth); next; } } if ($picwidth) { - logger('DEBUG', "TIFF $1 x $2"); + logger('DEBUG', "TIFF $picwidth x $picheight"); return ($pictype, $picwidth, $picheight, $bitdepth); } } @@ -239,6 +263,8 @@ sub identify { # # $type = quickident($filepath); # +# returns image type based on file extension only +# sub quickident { my ($filepath) = @_; logger('DEBUG', "running quickident"); @@ -252,68 +278,109 @@ sub quickident { # -# $error = scale_jpeg(\$args); +# $fact = scalefactor(\$args) # -# scale JPEG images to JPEG using netpbm tools +# returns the necessary scaling factor # -# args needed: $srcdir, $filename, $destdir, -# $scalesize, $scale_rel, $picwidth, $picheight -# -sub scale_jpeg { +sub scalefactor { my ($args) = @_; my $srcdir = $$args{'srcdir'}; my $filename = $$args{'filename'}; - my $destdir = $$args{'destdir'}; - my $scalesize = $$args{'scalesize'}; + my $scale_w = $$args{'scale_w'}; + my $scale_h = $$args{'scale_h'}; 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); + my $scale = 0; if ($scale_rel) { # scale relative -- no size needed, only scaling factor - $scaleopt = $scalesize; + $scale = $scale_w; } else { # scale to size -- size needed my $pictype = $$args{'pictype'}; my $picwidth = $$args{'picwidth'}; my $picheight = $$args{'picheight'}; if (! $picwidth) { + # no size yet - identify ($pictype, $picwidth, $picheight) = identify("$srcdir/$filename"); if ((! $pictype)||($picwidth == 0)||($picheight == 0)) { logger('ERROR', "unable to identify $srcdir/$filename!"); - return 1; + return 0; } - } - if ($picheight > $picwidth) { - $scaleopt = $scalesize / $picheight; - logger('DEBUG', "PIC is portrait"); + # save values + $$args{'pictype'} = $pictype; + $$args{'picwidth'} = $picwidth; + $$args{'picheight'} = $picheight; + } + # calculate x and y scaling factors + my $scale_x = $scale_w / $picwidth; + my $scale_y = $scale_h / $picheight; + # take the smallest + if ($scale_x < $scale_y) { + $scale = $scale_x; + logger('DEBUG', "PIC scale to width"); } else { - $scaleopt = $scalesize / $picwidth; - logger('DEBUG', "PIC is landscape"); + $scale = $scale_y; + logger('DEBUG', "PIC scale to height"); } - if ($scaleopt >= 1) { - $scaleopt = 1; + if ($scale >= 1) { + $scale = 1; logger('DEBUG', "PIC is already smaller"); + # continue since we may have to convert } } + return $scale; +} + + +# +# $error = scale_jpeg(\$args); +# +# scale JPEG images to JPEG using netpbm tools +# +# args needed: $srcdir, $filename, $destdir, +# $scale_w, $scale_h, $scale_rel, $picwidth, $picheight +# +sub scale_jpeg { + my ($args) = @_; + + my $srcdir = $$args{'srcdir'}; + my $filename = $$args{'filename'}; + my $destdir = $$args{'destdir'}; + my $scale_w = $$args{'scale_w'}; + my $scale_h = $$args{'scale_h'}; + 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); + + $scaleopt = scalefactor($args); if (!$scaleopt) { logger('ERROR', "unable to calculate scaling options!"); return 1; } + if ($scaleopt == 1) { + # is already smaller + logger('DEBUG', "PIC is smaller and JPEG - ignoring"); + return 0; + } + # 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"; + if (! -s "$destdir/$newfn") { + # file broken (size 0) + logger('ERROR', "created file '$destdir/$newfn' broken -- will be removed!"); + unlink "$destdir/$newfn"; + } return 1; } @@ -337,7 +404,7 @@ sub scale_jpeg { # scale TIFF images to JPEG using ImageMagick convert # # args needed: $srcdir, $filename, $destdir, -# $scalesize, $scale_rel, $picwidth, $picheight +# $scale_w, $scale_h, $scale_rel, $picwidth, $picheight # sub scale_tiff_jpeg2 { my ($args) = @_; @@ -345,50 +412,17 @@ sub scale_tiff_jpeg2 { my $srcdir = $$args{'srcdir'}; my $filename = $$args{'filename'}; my $destdir = $$args{'destdir'}; - my $scalesize = $$args{'scalesize'}; + my $scale_w = $$args{'scale_w'}; + my $scale_h = $$args{'scale_h'}; 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 { - # 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; - } - - if ($scale_rel) { - my $per_scale = 100 * $scaleopt; + my $per_scale = 100 * $scale_w; 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) { @@ -396,10 +430,15 @@ sub scale_tiff_jpeg2 { return 1; } } else { - logger('DEBUG', "nice -10 $converter -quality $jpeg_quality -scale ${scalesize}x${scalesize} '$srcdir/$filename' '$destdir/$newfn' 2>/dev/null"); + logger('DEBUG', "nice -10 $converter -quality $jpeg_quality -scale ${scale_w}x${scale_h} '$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) { + if (system("nice -10 $converter -quality $jpeg_quality -scale ${scale_w}x${scale_h} '$srcdir/$filename' '$destdir/$newfn' 2>/dev/null\n") != 0) { logger('ERROR', "error converting '$srcdir/$filename'!"); + if (! -s "$destdir/$newfn") { + # file broken (size 0) + logger('ERROR', "created file '$destdir/$newfn' broken -- will be removed!"); + unlink "$destdir/$newfn"; + } return 1; } } @@ -408,12 +447,6 @@ sub scale_tiff_jpeg2 { 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; } @@ -424,7 +457,7 @@ sub scale_tiff_jpeg2 { # scale TIFF images to JPEG using netpbm tools # # args needed: $srcdir, $filename, $destdir, -# $scalesize, $scale_rel, $picwidth, $picheight +# $scale_w, $scale_h, $scale_rel, $picwidth, $picheight # sub scale_tiff_jpeg { my ($args) = @_; @@ -432,7 +465,9 @@ sub scale_tiff_jpeg { my $srcdir = $$args{'srcdir'}; my $filename = $$args{'filename'}; my $destdir = $$args{'destdir'}; - my $scalesize = $$args{'scalesize'}; + my $bitdepth = $$args{'bitdepth'}; + my $scale_w = $$args{'scale_w'}; + my $scale_h = $$args{'scale_h'}; my $scale_rel = $$args{'scale_rel'}; my $scaleopt; @@ -442,33 +477,7 @@ sub scale_tiff_jpeg { logger('INFO', "Convert(tiff1): $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"); - } - } + $scaleopt = scalefactor($args); if (!$scaleopt) { logger('ERROR', "unable to calculate scaling options!"); @@ -476,11 +485,21 @@ sub scale_tiff_jpeg { } # 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"); + 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 "; + } + $cmd .= "| nice -10 $scaler $scaleopt 2>/dev/null | nice -10 $jpegwriter --quality $jpeg_quality > '$destdir/$newfn' 2>/dev/null"; + logger('DEBUG', "$cmd"); 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 (system($cmd) != 0) { logger('ERROR', "error converting '$srcdir/$filename'!"); - unlink "$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; } @@ -488,12 +507,6 @@ sub scale_tiff_jpeg { 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; } @@ -505,7 +518,7 @@ sub scale_tiff_jpeg { # scale TIFF images to PNG using netpbm tools # # args needed: $srcdir, $filename, $destdir, -# $scalesize, $scale_rel, $picwidth, $picheight +# $scale_w, $scale_h, $scale_rel, $picwidth, $picheight # sub scale_tiff_png { my ($args) = @_; @@ -513,43 +526,18 @@ sub scale_tiff_png { my $srcdir = $$args{'srcdir'}; my $filename = $$args{'filename'}; my $destdir = $$args{'destdir'}; - my $scalesize = $$args{'scalesize'}; my $bitdepth = $$args{'bitdepth'}; + my $scale_w = $$args{'scale_w'}; + my $scale_h = $$args{'scale_h'}; my $scale_rel = $$args{'scale_rel'}; my $scaleopt; - # convert jpg -> jpg + # convert tif -> png 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 { - $scaleopt = $scalesize / $picwidth; - logger('DEBUG', "PIC is landscape"); - } - if ($scaleopt >= 1) { - $scaleopt = 1; - logger('DEBUG', "PIC is already smaller"); - } - } + $scaleopt = scalefactor($args); if (!$scaleopt) { logger('ERROR', "unable to calculate scaling options!"); @@ -567,7 +555,11 @@ sub scale_tiff_png { return 0 if ($simulate); if (system($cmd) != 0) { logger('ERROR', "error converting '$srcdir/$filename'!"); - unlink "$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; } @@ -575,12 +567,6 @@ sub scale_tiff_png { 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; } @@ -591,7 +577,7 @@ sub scale_tiff_png { # convert file # sub convert_file { - my($srcdir, $filename, $destdir) = @_; + my($srcdir, $filename, $destdir, $filelist) = @_; my $filebase; my $fileext; my $newfn; @@ -609,25 +595,33 @@ sub convert_file { } # get base name and extension - if ($filename =~ /^(.*)\.(\w+)$/) { - $filebase = $1; - $fileext = $2; - } + ($filebase, $fileext) = splitfn($filename); # # quick check if target image exists # $pictype = quickident("$srcdir/$filename"); if ($pictype) { + if ($pictype eq "RAW") { + logger('DEBUG', "skipping raw file '$srcdir/$filename'"); + return 0; + } my $newext = $target_ext_type{$pictype}; if ($newext) { $newfn = $filebase . ".$newext"; + logger('DEBUG', "adding $destdir/$newfn'"); + $$filelist{"$destdir/$newfn"} = $filename; # check if file exists if (-f "$destdir/$newfn") { logger('DEBUG', "CONV file exists: $newfn"); if (! $overwrite) { - logger('INFO', "File already converted: $newfn"); - return 0; + # compare age with source file + if (-M "$destdir/$newfn" > -M "$srcdir/$filename") { + logger('DEBUG', "CONV file is older: $newfn"); + } else { + logger('INFO', "File already converted: $newfn"); + return 0; + } } } } else { @@ -635,7 +629,6 @@ sub convert_file { } } else { # quick ident failed -- do it slowly - ($pictype, $picwidth, $picheight, $bitdepth) = identify("$srcdir/$filename"); if ((! $pictype)||($picwidth == 0)||($picheight == 0)) { logger('WARNING', "unknown file type '$srcdir/$filename'"); @@ -653,7 +646,8 @@ sub convert_file { $args{'picheight'} = $picheight; $args{'bitdepth'} = $bitdepth; $args{'srcdir'} = $srcdir; - $args{'scalesize'} = $scalesize; + $args{'scale_w'} = $scale_w; + $args{'scale_h'} = $scale_h; $args{'scale_rel'} = $scale_relative; # decide conversion based on image type and encoding preferences @@ -688,7 +682,7 @@ sub convert_file { # Descend recursively through $dirname and work on all files # sub walk_convert_dir { - my($srcdir, $workdir, $destdir) = @_; + my($srcdir, $workdir, $destdir, $filelist) = @_; my $errcnt = 0; my $newfn; @@ -701,12 +695,16 @@ sub walk_convert_dir { closedir WORKDIR; + # check all directories first if ($do_descend) { foreach (sort @dirlist) { - next if (/^[.]+$/); + # skip dot-directories + next if (/^\..*$/); + # skip junk directories next if ($junk_files{$_}); + # recurse through the rest if (-d "$srcdir/$workdir/$_") { - walk_convert_dir($srcdir, "$workdir/$_", $destdir); + walk_convert_dir($srcdir, "$workdir/$_", $destdir, $filelist); } } } @@ -724,13 +722,13 @@ sub walk_convert_dir { }; } + # check all files in this directory foreach (sort @dirlist) { - # skip dot-directories - if (/^[.]+.*$/) { - next; - } + # skip dot-files + next if (/^[.]+.*$/); + # try to convert the rest if (-f "$srcdir/$workdir/$_") { - $errcnt += convert_file("$srcdir/$workdir", "$_", "$destdir/$workdir"); + $errcnt += convert_file("$srcdir/$workdir", "$_", "$destdir/$workdir", $filelist); } } @@ -751,15 +749,31 @@ sub walk_convert_dir { # sub convert_dir { my ($srcdir, $workdir, $destdir) = @_; + my %files = (); logger('INFO', "** Converting Scans **"); - logger('INFO', "Starting in directory '$srcdir/$workdir'"); - - walk_convert_dir($srcdir, $workdir, $destdir); - - # touch source directory so digilib rescans the thumbnails - #logger('DEBUG', "/usr/bin/touch $source_base_dirs[0]/$workdir"); - system("/usr/bin/touch '$srcdir/$workdir'"); + + if (-d "$srcdir/$workdir") { + # it's a dirrectory + logger('INFO', "Starting in directory '$srcdir/$workdir'"); + walk_convert_dir($srcdir, $workdir, $destdir, \%files); + if ($synchronise) { + logger('INFO', "Removing unmatched files in '$destdir/$workdir'"); + remove_unmatched_files("$destdir/$workdir", \%files); + } + # touch source directory so digilib rescans the thumbnails + #logger('DEBUG', "/usr/bin/touch $source_base_dirs[0]/$workdir"); + system("/usr/bin/touch '$srcdir/$workdir'"); + } elsif (-f _) { + # it's a file + logger('INFO', "Converting file '$srcdir/$workdir'"); + convert_file($srcdir, $workdir, $destdir); + # touch source parent directory so digilib rescans the thumbnails + my $pdir = "$srcdir/$workdir"; + # chop off after the last slash + $pdir =~ s/\/[^\/]+$/\//; + system("/usr/bin/touch '$pdir'"); + } logger('DONE', "** Finished converting scans **"); return 1; @@ -767,6 +781,46 @@ sub convert_dir { +# +# remove_unmatched_files($basedir, \%files) +# +# removes all files from $basedir and its subdirectories that are not +# in %files +# +sub remove_unmatched_files { + my ($basedir, $files) = @_; + my $cnt = 0; + + if (! opendir DIR, $basedir) { + logger('ERROR', "directory $basedir doesn't exist (in remove_unmatched_files)"); + return 0; + } + my @dirfiles = readdir DIR; + foreach my $fn (@dirfiles) { + # ignore names starting with a dot + next if ($fn =~ /^\./); + # ignore other silly files + next if ($junk_files{$fn}); + + $cnt++; + my $f = "$basedir/$fn"; + #print "fs_file: \"$f\"\n"; + if (-f $f) { + #print " is file\n"; + logger('DEBUG', "checking '$f'"); + if (not exists($$files{$f})) { + logger('DEBUG', "removing orphaned file $f"); + unlink $f; + } + } elsif (-d _) { + # recurse into directory + $cnt += remove_unmatched_files($f, $files); + # delete if its empty + rmdir $f; + } + } + return $cnt; +} @@ -777,10 +831,11 @@ if ($#ARGV < 3) { print "Scale-O-Mat $version\n"; print " use: scaleomat.pl -src=src-base -dest=dest-base -dir=workdir [...]\n"; print " reads from scr-base/workdir and writes to dest-base/workdir\n"; - print " -scaleto=destination size\n"; + print " -scaleto=destination size (S or WxH)\n"; print " -scaleby=magnification factor.\n"; print " -jpegqual=JPEG quality (0-100)\n"; - print " -replace=yes replaces existing files (default=skip).\n"; + print " -replace=yes replaces existing files (default=update).\n"; + print " -sync=yes delete unmatched file in destination (default=ignore).\n"; print " -encoder=tiff_png|tiff_jpeg|tiff_jpeg2\n"; exit 1; } @@ -792,24 +847,30 @@ checksoft(); my $args = parseargs(); # source dir -my $srcdir = $$args{'src'}; +my $srcdir = cleanpath($$args{'src'}, 1); # destination dir -my $destdir = $$args{'dest'}; +my $destdir = cleanpath($$args{'dest'}, 1); # working dir -my $workdir = $$args{'dir'}; +my $workdir = cleanpath($$args{'dir'}); # destination size if ($$args{'scaleby'}) { $scale_relative = 1; - $scalesize = $$args{'scaleby'}; - logger('INFO', "Scaling relative by factor $scalesize"); + $scale_w = $$args{'scaleby'}; + logger('INFO', "Scaling relative by factor $scale_w"); } if ($$args{'scaleto'}) { $scale_relative = 0; - $scalesize = $$args{'scaleto'}; - logger('INFO', "Scaling absolute to size $scalesize"); + if ($$args{'scaleto'} =~ /(\d+)x(\d+)/) { + $scale_w = $1; + $scale_h = $2; + } else { + $scale_w = $$args{'scaleto'}; + $scale_h = $$args{'scaleto'}; + } + logger('INFO', "Scaling absolute to size $scale_w x $scale_h"); } # JPEG quality @@ -830,6 +891,12 @@ if ($$args{'replace'}) { $overwrite = 1; } +# Synchronise +if ($$args{'sync'}) { + logger('INFO', "Set to delete unmatched files!"); + $synchronise = 1; +} + # debug if ($$args{'debug'}) { logger('INFO', "Set debug level to $$args{'debug'}!");