Annotation of foxridge-archiver/MPIWGStor.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 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>
![[BACK]](/cvs/cvsweb/icons/back.gif){kind=icon}
Return to MPIWGStor.pm CVS log ![[TXT]](/cvs/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvs/cvsweb/icons/dir.gif){kind=icon}
Up to [Repository] / foxridge-archiver