Return to MPIWGlib.pm CVS log

Up to [Repository] / scaleomat

added GPL

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