--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/MPIWGStor.pm	Thu Jun 17 17:58:42 2004 +0200
@@ -0,0 +1,269 @@
+#!/usr/local/bin/perl -w
+
+#
+# Library with definitions and common routines for MPIWG storage system
+# scripts
+#
+
+package MPIWGStor;
+
+use strict;
+use vars qw(@ISA @EXPORT $VERSION
+	    $debug %junk_files %index_files $index_file_perm $archived_index_file_perm 
+	    $file_perm);
+use Exporter;
+
+$VERSION = 0.3; #  ROC 24.9.2003
+
+@ISA = qw(Exporter);
+
+@EXPORT = qw($debug %junk_files %index_files $index_file_perm $archived_index_file_perm 
+	     $file_perm
+	     &parseargs &logger &stime  &s2stime &ymd_date &split_file_path &sstrip 
+	     &valid_file_name &valid_dir_name &read_xml &write_xml);
+
+# debug level
+$debug = 0;
+
+# junk files
+%junk_files = (
+		  '.HSResource' => '.HSResource',
+		  '.HSancillary' => '.HSancillary',
+		  '.HSicon' => '.HSicon',
+		  'Network Trash Folder' => 'Network Trash Folder',
+		  'TheVolumeSettingsFolder' => 'TheVolumeSettingsFolder',
+		  '.DS_Store' => '.DS_Store'
+		  );
+
+# filenames to not delete (but archive)
+%index_files = ( 
+		     'index.meta' => 'index.meta',
+		     'index.meta.old' => 'index.meta.old'
+		     );
+
+# default permissions for normal index files (rw-rw-r--)
+$index_file_perm = 0664;
+# default permissions for archived index files (rw-r--r--)
+$archived_index_file_perm = 0644;
+# default permissions for other files (rw-rw-r--)
+$file_perm = 0664;
+
+
+#
+# $param_hash = parseargs;
+#
+# reads @ARGV and returns a hash with all options like "-option=value"
+# and the last part of the string as "path"
+#
+sub parseargs {
+    my %opts;
+    foreach my $s (@ARGV) {
+	if ($s =~ /^-([^=]+)=*(.*)$/) {
+	    $opts{$1} = ($2) ? $2 : $1;
+	} else {
+	    $opts{'path'} = $s;
+	}
+    }
+    return \%opts;
+}
+
+
+#
+# logger($level, $message)
+#
+# logs the $message (mostly to stdout)
+#
+sub logger {
+    my ($level, $message) = @_;
+    if ($debug || ($level ne "DEBUG")) {
+	print "$level: $message\n";
+    }
+}
+
+#
+# $stime = stime($utime)
+#
+# format utime (seconds since epoch) into string 
+# representation: "YYYY/MM/DD HH:MM:SS"
+#
+sub stime {
+    my ($utime) = @_;
+    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+	localtime($utime);
+    my $yy = $year + 1900;
+    my $mm = $mon + 1;
+    my $stime = sprintf("%d/%02d/%02d %02d:%02d:%02d", 
+			$yy, $mm, $mday, $hour, $min, $sec);
+    return $stime;
+}
+
+#
+# $stime = s2stime($stime2)
+#
+# format db-like time (2003-09-19 12:43:32+02) into string 
+# representation: "YYYY/MM/DD HH:MM:SS"
+#
+sub s2stime {
+    my ($s2time) = @_;
+    my $stime = "";
+    if ($s2time =~ /(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)/) {
+	my ($year,$mon,$mday,$hour,$min,$sec) = ($1, $2, $3, $4, $5, $6);
+	$stime = sprintf("%d/%02d/%02d %02d:%02d:%02d", 
+			$year, $mon, $mday, $hour, $min, $sec);
+    }
+    return $stime;
+}
+
+#
+# $date = ymd_date($olddate)
+#
+# converts a date string in mm/dd/yy format to yyyy/mm/dd format
+#
+sub ymd_date {
+    my ($mdy) = @_;
+    my $ydm;
+    if ($mdy =~ /(\d+)\/(\d+)\/(\d+)/) {
+	my $m = $1;
+	my $d = $2;
+	my $y = $3;
+	# extend yy to yyyy
+	$y = ($y < 70) ? (2000 + $y) : (($y < 100) ? ($y + 1900) : $y);
+	$ydm = sprintf "%d/%02d/%02d", $y, $m, $d;
+    }
+    return $ydm;
+}
+
+#
+# ($name, $path) = split_file_path($fn)
+#
+# splits the file path $fn into
+# file name (the last path element) and path
+#
+sub split_file_path {
+    my ($fn) = @_;
+
+    if ($fn =~ /^(.*)\/([^\/]+)$/) {
+        return ($2, $1);
+    }
+    return $fn;
+}
+
+
+#
+# $name = sstrip($name)
+#
+# strips leading and trailing whitespace from $name
+#
+sub sstrip {
+    my ($name) = @_;
+    
+    if ($name =~ /\s*(.*)\s*/) {
+	return $1;
+    }
+    return $name;
+}
+
+
+#
+# $valid = valid_file_name($name)
+#
+# checks if $name is a valid file name
+#
+sub valid_file_name {
+    return valid_name($_[0], 0);
+}
+
+
+#
+# $valid = valid_dir_name($name)
+#
+# checks if $name is a valid directory name
+#
+sub valid_dir_name {
+    return valid_name($_[0], 1);
+}
+
+
+#
+# $valid = valid_name($name, $mode)
+#
+# checks if $name is a valid file ($mode=0) or directory name (mode=1)
+#
+sub valid_name {
+    my ($name, $mode) = @_;
+
+    # whitespace?
+    if ($name =~ /\s+/) {
+	return 0;
+    }
+    # invalid characters
+    if ($name !~ /^[-\w.\/]+$/) {
+	return 0;
+    }
+    # files have extension
+    if ($mode == 0) {
+	if ($name !~ /\.[-\w]+$/) {
+	    return 0;
+	}
+    }
+    return 1;
+}
+
+
+#
+# ($document, $rootnode) = read_xml($file)
+#
+# reads xml meta file $file
+# returns root node element
+#
+sub read_xml {
+    my ($file) = @_;
+    my $document;
+
+    my $parser = XML::LibXML->new();
+    if (! $parser) {
+	logger("ABORT", "unable to create parser for metadata index file!!");
+	exit 1;
+    }
+
+    logger("INFO", "index file: $file");
+    eval { $document = $parser->parse_file($file) };
+    # catch parsing errors
+    if ($@) {
+	logger("ABORT", "XML syntax error in index file!!");
+	exit 1;
+    }
+    my $rootnode = $document->documentElement;
+    logger("INFO", "root element: \'" . $rootnode->nodeName . "\'");
+
+    return ($document, $rootnode);
+}
+
+
+#
+# write_xml($document, $file)
+#
+# saves the XML tree of $document to the file $file
+#
+sub write_xml {
+    my ($document, $filename) = @_;
+    # keep backup copy
+    if (-f $filename) {
+	if (! rename $filename, "$filename.old") {
+	    logger("ABORT", "unable to change file $filename!");
+	    exit 1;
+	}
+    }
+    # write new file
+    if ($document->toFile($filename)) {
+	logger("INFO", "written new file $filename");
+	chmod $index_file_perm, $filename;
+    } else {
+	logger("ABORT", "unable to write file $filename!");
+	exit 1;
+    }
+}
+
+
+# module init
+return 1;