Diff for /foxridge-archiver/archiver.pl between versions 1.5 and 1.7

version 1.5, 2005/09/20 17:24:57 version 1.7, 2005/10/05 13:35:12
Line 16  $|=1; Line 16  $|=1;
 #  #
   
 # program version  # program version
 my $version = "0.7 (ROC 20.9.2005)";  my $version = "0.7.2 (ROC 5.10.2005)";
   
 # short help  # short help
 my $help = "MPIWG archiver $version  my $help = "MPIWG archiver $version
Line 25  options: Line 25  options:
   -debug  show debugging info    -debug  show debugging info
   -premigrate  don't delete archived files    -premigrate  don't delete archived files
   -force  archive even if already archived    -force  archive even if already archived
     -replace  rewrite index file
 ";  ";
   
 # read command line parameters  # read command line parameters
Line 40  $debug = (exists $$args{'debug'}) ? $$ar Line 41  $debug = (exists $$args{'debug'}) ? $$ar
 # force archiving  # force archiving
 my $force_archive = (exists $$args{'force'}) ? $$args{'force'} : 0;  my $force_archive = (exists $$args{'force'}) ? $$args{'force'} : 0;
   
   # rewrite index file
   my $rewrite_index = (exists $$args{'replace'}) ? $$args{'replace'} : 0;
   
 # rewrite XML file (necessary for archive date!)  # rewrite XML file (necessary for archive date!)
 my $fix_xml = 1;  my $fix_xml = 1;
 my $xml_changed = 0;  my $xml_changed = 0;
Line 274  sub delete_files { Line 278  sub delete_files {
     next unless (-f $f);      next unless (-f $f);
     # delete files      # delete files
     if (unlink $f) {      if (unlink $f) {
         logger('INFO', "remove $f ($fn)");          logger('DEBUG', "remove $f ($fn)");
     } else {      } else {
         logger('ERROR', "unable to delete $f!");          logger('ERROR', "unable to delete $f!");
         $errcnt++;          $errcnt++;
Line 288  sub delete_files { Line 292  sub delete_files {
     # dont't remove document dir (shouldn't be empty anyway)      # dont't remove document dir (shouldn't be empty anyway)
     next if ($d eq $docdir);      next if ($d eq $docdir);
     if (-d $d) {      if (-d $d) {
         logger('INFO', "remove dir $d");          logger('DEBUG', "remove dir $d");
         rmdir $d;          rmdir $d;
     }      }
     }      }
Line 319  sub delete_all_files { Line 323  sub delete_all_files {
         if (-f "$dir/$f") {          if (-f "$dir/$f") {
         # $f is a file          # $f is a file
         if (unlink "$dir/$f") {          if (unlink "$dir/$f") {
             logger('INFO', "removed $f");              logger('DEBUG', "removed $f");
         } else {          } else {
             logger('ERROR', "unable to delete $f!");              logger('ERROR', "unable to delete $f!");
             $errcnt++;              $errcnt++;
Line 327  sub delete_all_files { Line 331  sub delete_all_files {
         } elsif (-d _) {          } elsif (-d _) {
         # $f is a directory (unlink won't work)          # $f is a directory (unlink won't work)
         if ((system 'rm', '-r', "$dir/$f") == 0) {          if ((system 'rm', '-r', "$dir/$f") == 0) {
             logger('INFO', "removed directory $f");              logger('DEBUG', "removed directory $f");
         } else {          } else {
             logger('ERROR', "unable to delete directory $f!");              logger('ERROR', "unable to delete directory $f!");
             $errcnt++;              $errcnt++;
Line 357  logger('START', "archiver $version at $a Line 361  logger('START', "archiver $version at $a
 # make shure the right user is running this program  # make shure the right user is running this program
 my $user = getlogin;  my $user = getlogin;
 if (($user ne "archive")&&($user ne "root")) {  if (($user ne "archive")&&($user ne "root")) {
     logger("ABORT", "you ($user) must be archive or root user to run this program!");      logger("WARNING", "you ($user) should be archive or root user to run this program!");
     exit 1;  
 }  }
   
 # check for .archived file  # check for .archived file
Line 373  if (-f "$docdir/.archived") { Line 376  if (-f "$docdir/.archived") {
 }  }
   
 # use metacheck first  # use metacheck first
 if (open CHECK, "$checkprog -add-files $docdir |") {  my $check_opts="-add-files";
   if ($rewrite_index) {
       $check_opts = "-replace";
   }
   if (open CHECK, "$checkprog $check_opts $docdir |") {
     my @errors;      my @errors;
     my $msg;      my $msg;
     while (<CHECK>) {      while (<CHECK>) {

Removed from v.1.5  
changed lines
  Added in v.1.7


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