--- foxridge-archiver/archiver.pl	2004/07/08 17:27:59	1.2
+++ foxridge-archiver/archiver.pl	2005/09/23 17:16:17	1.6
@@ -16,16 +16,40 @@ $|=1;
 #
 
 # program version
-my $version = "0.5.1 (8.7.2004)";
+my $version = "0.7.1 (ROC 23.9.2005)";
+
+# short help
+my $help = "MPIWG archiver $version
+use:  archiver [options] docpath
+options:
+  -debug  show debugging info
+  -premigrate  don't delete archived files
+  -force  archive even if already archived
+";
+
+# read command line parameters
+my $args = MPIWGStor::parseargs;
+if (! scalar(%$args)) {
+    print $help, "\n";
+    exit 1;
+}
+
+# debug level
+$debug = (exists $$args{'debug'}) ? $$args{'debug'} : 0;
+
+# force archiving
+my $force_archive = (exists $$args{'force'}) ? $$args{'force'} : 0;
 
 # rewrite XML file (necessary for archive date!)
 my $fix_xml = 1;
 my $xml_changed = 0;
+
 # XML namespace (not really implemented!)
 my $namespace = "";
 
 # archive name (archive-path element, usually == $docdir)
 my $archname;
+
 # archive storage date (now)
 my $archdate = stime(time);
 
@@ -35,50 +59,52 @@ my $delete_junk_files = 1;
 # delete data files after archiving
 my $delete_data_files = 1;
 
+# don't delete archived files with "-premigrate"
+if (exists $$args{'premigrate'}) {
+    $delete_data_files = not $$args{'premigrate'};
+}
+if ($delete_data_files) {
+    logger('INFO', "going to remove successfully archived files from disk");
+}
+
 
 #######################################################
 # external programs
 #
 my $archprog = "/opt/tivoli/tsm/client/ba/bin/dsmc";
 if (! -x $archprog) {
-    print "ABORT: TSM client program '$archprog' missing!!\n";
+    logger('ABORT', "TSM client program '$archprog' missing!");
     exit 1;
 }
 my $checkprog = "/usr/local/mpiwg/archive/metacheck";
 if (! -x $checkprog) {
-    print "ABORT: meta data checking program '$checkprog' missing!!\n";
+    logger('ABORT', "meta data checking program '$checkprog' missing!");
     exit 1;
 }
 # log file for archiver
 my $log_file = "/var/log/mpiwg-archiver.log";
 if (! open LOG, ">>$log_file") {
-    print "ABORT: unable to write log file '$log_file'!!\n";
+    logger('ABORT', "unable to write log file '$log_file'!");
     exit 1;
 }
 
 #######################################################
 # check parameters that were passed to the program
 #
-if ($#ARGV < 0) {
-    print "ABORT: no document directory given!\n";
-    exit 1;
-}
-my $docdir = $ARGV[0];
+
+my $docdir = $$args{'path'};
 # strip double slashes
 $docdir =~ s/\/\//\//;
 # strip trailing slashes
 $docdir =~ s/\/+$//;
 if (! -d $docdir) {
-    print "ABORT: document directory \'$docdir\' doesn't exist!\n";
+    logger('ABORT', "document directory \'$docdir\' doesn't exist!");
     exit 1;
 }
