Annotation of scaleomat/MPIWGlib.pm, revision 1.2

1.1       casties     1: #!/usr/local/bin/perl -w
                      2: 
1.2     ! casties     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: 
1.1       casties    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;

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