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