-if (($#ARGV > 0)&&($ARGV[1] eq "-premigrate")) {
-    $delete_data_files = 0;
-}
 
 my $metafile = "$docdir/index.meta";
 if (! -f $metafile) {
-    print "ABORT: metadata index file \'$metafile\' doesn't exist!\n";
+    logger('ABORT', "metadata index file \'$metafile\' doesn't exist!");
     exit 1;
 }
 
@@ -109,7 +135,7 @@ sub read_resource_meta {
     # get archive-path
     $archname = MPIWGStor::sstrip($rootnode->findvalue('child::archive-path'));
     if (! $archname) {
-	print "ABORT: archive-name element missing!!\n";
+	logger('ABORT', "archive-name element missing!");
 	exit 1;
     }
 
@@ -120,7 +146,7 @@ sub read_resource_meta {
     foreach my $fn (@filenodes) {
 	my $name = MPIWGStor::sstrip($fn->findvalue('child::name'));
 	my $path = MPIWGStor::sstrip($fn->findvalue('child::path'));
-	print "FILE: ($path)$name\n";
+	logger('DEBUG', "FILE ($path)$name");
 	my $f = ($path) ? "$path/$name" : "$name";
 	$files{$f} = $name;
     }
@@ -130,7 +156,7 @@ sub read_resource_meta {
     #
     my $stordatenode = ($rootnode->find('child::archive-storage-date'))->get_node(1);
     if ($stordatenode) {
-	print "WARNING: archive storage date exists! Resource already archived?\n";
+	logger('WARNING', "archive storage date exists! Resource already archived?");
 	$warncnt++;
 	# delete old date
 	$stordatenode->removeChildNodes;
@@ -173,7 +199,7 @@ sub run_archive {
 	    }
 	}
     } else {
-	print "ABORT: unable to start archive command '$archcmd'!!\n";
+	logger('ABORT', "unable to start archive command '$archcmd'!!");
 	exit 1;
     }
 
@@ -196,10 +222,10 @@ sub check_files {
 	my $fp = "$docdir/$ft";
 	#print "  fp: $fp\n";
 	if ($$archived{$fp}) {
-	    print "DEBUG: $ft archived OK\n";
+	    logger('DEBUG', "$ft archived OK");
 	    $$archived{$fp} = "OK";
 	} else {
-	    print "ERROR: file '$ft' missing from archive!\n";
+	    logger('ERROR', "file '$ft' missing from archive!");
 	    $errcnt++;
 	}
     }
@@ -208,19 +234,19 @@ sub check_files {
 	if ($$archived{$fa} ne "OK") {
 	    my ($fn, $fp) = MPIWGStor::split_file_path($fa);
 	    if ($MPIWGStor::index_files{$fn}) {
-		print "DEBUG: $fa ignored\n";
+		logger('DEBUG', "$fa ignored");
 		$na--;
 	    } else {
-		print "WARNING: $fa archived but not in list!\n";
+		logger('WARNING', "$fa archived but not in list!");
 		$warncnt++;
 	    }
 	}
     }
 
     if ($nt > $na) {
-	print "WARNING: less files were archived ($na vs. $nt)!\n";
+	logger('WARNING', "less files were archived ($na vs. $nt)!");
     } elsif ($na > $nt) {
-	print "WARNING: more files were archived ($na vs. $nt)!\n";
+	logger('WARNING', "more files were archived ($na vs. $nt)!");
     }
 
 }
@@ -248,9 +274,9 @@ sub delete_files {
 	next unless (-f $f);
 	# delete files
 	if (unlink $f) {
-	    print "INFO: remove $f ($fn)\n";
+	    logger('DEBUG', "remove $f ($fn)");
 	} else {
-	    print "ERROR: unable to delete $f!\n";
+	    logger('ERROR', "unable to delete $f!");
 	    $errcnt++;
 	}
     }
@@ -262,7 +288,7 @@ sub delete_files {
 	# dont't remove document dir (shouldn't be empty anyway)
 	next if ($d eq $docdir);
 	if (-d $d) {
-	    print "INFO: remove dir $d\n";
+	    logger('DEBUG', "remove dir $d");
 	    rmdir $d;
 	}
     }
@@ -279,7 +305,7 @@ sub delete_all_files {
     my ($files, $dir) = @_;
 
     if (! opendir DIR, $dir) {
-	print "ERROR: unable to read directory $dir!\n";
+	logger('ERROR', "unable to read directory $dir!");
 	$errcnt++;
 	return;
     }
@@ -293,28 +319,28 @@ sub delete_all_files {
 	    if (-f "$dir/$f") {
 		# $f is a file
 		if (unlink "$dir/$f") {
-		    print "INFO: removed $f\n";
+		    logger('DEBUG', "removed $f");
 		} else {
-		    print "ERROR: unable to delete $f!\n";
+		    logger('ERROR', "unable to delete $f!");
 		    $errcnt++;
 		}
 	    } elsif (-d _) {
 		# $f is a directory (unlink won't work)
 		if ((system 'rm', '-r', "$dir/$f") == 0) {
-		    print "INFO: removed directory $f\n";
+		    logger('DEBUG', "removed directory $f");
 		} else {
-		    print "ERROR: unable to delete directory $f!\n";
+		    logger('ERROR', "unable to delete directory $f!");
 		    $errcnt++;
 		}
 	    } else {
-		print "ERROR: funny object $dir/$f!\n";
+		logger('ERROR', "funny object $dir/$f!");
 		$errcnt++;
 	    }
 	} else {
 	    # $f is not in the list
 	    if (-d "$dir/$f") {
 		# recurse into directories
-		print "DEBUG: enter $dir/$f\n";
+		logger('DEBUG', "enter $dir/$f");
 		delete_all_files($files, "$dir/$f");
 	    }
 	}
@@ -326,22 +352,54 @@ sub delete_all_files {
 # main
 #
 
-print "START: archiver $version at $archdate\n";
+logger('START', "archiver $version at $archdate");
 
 # make shure the right user is running this program
 my $user = getlogin;
-#if (($user ne "archive")||($user ne "root")) {
-#    logger("ABORT", "you ($user) must be archive or root user to run this program!");
-#    exit 1;
-#}
+if (($user ne "archive")&&($user ne "root")) {
+    logger("WARNING", "you ($user) should be archive or root user to run this program!");
+}
+
+# check for .archived file
+if (-f "$docdir/.archived") {
+    if (not $force_archive) {
+	logger('ABORT', "already archived! (.archived file exists)");
+	exit 1;
+    } else {
+	logger('WARNING', "resource already archived? (.archived file exists)");
+	$warncnt++;
+    }
+}
 
 # use metacheck first
-if (system("$checkprog $docdir >/dev/null") == 0) {
-    print "INFO: resource '$docdir' check OK\n";
+if (open CHECK, "$checkprog -add-files $docdir |") {
+    my @errors;
+    my $msg;
+    while (<CHECK>) {
+	chomp;
+	if (/^ERROR/) {
+	    push @errors, $_;
+	}
+	$msg = $_;
+    }
+    if ($msg =~ /^DONE/) {
+	logger('DEBUG', "checking index file: $msg");
+	logger('INFO', "resource '$docdir' check OK");
+    } else {
+	logger('DEBUG', "errors checking index file:\n    " . join("\n    ", @errors) . "\n    $msg");
+	logger('ABORT', "resource '$docdir' check failed!");
+	exit 1;
+    }
 } else {
-    print "ABORT: resource '$docdir' check failed!!\n";
+    logger('ABORT', "unable to run $checkprog");
     exit 1;
 }
+# if (system("$checkprog $docdir >/dev/null") == 0) {
+#     logger('INFO', "resource '$docdir' check OK");
+# } else {
+#     logger('ABORT', "resource '$docdir' check failed!!");
+#     exit 1;
+# }
 
 # read index.meta file
 my ($document, $rootnode) = MPIWGStor::read_xml($metafile);
@@ -349,15 +407,15 @@ my ($document, $rootnode) = MPIWGStor::r
 # check file and add archive date
 my $files_to_archive = read_resource_meta($rootnode);
 
-print "INFO: ", scalar keys %$files_to_archive, " files to archive\n";
+logger('INFO', (scalar keys %$files_to_archive) . " files to archive");
 
-# check for .archived file
+# remove .archived file
 if (-f "$docdir/.archived") {
     if (unlink "$docdir/.archived") {
-	print "WARNING: existing .archived file has been removed! Resource already archived?\n";
+	logger('WARNING', "existing .archived file has been removed!");
 	$warncnt++;
     } else {
-	print "ERROR: unable to remove existing .archived file!\n";
+	logger('ERROR', "unable to remove existing .archived file!");
 	$errcnt++;
     }
 }
@@ -369,7 +427,7 @@ if ($delete_junk_files) {
 
 # write new index.meta
 if ($errcnt > 0) {
-    print "ABORT: there were errors!\n";
+    logger('ABORT', "there were errors!");
     exit 1;
 } else {
     if ($fix_xml) {
@@ -378,9 +436,10 @@ if ($errcnt > 0) {
 }
 
 # start archiving
-my $archived_files = run_archive;
+my $archived_files = run_archive();
+my $num_archfiles = scalar keys %$archived_files;
 
-print "INFO: ", scalar keys %$archived_files, " files archived\n";
+logger('INFO', "$num_archfiles files archived");
 
 # check list of archived files
 check_files($files_to_archive, $archived_files);
@@ -398,12 +457,11 @@ if ($errcnt == 0) {
     }
 }
 
-print "INFO: $warncnt warnings\n";
-print "INFO: $errcnt errors\n";
-my $num_archfiles = %$archived_files + 1;
+logger('INFO', "$warncnt warnings");
+logger('INFO', "$errcnt errors");
 if ($errcnt > 0) {
-    print "ABORT: there were errors! ($num_archfiles files archived) at ", stime(time), "\n";
+    logger('ABORT', "there were errors! ($num_archfiles files archived) at " . stime(time));
     exit 1;
 } else {
-    print "DONE: $num_archfiles files archived at ", stime(time), "\n";
+    logger('DONE', "$num_archfiles files archived at " . stime(time));
 }