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>