[BACK]Return to scaleomat.pl CVS log [TXT] [DIR] Up to [Repository] / scaleomat

Diff for /scaleomat/scaleomat.pl between versions 1.1 and 1.8

version 1.1, 2004/07/23 17:58:24 version 1.8, 2005/01/05 18:38:32
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.5 (ROC 5.1.2005)";
   
 $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", "dcr" => "RAW");
   # destination image file extensions
   my %target_ext_type = ("TIFF" => "jpg", "JPEG" => "jpg");
   
   # default scale settings
   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
   
   # 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 78  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 100  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 105  sub findfile { Line 131  sub findfile {
     return;      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)
   #
   # 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 174  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 186  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 196  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 204  sub mmkdir {
 }  }
   
 #  #
 # dir_ok($dirname)  # ($type, $width, $height) = identify($filepath)
 #  
 # check directory name against evil  
 #  #
 sub dir_ok {  sub identify {
     my($dirname) = @_;      my ($filepath) = @_;
       my $pictype = "";
     if ($dirname eq "") {      my $picwidth = 0;
     print "ERROR: DIR mustn't be empty!\n";      my $picheight = 0;
     return 0;      my $bitdepth = 0;
       # use quickident first
       $pictype = quickident($filepath);
       # optimized 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;
           # we take the biggest values, because embedded thumbnails 
           # may also show up
           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);
 }  }
   
   
 #  
 # convert_file($filename)  
 #  
 # convert file  
 #  
 sub convert_file {  
     my($basedir, $filename) = @_;  
     my $newfn;  
     my $pictype;  
     my $picwidth;  
     my $picheight;  
     my $scaleopt = 0.3;  
   
     if (not (( -f "$basedir/$filename") && (-r _))) {  
     print "ERROR: unable to read file '$basedir/$filename'\n;";  
     return 0;  
     }      }
       }
     #      # run ident to get image type and dimensions
     # run ident first to get image type and dimensions      logger('DEBUG', "running identifier $identifier");
     # calculate scaling factor based on destination size or factor      if (open(IDENT, "nice -10 $identifier -ping -format '%w %h %m\n' '$filepath' 2>/dev/null |")) {
     #  
     if (open(IDENT, "nice -10 $identifier -ping -format '%w %h %m\n' '$basedir/$filename' 2>/dev/null|")) {  
     my @id = <IDENT>;      my @id = <IDENT>;
     my $picinfo = $id[0];      my $picinfo = $id[0];
     close IDENT;      close IDENT;
     chomp $picinfo;      chomp $picinfo;
     dprint "INFO: PIC is $picinfo\n";      logger('DEBUG', "PIC is '$picinfo'");
     if ($picinfo =~ /^(\d+) (\d+) (\w+)$/) {      if ($picinfo =~ /^(\d+) (\d+) (\w+)$/) {
         $picwidth = $1;          $picwidth = $1;
         $picheight = $2;          $picheight = $2;
         $pictype = $3;          $pictype = $3;
         if ($scale_relative) {      }
         $scaleopt = $target_size;  
         } else {          } else {
         if ($picheight > $picwidth) {      logger('DEBUG', "unable to identify $filepath!");
             $scaleopt = $target_size / $picheight;  
             dprint "INFO: PIC is portrait\n";  
         } else {  
             $scaleopt = $target_size / $picwidth;  
             dprint "INFO: PIC is landscape\n";  
         }  
         if ($scaleopt >= 1) {  
             $scaleopt = 1;  
             dprint "INFO: PIC is already smaller\n";  
         }          }
       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;
     }      }
           
   
   #
   # $fact = scalefactor(\$args)
   #
   sub scalefactor {
       my ($args) = @_;
   
       my $srcdir = $$args{'srcdir'};
       my $filename = $$args{'filename'};
       my $scale_w = $$args{'scale_w'};
       my $scale_h = $$args{'scale_h'};
       my $scale_rel = $$args{'scale_rel'};
       my $scale = 0;
   
       if ($scale_rel) {
       # scale relative -- no size needed, only scaling factor
       $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 0;
           }
           # 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 {
           $scale = $scale_y;
           logger('DEBUG', "PIC scale to height");
       }
       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      # scale JPEG images to JPEG using netpbm tools
     #      #
     if ($pictype eq 'JPEG') {  # 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      # 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(jpg): $filename -> $newfn");
         dprint "INFO  CONV file exists: $newfn\n";      return 1 if ($simulate);
         if ($dont_overwrite) {  
         print "INFO:  File already converted: $newfn\n";      $scaleopt = scalefactor($args);
   
       if (!$scaleopt) {
       logger('ERROR', "unable to calculate scaling options!");
         return 1;          return 1;
         }          }
     }  
     print "INFO: Convert(jpg): $filename -> $newfn\n";      if ($scaleopt == 1) {
     return 1 if ($simulate);      # is already smaller
     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 smaller and JPEG - ignoring");
     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) {  
         return 0;          return 0;
     }      }
     chmod $file_perm, "$dest_base_dir/$newfn" or  
         print "WARNING: unable to set permission on '$dest_base_dir/$newfn'\n";      # 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'!");
       if (! -s "$destdir/$newfn") {
           # file broken (size 0)
           logger('ERROR', "created file '$destdir/$newfn' broken -- will be removed!");
           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;
   }
   
   
   #
   # $error = scale_tiff_jpeg2(\$args);
     #      #
     # scale TIFF images to JPEG using convert   # scale TIFF images to JPEG using ImageMagick convert
     # (slower but netpbm doesn't always work)  
     #      #
     if ($pictype eq 'TIFF') {  # args needed: $srcdir, $filename, $destdir, 
     # convert tif -> jpg  #              $scale_w, $scale_h, $scale_rel, $picwidth, $picheight
     $newfn = $filename;  #
     $newfn =~ s/\.\w+$/.jpg/;  sub scale_tiff_jpeg2 {
     if (-f "$dest_base_dir/$newfn") {      my ($args) = @_;
         dprint "INFO:  CONV file exists: $newfn\n";  
         if ($dont_overwrite) {      my $srcdir = $$args{'srcdir'};
         print "INFO:  File already converted: $newfn\n";      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;
   
       my ($basename, $fileext) = splitfn($filename);
       my $newfn = $basename . ".jpg";
       logger('INFO', "Convert(tiff2): $filename -> $newfn");
   
       if ($scale_rel) {
       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) {
           logger('ERROR', "error converting '$srcdir/$filename'!");
         return 1;          return 1;
         }          }
       } else {
       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 ${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";
     }      }
     print "INFO: Convert(tif): $filename -> $newfn\n";          return 1;
     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);      # change permissions
         if (system("nice -10 $converter -quality $jpeg_quality -scale $per_scale\% '$basedir/$filename' '$dest_base_dir/$newfn' 2>/dev/null\n") != 0) {      chmod $file_perm, "$destdir/$newfn" or
       logger('WARNING', "unable to set permission on '$destdir/$newfn'");
   
         return 0;          return 0;
         }          }
     } else {  
         dprint("nice -10 $converter -quality $jpeg_quality -scale ${target_size}x${target_size} $basedir/$filename $dest_base_dir/$newfn 2>/dev/null\n");  
   #
   # $error = scale_tiff_jpeg(\$args);
   #
   # scale TIFF images to JPEG using netpbm tools
   #
   # args needed: $srcdir, $filename, $destdir, 
   #              $scale_w, $scale_h, $scale_rel, $picwidth, $picheight
   #
   sub scale_tiff_jpeg {
       my ($args) = @_;
   
       my $srcdir = $$args{'srcdir'};
       my $filename = $$args{'filename'};
       my $destdir = $$args{'destdir'};
       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
       my ($basename, $fileext) = splitfn($filename);
       my $newfn = $basename . ".jpg";
       logger('INFO', "Convert(tiff1): $filename -> $newfn");
         return 1 if ($simulate);          return 1 if ($simulate);
         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;      $scaleopt = scalefactor($args);
   
       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 ";
       }
       $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($cmd) != 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";
     }      }
     chmod $file_perm, "$dest_base_dir/$newfn" or  
         print "WARNING: unable to set permission on '$newfn'\n;";  
     return 1;      return 1;
     }      }
   
       # change permissions
       chmod $file_perm, "$destdir/$newfn" or
       logger('WARNING', "unable to set permission on '$destdir/$newfn'");
   
       return 0;
   }
   
   
   
   #
   # $error = scale_tiff_png(\$args);
   #
   # scale TIFF images to PNG using netpbm tools
     #      #
     # convert TIFF to PNG using netpbm tools (not used any more)  # args needed: $srcdir, $filename, $destdir, 
   #              $scale_w, $scale_h, $scale_rel, $picwidth, $picheight
     #      #
     if ($pictype eq 'TIFF_old') {  sub scale_tiff_png {
       my ($args) = @_;
   
       my $srcdir = $$args{'srcdir'};
       my $filename = $$args{'filename'};
       my $destdir = $$args{'destdir'};
       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 tif -> png      # convert tif -> png
     $newfn = $filename;      my ($basename, $fileext) = splitfn($filename);
     $newfn =~ s/\.\w+$/.png/;      my $newfn = $basename . ".png";
     if (-f "$dest_base_dir/$newfn") {      logger('INFO', "Convert(tiff3): $filename -> $newfn");
         dprint "INFO:  CONV file exists: $newfn\n";  
         if ($dont_overwrite) {      $scaleopt = scalefactor($args);
         print "INFO:  File already converted: $newfn\n";  
       if (!$scaleopt) {
       logger('ERROR', "unable to calculate scaling options!");
         return 1;          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 ";
     }      }
     print "INFO: Convert(tif): $filename -> $newfn\n";      $cmd .= "| nice -10 $scaler $scaleopt 2>/dev/null | nice -10 $pngwriter > '$destdir/$newfn' 2>/dev/null";
     return 1 if ($simulate);      logger('DEBUG', "$cmd");
     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");      return 0 if ($simulate);
     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) {      if (system($cmd) != 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;
       }
   
       # change permissions
       chmod $file_perm, "$destdir/$newfn" or
       logger('WARNING', "unable to set permission on '$destdir/$newfn'");
   
         return 0;          return 0;
     }      }
     chmod $file_perm, "$dest_base_dir/$newfn" or  
         print "WARNING: unable to set permission on '$newfn'\n;";  
   #
   # $error = convert_file($srcdir, $filename, $destdir);
   #
   # convert file
   #
   sub convert_file {
       my($srcdir, $filename, $destdir) = @_;
       my $filebase;
       my $fileext;
       my $newfn;
       my $pictype;
       my $picwidth;
       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;
     }      }
   
     print "WARNING: unknown file type: '$basedir/$filename'\n;";      # get base name and extension
       if ($filename =~ /^(.*)\.(\w+)$/) {
       $filebase = $1;
       $fileext = $2;
       }
   
       #
       # 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;      return 0;
 }      }    
       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) {
               # 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 {
           logger('DEBUG', "target extension for $pictype unknown!");
       }
       } 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'");
           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{'scale_w'} = $scale_w;
       $args{'scale_h'} = $scale_h;
       $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 676  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 691  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 738  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";  
     print "INFO: Starting in directory '$workdir'\n";  
           
     dir_ok($workdir) or die("ABORT: Illegal directory name '$workdir'!\n");      logger('INFO', "** Converting Scans **");
   
     walk_convert_dir($workdir);  
   
       if (-d "$srcdir/$workdir") {
       # it's a dirrectory
       logger('INFO', "Starting in directory '$srcdir/$workdir'");
       walk_convert_dir($srcdir, $workdir, $destdir);
     # 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'");
       } 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'");
       }
   
     print "DONE: ** Finished converting scans **\n";      logger('DONE', "** Finished converting scans **");
     return 1;      return 1;
 }  }
   
