Mercurial > hg > foxridge-archiver
annotate MPIWGStor.pm @ 18:fdf4ceb36db1
fixed problem with dir names in metacheck
new version of metacheck defaults to not change index file
new version of archiver uses new version of metacheck
| author | casties |
|---|---|
| date | Tue, 20 Sep 2005 19:24:57 +0200 |
| parents | 8eee361fdec8 |
| children | 2890dd75d2f6 |
| rev | line source |
|---|---|
| 0 | 1 |
| 2 # | |
| 3 # Library with definitions and common routines for MPIWG storage system | |
| 4 # scripts | |
| 5 # | |
| 6 | |
| 7 package MPIWGStor; | |
| 8 | |
| 9 use strict; | |
| 10 use vars qw(@ISA @EXPORT $VERSION | |
| 11 $debug %junk_files %index_files $index_file_perm $archived_index_file_perm | |
| 12 $file_perm); | |
| 13 use Exporter; | |
| 14 | |
| 16 | 15 $VERSION = 0.6.1; # ROC 8.8.2005 |
| 0 | 16 |
| 17 @ISA = qw(Exporter); | |
| 18 | |
| 19 @EXPORT = qw($debug %junk_files %index_files $index_file_perm $archived_index_file_perm | |
| 20 $file_perm | |
| 21 &parseargs &logger &stime &s2stime &ymd_date &split_file_path &sstrip | |
|
12
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
22 &valid_file_name &valid_dir_name &park_file &unpark_file |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
23 &read_xml &write_xml &add_text_element &create_element_path &create_text_path); |
| 0 | 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 { | |
| 18 | 143 my ($fn, $nodot) = @_; |
| 0 | 144 |
| 145 if ($fn =~ /^(.*)\/([^\/]+)$/) { | |
| 146 return ($2, $1); | |
| 18 | 147 } |
| 148 # only file name | |
| 149 if ($nodot) { | |
| 150 return ($fn, ''); | |
| 151 } else { | |
| 152 return ($fn, '.'); | |
| 0 | 153 } |
| 154 } | |
| 155 | |
| 156 | |
| 157 # | |
| 158 # $name = sstrip($name) | |
| 159 # | |
| 160 # strips leading and trailing whitespace from $name | |
| 161 # | |
| 162 sub sstrip { | |
| 163 my ($name) = @_; | |
| 164 | |
| 165 if ($name =~ /\s*(.*)\s*/) { | |
| 166 return $1; | |
| 167 } | |
| 168 return $name; | |
| 169 } | |
| 170 | |
| 171 | |
| 172 # | |
| 173 # $valid = valid_file_name($name) | |
| 174 # | |
| 175 # checks if $name is a valid file name | |
| 176 # | |
| 177 sub valid_file_name { | |
| 178 return valid_name($_[0], 0); | |
| 179 } | |
| 180 | |
| 181 | |
| 182 # | |
| 183 # $valid = valid_dir_name($name) | |
| 184 # | |
| 185 # checks if $name is a valid directory name | |
| 186 # | |
| 187 sub valid_dir_name { | |
| 188 return valid_name($_[0], 1); | |
| 189 } | |
| 190 | |
| 191 | |
| 192 # | |
| 193 # $valid = valid_name($name, $mode) | |
| 194 # | |
| 195 # checks if $name is a valid file ($mode=0) or directory name (mode=1) | |
| 196 # | |
| 197 sub valid_name { | |
| 198 my ($name, $mode) = @_; | |
| 199 | |
| 200 # whitespace? | |
| 201 if ($name =~ /\s+/) { | |
| 202 return 0; | |
| 203 } | |
| 204 # invalid characters | |
| 205 if ($name !~ /^[-\w.\/]+$/) { | |
| 206 return 0; | |
| 207 } | |
| 208 # files have extension | |
| 209 if ($mode == 0) { | |
| 210 if ($name !~ /\.[-\w]+$/) { | |
| 211 return 0; | |
| 212 } | |
| 213 } | |
| 214 return 1; | |
| 215 } | |
| 216 | |
| 217 | |
| 218 # | |
| 10 | 219 # $newfilename = park_file($filename) |
| 220 # | |
| 221 # parks a file under a new name (*.bak) | |
| 222 # | |
| 223 sub park_file { | |
| 224 my ($filename) = @_; | |
| 225 my $newfn = ""; | |
| 226 if (-f $filename) { | |
| 227 $newfn = "$filename.bak"; | |
| 228 if (! rename $filename, $newfn) { | |
| 229 logger("ABORT", "unable to rename file $filename!"); | |
| 230 exit 1; | |
| 231 } | |
| 232 } | |
| 233 return $newfn; | |
| 234 } | |
| 235 | |
| 236 # | |
| 237 # $filename = unpark_file($filename) | |
| 238 # | |
| 239 # unparks a file | |
| 240 # | |
| 241 sub unpark_file { | |
| 242 my ($filename) = @_; | |
| 243 my $newfn = "$filename.bak"; | |
| 244 if (-f $newfn) { | |
| 245 if (! rename $newfn, $filename) { | |
| 246 logger("ABORT", "unable to rename file $newfn!"); | |
| 247 exit 1; | |
| 248 } | |
| 249 return $filename; | |
| 250 } | |
| 251 return ""; | |
| 252 } | |
| 253 | |
| 254 | |
| 255 | |
| 256 # | |
| 0 | 257 # ($document, $rootnode) = read_xml($file) |
| 258 # | |
| 259 # reads xml meta file $file | |
| 260 # returns root node element | |
| 261 # | |
| 262 sub read_xml { | |
| 263 my ($file) = @_; | |
| 264 my $document; | |
| 265 | |
| 266 my $parser = XML::LibXML->new(); | |
| 267 if (! $parser) { | |
| 268 logger("ABORT", "unable to create parser for metadata index file!!"); | |
| 269 exit 1; | |
| 270 } | |
| 271 | |
|
12
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
272 logger("DEBUG", "index file: $file"); |
| 0 | 273 eval { $document = $parser->parse_file($file) }; |
| 274 # catch parsing errors | |
| 275 if ($@) { | |
|
12
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
276 logger("ABORT", "XML syntax error in file $file!!"); |
| 0 | 277 exit 1; |
| 278 } | |
| 279 my $rootnode = $document->documentElement; | |
|
12
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
280 logger("DEBUG", "root element: \'" . $rootnode->nodeName . "\'"); |
| 0 | 281 |
| 282 return ($document, $rootnode); | |
| 283 } | |
| 284 | |
| 285 | |
| 286 # | |
| 287 # write_xml($document, $file) | |
| 288 # | |
| 289 # saves the XML tree of $document to the file $file | |
| 290 # | |
| 291 sub write_xml { | |
| 292 my ($document, $filename) = @_; | |
| 293 # keep backup copy | |
| 294 if (-f $filename) { | |
| 295 if (! rename $filename, "$filename.old") { | |
| 296 logger("ABORT", "unable to change file $filename!"); | |
| 297 exit 1; | |
| 298 } | |
| 299 } | |
| 300 # write new file | |
|
12
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
301 my ($fn, $dir) = split_file_path($filename); |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
302 if (-d $dir && $document->toFile($filename)) { |
| 0 | 303 logger("INFO", "written new file $filename"); |
| 304 chmod $index_file_perm, $filename; | |
| 305 } else { | |
| 306 logger("ABORT", "unable to write file $filename!"); | |
| 307 exit 1; | |
| 308 } | |
| 309 } | |
| 310 | |
|
12
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
311 # |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
312 # $elem = add_text_element($node, $name, $value, $namespace) |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
313 # |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
314 # creates an XML element with the name $name and the text content |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
315 # $value attached to the node $node and returns it. |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
316 # |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
317 sub add_text_element { |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
318 my ($node, $name, $value, $namespace) = @_; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
319 |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
320 my $doc = $node->ownerDocument; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
321 my $text = $doc->createTextNode($value); |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
322 my $newnode = $node->addNewChild($namespace, $name); |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
323 $newnode->addChild($text); |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
324 |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
325 return $newnode; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
326 } |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
327 |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
328 # |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
329 # $elem = create_element_path($path, $root, $namespace) |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
330 # |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
331 # creates and returns a DOM element at the given path from the |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
332 # given root. path is e.g. meta/bib@type=book. elements are separated |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
333 # by /, an additional attribute can be specified after the @. |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
334 # |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
335 sub create_element_path { |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
336 my ($path, $root, $namespace) = @_; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
337 my $attribute = ""; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
338 # get attribute |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
339 if ($path =~ /^(.+)@(.+)$/) { |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
340 $attribute = $2; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
341 $path = $1; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
342 } |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
343 my $point = $root; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
344 for my $p (split /\//, $path) { |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
345 # check if the next path element exists |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
346 my $n = ($point->findnodes($p))[0]; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
347 if ($n) { |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
348 $point = $n; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
349 } else { |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
350 # create if it doesn't exist |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
351 $point = $point->addNewChild($namespace, $p); |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
352 } |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
353 } |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
354 # add the attribute |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
355 if ($attribute) { |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
356 my $dom = $root->getOwner(); |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
357 my ($attkey, $attval) = split /=/, $attribute; #/ silly fontlock... |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
358 $point->addChild($dom->createAttributeNS($namespace, $attkey, $attval)); |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
359 } |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
360 return $point; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
361 } |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
362 |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
363 # |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
364 # $elem = create_text_path($path, $text, $root, $namespace) |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
365 # |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
366 # creates and returns a DOM text element with the given content at the |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
367 # given path from the given root. |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
368 # |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
369 sub create_text_path { |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
370 my ($path, $text, $root, $namespace) = @_; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
371 my $elem = create_element_path($path, $root, $namespace)->appendTextNode($text); |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
372 return $elem; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
373 } |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
374 |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
375 |
| 0 | 376 |
| 377 # module init | |
| 378 return 1; |