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

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

version 1.8, 2005/01/05 18:38:32 version 1.9, 2005/01/07 16:55:40
Line 1 Line 1
 #!/usr/bin/perl  #!/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  #  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  #  under the terms of the GNU General Public License as published by the Free
Line 24  use MPIWGlib; Line 24  use MPIWGlib;
   
 $| = 1; # unblock IO  $| = 1; # unblock IO
   
 my $version = "V0.9.5 (ROC 5.1.2005)";  my $version = "V0.9.6 (ROC 6.1.2005)";
   
 $debug = 0;  $debug = 0;
   
Line 38  my $file_perm = 0664; Line 38  my $file_perm = 0664;
 umask 000; # to make shure we can actually use these perms  umask 000; # to make shure we can actually use these perms
   
 my $overwrite = 0; # overwrite already converted files  my $overwrite = 0; # overwrite already converted files
   my $synchronise = 0; # delete unmatched destination files
   
 # image file extensions and formats  # image file extensions and formats
 my %img_type_ext = ("tif" => "TIFF", "tiff" => "TIFF", "gif" => "GIF",   my %img_type_ext = ("tif" => "TIFF", "tiff" => "TIFF", "gif" => "GIF", 
Line 50  my $scale_w = 2048; # width in pixel Line 51  my $scale_w = 2048; # width in pixel
 my $scale_h = 2048; # height in pixel  my $scale_h = 2048; # height in pixel
 my $scale_relative = 0; # scale by relative factor instead of destination size  my $scale_relative = 0; # scale by relative factor instead of destination size
 my $jpeg_quality = 75; # default JPEG compression quality  my $jpeg_quality = 75; # default JPEG compression quality
 my $use_encoder = 0; # autodetect encoder  my $use_encoder = 0; # false: autodetect encoder
   
 # programs to use  # programs to use
 my $identifier;  my $identifier;
Line 206  sub mmkdir { Line 207  sub mmkdir {
 #  #
 # ($type, $width, $height) = identify($filepath)  # ($type, $width, $height) = identify($filepath)
 #  #
   # returns type, width and height of the image using ImageMagick's identify
   #
 sub identify {  sub identify {
     my ($filepath) = @_;      my ($filepath) = @_;
     my $pictype = "";      my $pictype = "";
Line 260  sub identify { Line 263  sub identify {
 #  #
 # $type = quickident($filepath);  # $type = quickident($filepath);
 #  #
   # returns image type based on file extension only
   #
 sub quickident {  sub quickident {
     my ($filepath) = @_;      my ($filepath) = @_;
     logger('DEBUG', "running quickident");      logger('DEBUG', "running quickident");
Line 275  sub quickident { Line 280  sub quickident {
 #  #
 # $fact = scalefactor(\$args)  # $fact = scalefactor(\$args)
 #  #
   # returns the necessary scaling factor
   #
 sub scalefactor {  sub scalefactor {
     my ($args) = @_;      my ($args) = @_;
   
Line 570  sub scale_tiff_png { Line 577  sub scale_tiff_png {
 # convert file  # convert file
 #  #
 sub convert_file {  sub convert_file {
     my($srcdir, $filename, $destdir) = @_;      my($srcdir, $filename, $destdir, $filelist) = @_;
     my $filebase;      my $filebase;
     my $fileext;      my $fileext;
     my $newfn;      my $newfn;
Line 588  sub convert_file { Line 595  sub convert_file {
     }      }
   
     # get base name and extension      # get base name and extension
     if ($filename =~ /^(.*)\.(\w+)$/) {      ($filebase, $fileext) = splitfn($filename);
     $filebase = $1;  
     $fileext = $2;  
     }  
   
     #      #
     # quick check if target image exists      # quick check if target image exists
Line 605  sub convert_file { Line 609  sub convert_file {
     my $newext = $target_ext_type{$pictype};      my $newext = $target_ext_type{$pictype};
     if ($newext) {      if ($newext) {
         $newfn = $filebase . ".$newext";          $newfn = $filebase . ".$newext";
           logger('DEBUG', "adding $destdir/$newfn'");
           $$filelist{"$destdir/$newfn"} = $filename;
         # check if file exists          # check if file exists
         if (-f "$destdir/$newfn") {          if (-f "$destdir/$newfn") {
         logger('DEBUG', "CONV file exists: $newfn");          logger('DEBUG', "CONV file exists: $newfn");
Line 676  sub convert_file { Line 682  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($srcdir, $workdir, $destdir) = @_;      my($srcdir, $workdir, $destdir, $filelist) = @_;
     my $errcnt = 0;      my $errcnt = 0;
     my $newfn;      my $newfn;
   
Line 689  sub walk_convert_dir { Line 695  sub walk_convert_dir {
   
     closedir WORKDIR;      closedir WORKDIR;
   
       # check all directories first
     if ($do_descend) {      if ($do_descend) {
     foreach (sort @dirlist) {      foreach (sort @dirlist) {
           # skip dot-directories
         next if (/^[.]+$/);          next if (/^[.]+$/);
           # skip junk directories
         next if ($junk_files{$_});          next if ($junk_files{$_});
           # recurse through the rest
         if (-d "$srcdir/$workdir/$_") {          if (-d "$srcdir/$workdir/$_") {
         walk_convert_dir($srcdir, "$workdir/$_", $destdir);          walk_convert_dir($srcdir, "$workdir/$_", $destdir, $filelist);
         }          }
     }      }
     }      }
Line 712  sub walk_convert_dir { Line 722  sub walk_convert_dir {
     };      };
     }      }
   
       # check all files in this directory
     foreach (sort @dirlist) {      foreach (sort @dirlist) {
     # skip dot-directories      # skip dot-files
     if (/^[.]+.*$/) {      next if (/^[.]+.*$/);
         next;      # try to convert the rest
     }  
     if (-f "$srcdir/$workdir/$_") {      if (-f "$srcdir/$workdir/$_") {
         $errcnt += convert_file("$srcdir/$workdir", "$_", "$destdir/$workdir");          $errcnt += convert_file("$srcdir/$workdir", "$_", "$destdir/$workdir", $filelist);
     }      }
     }      }
   
Line 739  sub walk_convert_dir { Line 749  sub walk_convert_dir {
 #  #
 sub convert_dir {  sub convert_dir {
     my ($srcdir, $workdir, $destdir) = @_;      my ($srcdir, $workdir, $destdir) = @_;
       my %files = ();
   
     logger('INFO', "** Converting Scans **");      logger('INFO', "** Converting Scans **");
   
     if (-d "$srcdir/$workdir") {      if (-d "$srcdir/$workdir") {
     # it's a dirrectory      # it's a dirrectory
     logger('INFO', "Starting in directory '$srcdir/$workdir'");      logger('INFO', "Starting in directory '$srcdir/$workdir'");
     walk_convert_dir($srcdir, $workdir, $destdir);      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      # touch source directory so digilib rescans the thumbnails
     #logger('DEBUG', "/usr/bin/touch $source_base_dirs[0]/$workdir");      #logger('DEBUG', "/usr/bin/touch $source_base_dirs[0]/$workdir");
     system("/usr/bin/touch '$srcdir/$workdir'");      system("/usr/bin/touch '$srcdir/$workdir'");
Line 766  sub convert_dir { Line 781  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;
   }
   
   
   
Line 779  if ($#ARGV < 3) { Line 834  if ($#ARGV < 3) {
     print "    -scaleto=destination size (S or WxH)\n";      print "    -scaleto=destination size (S or WxH)\n";
     print "    -scaleby=magnification factor.\n";      print "    -scaleby=magnification factor.\n";
     print "    -jpegqual=JPEG quality (0-100)\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";      print "    -encoder=tiff_png|tiff_jpeg|tiff_jpeg2\n";
     exit 1;      exit 1;
 }  }
Line 835  if ($$args{'replace'}) { Line 891  if ($$args{'replace'}) {
     $overwrite = 1;      $overwrite = 1;
 }  }
   
   # Synchronise
   if ($$args{'sync'}) {
       logger('INFO', "Set to delete unmatched files!");
       $synchronise = 1;
   }
   
 # debug  # debug
 if ($$args{'debug'}) {  if ($$args{'debug'}) {
     logger('INFO', "Set debug level to $$args{'debug'}!");      logger('INFO', "Set debug level to $$args{'debug'}!");
Removed from v.1.8  
changed lines
  Added in v.1.9

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