Line 410  sub convert_dir { Line 772  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 (S or WxH)\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];  
 }  
   
 # parameter 2 is destination size (or factor when starting with "x")  # source dir
 if ($#ARGV > 1) {  my $srcdir = cleanpath($$args{'src'}, 1);
     if ($ARGV[2] =~ /^x([\d.]+)/) {  
   # destination dir
   my $destdir = cleanpath($$args{'dest'}, 1);
   
   # working dir
   my $workdir = cleanpath($$args{'dir'});
   
   # destination size
   if ($$args{'scaleby'}) {
     $scale_relative = 1;      $scale_relative = 1;
     $target_size = $1;      $scale_w = $$args{'scaleby'};
     print "INFO: scaling relative by factor $target_size\n";      logger('INFO', "Scaling relative by factor $scale_w");
     } else {  }
   if ($$args{'scaleto'}) {
     $scale_relative = 0;      $scale_relative = 0;
     $target_size = $ARGV[2];      if ($$args{'scaleto'} =~ /(\d+)x(\d+)/) {
     print "INFO: scaling absolute to size $target_size\n";      $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");
 }  }
   
 # optional parameters are JPEG quality or --replace  # JPEG quality
 if ($#ARGV > 2) {  if ($$args{'jpegqual'}) {
     for ($i = 3; $i <= $#ARGV; $i++) {      logger('INFO', "JPEG quality set to '$$args{'jpegqual'}'!");
     $s = $ARGV[$i];      $jpeg_quality = $$args{'jpegqual'};
     if ($s eq "--replace") {  }
         print "INFO: set to overwrite existing files!\n";  
         $dont_overwrite = 0;  # force encoder
     } else {  if ($$args{'encoder'}) {
         print "INFO: JPEG quality set to '$s'!\n";      logger('INFO', "Using encoder '$$args{'encoder'}'!");
         $jpeg_quality = $s;      $use_encoder = $$args{'encoder'};
     }      }
   
   # 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);
Removed from v.1.1  
changed lines
  Added in v.1.8

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>