version 1.6, 2005/09/23 17:16:17
|
version 1.8, 2008/09/10 12:59:45
|
Line 16 $|=1;
|
Line 16 $|=1;
|
# |
# |
|
|
# program version |
# program version |
my $version = "0.7.1 (ROC 23.9.2005)"; |
my $version = "0.7.3 (ROC 10.9.2008)"; |
|
|
# 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 355 sub delete_all_files {
|
Line 359 sub delete_all_files {
|
logger('START', "archiver $version at $archdate"); |
logger('START', "archiver $version at $archdate"); |
|
|
# make shure the right user is running this program |
# make shure the right user is running this program |
my $user = getlogin; |
my $user = getlogin || getpwuid($<); |
if (($user ne "archive")&&($user ne "root")) { |
if (($user ne "archive")&&($user ne "root")) { |
logger("WARNING", "you ($user) should be archive or root user to run this program!"); |
logger("WARNING", "you ($user) should be archive or root user to run this program!"); |
} |
} |
Line 372 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>) { |