File:  [Repository] / foxridge-archiver / MPIWGStor.pm
Revision 1.1: download - view: text, annotated - select for diffs - revision graph
Thu Jun 17 15:58:42 2004 UTC (20 years ago) by casties
Branches: MAIN
CVS tags: HEAD
Initial revision

    1: #!/usr/local/bin/perl -w
    2: 
    3: #
    4: # Library with definitions and common routines for MPIWG storage system
    5: # scripts
    6: #
    7: 
    8: package MPIWGStor;
    9: 
   10: use strict;
   11: use vars qw(@ISA @EXPORT $VERSION
   12: 	    $debug %junk_files %index_files $index_file_perm $archived_index_file_perm 
   13: 	    $file_perm);
   14: use Exporter;
   15: 
   16: $VERSION = 0.3; #  ROC 24.9.2003
   17: 
   18: @ISA = qw(Exporter);
   19: 
   20: @EXPORT = qw($debug %junk_files %index_files $index_file_perm $archived_index_file_perm 
   21: 	     $file_perm
   22: 	     &parseargs &logger &stime  &s2stime &ymd_date &split_file_path &sstrip 
   23: 	     &valid_file_name &valid_dir_name &read_xml &write_xml);
   24: 
   25: # debug level
   26: $debug = 0;
   27: 
   28: # junk files
   29: %junk_files = (
   30: 		  '.HSResource' => '.HSResource',
   31: 		  '.HSancillary' => '.HSancillary',
   32: 		  '.HSicon' => '.HSicon',
   33: 		  'Network Trash Folder' => 'Network Trash Folder',
   34: 		  'TheVolumeSettingsFolder' => 'TheVolumeSettingsFolder',
   35: 		  '.DS_Store' => '.DS_Store'
   36: 		  );
   37: 
   38: # filenames to not delete (but archive)
   39: %index_files = ( 
   40: 		     'index.meta' => 'index.meta',
   41: 		     'index.meta.old' => 'index.meta.old'
   42: 		     );
   43: 
   44: # default permissions for normal index files (rw-rw-r--)
   45: $index_file_perm = 0664;
   46: # default permissions for archived index files (rw-r--r--)
   47: $archived_index_file_perm = 0644;
   48: # default permissions for other files (rw-rw-r--)
   49: $file_perm = 0664;
   50: 
   51: 
   52: #
   53: # $param_hash = parseargs;
   54: #
   55: # reads @ARGV and returns a hash with all options like "-option=value"
   56: # and the last part of the string as "path"
   57: #
   58: sub parseargs {
   59:     my %opts;
   60:     foreach my $s (@ARGV) {
   61: 	if ($s =~ /^-([^=]+)=*(.*)$/) {
   62: 	    $opts{$1} = ($2) ? $2 : $1;
   63: 	} else {
   64: 	    $opts{'path'} = $s;
   65: 	}
   66:     }
   67:     return \%opts;
   68: }
   69: 
   70: 
   71: #
   72: # logger($level, $message)
   73: #
   74: # logs the $message (mostly to stdout)
   75: #
   76: sub logger {
   77:     my ($level, $message) = @_;
   78:     if ($debug || ($level ne "DEBUG")) {
   79: 	print "$level: $message\n";
   80:     }
   81: }
   82: 
   83: #
   84: # $stime = stime($utime)
   85: #
   86: # format utime (seconds since epoch) into string 
   87: # representation: "YYYY/MM/DD HH:MM:SS"
   88: #
   89: sub stime {
   90:     my ($utime) = @_;
   91:     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
   92: 	localtime($utime);
   93:     my $yy = $year + 1900;
   94:     my $mm = $mon + 1;
   95:     my $stime = sprintf("%d/%02d/%02d %02d:%02d:%02d", 
   96: 			$yy, $mm, $mday, $hour, $min, $sec);
   97:     return $stime;
   98: }
   99: 
  100: #
  101: # $stime = s2stime($stime2)
  102: #
  103: # format db-like time (2003-09-19 12:43:32+02) into string 
  104: # representation: "YYYY/MM/DD HH:MM:SS"
  105: #
  106: sub s2stime {
  107:     my ($s2time) = @_;
  108:     my $stime = "";
  109:     if ($s2time =~ /(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)/) {
  110: 	my ($year,$mon,$mday,$hour,$min,$sec) = ($1, $2, $3, $4, $5, $6);
  111: 	$stime = sprintf("%d/%02d/%02d %02d:%02d:%02d", 
  112: 			$year, $mon, $mday, $hour, $min, $sec);
  113:     }
  114:     return $stime;
  115: }
  116: 
  117: #
  118: # $date = ymd_date($olddate)
  119: #
  120: # converts a date string in mm/dd/yy format to yyyy/mm/dd format
  121: #
  122: sub ymd_date {
  123:     my ($mdy) = @_;
  124:     my $ydm;
  125:     if ($mdy =~ /(\d+)\/(\d+)\/(\d+)/) {
  126: 	my $m = $1;
  127: 	my $d = $2;
  128: 	my $y = $3;
  129: 	# extend yy to yyyy
  130: 	$y = ($y < 70) ? (2000 + $y) : (($y < 100) ? ($y + 1900) : $y);
  131: 	$ydm = sprintf "%d/%02d/%02d", $y, $m, $d;
  132:     }
  133:     return $ydm;
  134: }
  135: 
  136: #
  137: # ($name, $path) = split_file_path($fn)
  138: #
  139: # splits the file path $fn into
  140: # file name (the last path element) and path
  141: #
  142: sub split_file_path {
  143:     my ($fn) = @_;
  144: 
  145:     if ($fn =~ /^(.*)\/([^\/]+)$/) {
  146:         return ($2, $1);
  147:     }
  148:     return $fn;
  149: }
  150: 
  151: 
  152: #
  153: # $name = sstrip($name)
  154: #
  155: # strips leading and trailing whitespace from $name
  156: #
  157: sub sstrip {
  158:     my ($name) = @_;
  159:     
  160:     if ($name =~ /\s*(.*)\s*/) {
  161: 	return $1;
  162:     }
  163:     return $name;
  164: }
  165: 
  166: 
  167: #
  168: # $valid = valid_file_name($name)
  169: #
  170: # checks if $name is a valid file name
  171: #
  172: sub valid_file_name {
  173:     return valid_name($_[0], 0);
  174: }
  175: 
  176: 
  177: #
  178: # $valid = valid_dir_name($name)
  179: #
  180: # checks if $name is a valid directory name
  181: #
  182: sub valid_dir_name {
  183:     return valid_name($_[0], 1);
  184: }
  185: 
  186: 
  187: #
  188: # $valid = valid_name($name, $mode)
  189: #
  190: # checks if $name is a valid file ($mode=0) or directory name (mode=1)
  191: #
  192: sub valid_name {
  193:     my ($name, $mode) = @_;
  194: 
  195:     # whitespace?
  196:     if ($name =~ /\s+/) {
  197: 	return 0;
  198:     }
  199:     # invalid characters
  200:     if ($name !~ /^[-\w.\/]+$/) {
  201: 	return 0;
  202:     }
  203:     # files have extension
  204:     if ($mode == 0) {
  205: 	if ($name !~ /\.[-\w]+$/) {
  206: 	    return 0;
  207: 	}
  208:     }
  209:     return 1;
  210: }
  211: 
  212: 
  213: #
  214: # ($document, $rootnode) = read_xml($file)
  215: #
  216: # reads xml meta file $file
  217: # returns root node element
  218: #
  219: sub read_xml {
  220:     my ($file) = @_;
  221:     my $document;
  222: 
  223:     my $parser = XML::LibXML->new();
  224:     if (! $parser) {
  225: 	logger("ABORT", "unable to create parser for metadata index file!!");
  226: 	exit 1;
  227:     }
  228: 
  229:     logger("INFO", "index file: $file");
  230:     eval { $document = $parser->parse_file($file) };
  231:     # catch parsing errors
  232:     if ($@) {
  233: 	logger("ABORT", "XML syntax error in index file!!");
  234: 	exit 1;
  235:     }
  236:     my $rootnode = $document->documentElement;
  237:     logger("INFO", "root element: \'" . $rootnode->nodeName . "\'");
  238: 
  239:     return ($document, $rootnode);
  240: }
  241: 
  242: 
  243: #
  244: # write_xml($document, $file)
  245: #
  246: # saves the XML tree of $document to the file $file
  247: #
  248: sub write_xml {
  249:     my ($document, $filename) = @_;
  250:     # keep backup copy
  251:     if (-f $filename) {
  252: 	if (! rename $filename, "$filename.old") {
  253: 	    logger("ABORT", "unable to change file $filename!");
  254: 	    exit 1;
  255: 	}
  256:     }
  257:     # write new file
  258:     if ($document->toFile($filename)) {
  259: 	logger("INFO", "written new file $filename");
  260: 	chmod $index_file_perm, $filename;
  261:     } else {
  262: 	logger("ABORT", "unable to write file $filename!");
  263: 	exit 1;
  264:     }
  265: }
  266: 
  267: 
  268: # module init
  269: return 1;

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