Mercurial > hg > foxridge-archiver
annotate MPIWGStor.pm @ 38:7bf843ac256b
new bib type (JournalVolume)
| author | casties |
|---|---|
| date | Tue, 27 Jun 2006 17:25:40 +0200 |
| parents | 398ef4b8f072 |
| children | 4d958249d337 |
| 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 | |
|
27
2890dd75d2f6
fixed bug in sstrip with whitespace at the end of the string...
casties
parents:
18
diff
changeset
|
15 $VERSION = 0.6.2; # ROC 10.2.2006 |
| 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 # | |
| 30 | 158 # $name = sstrip($name, $slash) |
| 0 | 159 # |
| 160 # strips leading and trailing whitespace from $name | |
| 30 | 161 # replaces double slashes with single ones with $slash. |
| 0 | 162 # |
| 163 sub sstrip { | |
| 30 | 164 my ($name, $slash) = @_; |
| 0 | 165 |
|
27
2890dd75d2f6
fixed bug in sstrip with whitespace at the end of the string...
casties
parents:
18
diff
changeset
|
166 if ($name =~ /^\s*(.*?)\s*$/) { |
| 30 | 167 $name = $1; |
| 168 } | |
| 169 if ($slash) { | |
| 170 # trim multiple slashes | |
| 171 $name =~ s/\/+/\//g; | |
| 0 | 172 } |
| 173 return $name; | |
| 174 } | |
| 175 | |
| 176 | |
| 177 # | |
| 178 # $valid = valid_file_name($name) | |
| 179 # | |
| 180 # checks if $name is a valid file name | |
| 181 # | |
| 182 sub valid_file_name { | |
| 183 return valid_name($_[0], 0); | |
| 184 } | |
| 185 | |
| 186 | |
| 187 # | |
| 188 # $valid = valid_dir_name($name) | |
| 189 # | |
| 190 # checks if $name is a valid directory name | |
| 191 # | |
| 192 sub valid_dir_name { | |
| 193 return valid_name($_[0], 1); | |
| 194 } | |
| 195 | |
| 196 | |
| 197 # | |
| 198 # $valid = valid_name($name, $mode) | |
| 199 # | |
| 200 # checks if $name is a valid file ($mode=0) or directory name (mode=1) | |
| 201 # | |
| 202 sub valid_name { | |
| 203 my ($name, $mode) = @_; | |
| 204 | |
| 205 # whitespace? | |
| 206 if ($name =~ /\s+/) { | |
| 207 return 0; | |
| 208 } | |
| 209 # invalid characters | |
| 210 if ($name !~ /^[-\w.\/]+$/) { | |
| 211 return 0; | |
| 212 } | |
| 213 # files have extension | |
| 214 if ($mode == 0) { | |
| 215 if ($name !~ /\.[-\w]+$/) { | |
| 216 return 0; | |
| 217 } | |
| 218 } | |
| 219 return 1; | |
| 220 } | |
| 221 | |
| 222 | |
| 223 # | |
| 10 | 224 # $newfilename = park_file($filename) |
| 225 # | |
| 226 # parks a file under a new name (*.bak) | |
| 227 # | |
| 228 sub park_file { | |
| 229 my ($filename) = @_; | |
| 230 my $newfn = ""; | |
| 231 if (-f $filename) { | |
| 232 $newfn = "$filename.bak"; | |
| 233 if (! rename $filename, $newfn) { | |
| 234 logger("ABORT", "unable to rename file $filename!"); | |
| 235 exit 1; | |
| 236 } | |
| 237 } | |
| 238 return $newfn; | |
| 239 } | |
| 240 | |
| 241 # | |
| 242 # $filename = unpark_file($filename) | |
| 243 # | |
| 244 # unparks a file | |
| 245 # | |
| 246 sub unpark_file { | |
| 247 my ($filename) = @_; | |
| 248 my $newfn = "$filename.bak"; | |
| 249 if (-f $newfn) { | |
| 250 if (! rename $newfn, $filename) { | |
| 251 logger("ABORT", "unable to rename file $newfn!"); | |
| 252 exit 1; | |
| 253 } | |
| 254 return $filename; | |
| 255 } | |
| 256 return ""; | |
| 257 } | |
| 258 | |
| 259 | |
| 260 | |
| 261 # | |
| 0 | 262 # ($document, $rootnode) = read_xml($file) |
| 263 # | |
| 264 # reads xml meta file $file | |
| 265 # returns root node element | |
| 266 # | |
| 267 sub read_xml { | |
| 268 my ($file) = @_; | |
| 269 my $document; | |
| 270 | |
| 271 my $parser = XML::LibXML->new(); | |
| 272 if (! $parser) { | |
| 273 logger("ABORT", "unable to create parser for metadata index file!!"); | |
| 274 exit 1; | |
| 275 } | |
| 276 | |
|
12
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
277 logger("DEBUG", "index file: $file"); |
| 0 | 278 eval { $document = $parser->parse_file($file) }; |
| 279 # catch parsing errors | |
| 280 if ($@) { | |
|
12
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
281 logger("ABORT", "XML syntax error in file $file!!"); |
| 0 | 282 exit 1; |
| 283 } | |
| 284 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
|
285 logger("DEBUG", "root element: \'" . $rootnode->nodeName . "\'"); |
| 0 | 286 |
| 287 return ($document, $rootnode); | |
| 288 } | |
| 289 | |
| 290 | |
| 291 # | |
| 292 # write_xml($document, $file) | |
| 293 # | |
| 294 # saves the XML tree of $document to the file $file | |
| 295 # | |
| 296 sub write_xml { | |
| 297 my ($document, $filename) = @_; | |
| 298 # keep backup copy | |
| 299 if (-f $filename) { | |
| 300 if (! rename $filename, "$filename.old") { | |
| 301 logger("ABORT", "unable to change file $filename!"); | |
| 302 exit 1; | |
| 303 } | |
| 304 } | |
| 305 # 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
|
306 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
|
307 if (-d $dir && $document->toFile($filename)) { |
| 0 | 308 logger("INFO", "written new file $filename"); |
| 309 chmod $index_file_perm, $filename; | |
| 310 } else { | |
| 311 logger("ABORT", "unable to write file $filename!"); | |
| 312 exit 1; | |
| 313 } | |
| 314 } | |
| 315 | |
|
12
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 # $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
|
318 # |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
319 # 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
|
320 # $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
|
321 # |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
322 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
|
323 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
|
324 |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
325 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
|
326 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
|
327 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
|
328 $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
|
329 |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
330 return $newnode; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
331 } |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
332 |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
333 # |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
334 # $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
|
335 # |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
336 # 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
|
337 # 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
|
338 # 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
|
339 # |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
340 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
|
341 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
|
342 my $attribute = ""; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
343 # get attribute |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
344 if ($path =~ /^(.+)@(.+)$/) { |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
345 $attribute = $2; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
346 $path = $1; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
347 } |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
348 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
|
349 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
|
350 # 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
|
351 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
|
352 if ($n) { |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
353 $point = $n; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
354 } else { |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
355 # 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
|
356 $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
|
357 } |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
358 } |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
359 # 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
|
360 if ($attribute) { |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
361 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
|
362 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
|
363 $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
|
364 } |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
365 return $point; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
366 } |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
367 |
|
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 # $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
|
370 # |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
371 # 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
|
372 # 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
|
373 # |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
374 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
|
375 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
|
376 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
|
377 return $elem; |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
378 } |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
379 |
|
620aad237f57
new tool makemeta-lib.pl to create index meta entries from the libraries online sources database
casties
parents:
10
diff
changeset
|
380 |
| 0 | 381 |
| 382 # module init | |
| 383 return 1; |