Annotation of foxridge-archiver/MPIWGStor.pm, revision 1.9
1.1 casties 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:
1.8 casties 15: $VERSION = 0.6.3; # ROC 6.3.2007
1.1 casties 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
1.3 casties 22: &valid_file_name &valid_dir_name &park_file &unpark_file
23: &read_xml &write_xml &add_text_element &create_element_path &create_text_path);
1.1 casties 24:
25: # debug level
26: $debug = 0;
27:
28: # junk files
29: %junk_files = (
1.8 casties 30: # netatalk stuff
31: '.AppleDB' => '.AppleDB',
32: '.AppleDesktop' => '.AppleDesktop',
33: '.AppleDouble' => '.AppleDouble',
34: '.FBCIndex' => '.FBCIndex',
35: '.FBCLockFolder' => '.FBCLockFolder',
36: ':2eTemporaryItems' => ':2eTemporaryItems',
37: ':2eDS_Store' => ':2eDS_Store',
1.9 ! casties 38: ':2eBridgeSort' => ':2eBridgeSort',
1.8 casties 39: # standard appleshare stuff
40: '.DS_Store' => '.DS_Store',
41: '.TemporaryItems' => '.TemporaryItems',
42: 'Network Trash Folder' => 'Network Trash Folder',
43: 'TheVolumeSettingsFolder' => 'TheVolumeSettingsFolder',
44: # old appleshare software turds
45: '.HSResource' => '.HSResource',
46: '.HSancillary' => '.HSancillary',
47: '.HSicon' => '.HSicon'
48: );
1.1 casties 49:
50: # filenames to not delete (but archive)
51: %index_files = (
52: 'index.meta' => 'index.meta',
53: 'index.meta.old' => 'index.meta.old'
54: );
55:
56: # default permissions for normal index files (rw-rw-r--)
57: $index_file_perm = 0664;
58: # default permissions for archived index files (rw-r--r--)
59: $archived_index_file_perm = 0644;
60: # default permissions for other files (rw-rw-r--)
61: $file_perm = 0664;
62:
63:
64: #
65: # $param_hash = parseargs;
66: #
67: # reads @ARGV and returns a hash with all options like "-option=value"
68: # and the last part of the string as "path"
69: #
70: sub parseargs {
71: my %opts;
72: foreach my $s (@ARGV) {
73: if ($s =~ /^-([^=]+)=*(.*)$/) {
74: $opts{$1} = ($2) ? $2 : $1;
75: } else {
76: $opts{'path'} = $s;
77: }
78: }
79: return \%opts;
80: }
81:
82:
83: #
84: # logger($level, $message)
85: #
86: # logs the $message (mostly to stdout)
87: #
88: sub logger {
89: my ($level, $message) = @_;
90: if ($debug || ($level ne "DEBUG")) {
91: print "$level: $message\n";
92: }
93: }
94:
95: #
96: # $stime = stime($utime)
97: #
98: # format utime (seconds since epoch) into string
99: # representation: "YYYY/MM/DD HH:MM:SS"
100: #
101: sub stime {
102: my ($utime) = @_;
103: my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
104: localtime($utime);
105: my $yy = $year + 1900;
106: my $mm = $mon + 1;
107: my $stime = sprintf("%d/%02d/%02d %02d:%02d:%02d",
108: $yy, $mm, $mday, $hour, $min, $sec);
109: return $stime;
110: }
111:
112: #
113: # $stime = s2stime($stime2)
114: #
115: # format db-like time (2003-09-19 12:43:32+02) into string
116: # representation: "YYYY/MM/DD HH:MM:SS"
117: #
118: sub s2stime {
119: my ($s2time) = @_;
120: my $stime = "";
121: if ($s2time =~ /(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)/) {
122: my ($year,$mon,$mday,$hour,$min,$sec) = ($1, $2, $3, $4, $5, $6);
123: $stime = sprintf("%d/%02d/%02d %02d:%02d:%02d",
124: $year, $mon, $mday, $hour, $min, $sec);
125: }
126: return $stime;
127: }
128:
129: #
130: # $date = ymd_date($olddate)
131: #
132: # converts a date string in mm/dd/yy format to yyyy/mm/dd format
133: #
134: sub ymd_date {
135: my ($mdy) = @_;
136: my $ydm;
137: if ($mdy =~ /(\d+)\/(\d+)\/(\d+)/) {
138: my $m = $1;
139: my $d = $2;
140: my $y = $3;
141: # extend yy to yyyy
142: $y = ($y < 70) ? (2000 + $y) : (($y < 100) ? ($y + 1900) : $y);
143: $ydm = sprintf "%d/%02d/%02d", $y, $m, $d;
144: }
145: return $ydm;
146: }
147:
148: #
149: # ($name, $path) = split_file_path($fn)
150: #
151: # splits the file path $fn into
152: # file name (the last path element) and path
153: #
154: sub split_file_path {
1.5 casties 155: my ($fn, $nodot) = @_;
1.1 casties 156:
157: if ($fn =~ /^(.*)\/([^\/]+)$/) {
158: return ($2, $1);
1.5 casties 159: }
160: # only file name
161: if ($nodot) {
162: return ($fn, '');
163: } else {
164: return ($fn, '.');
1.1 casties 165: }
166: }
167:
168:
169: #
1.7 casties 170: # $name = sstrip($name, $slash)
1.1 casties 171: #
172: # strips leading and trailing whitespace from $name
1.7 casties 173: # replaces double slashes with single ones with $slash.
1.1 casties 174: #
175: sub sstrip {
1.7 casties 176: my ($name, $slash) = @_;
1.1 casties 177:
1.6 casties 178: if ($name =~ /^\s*(.*?)\s*$/) {
1.7 casties 179: $name = $1;
180: }
181: if ($slash) {
182: # trim multiple slashes
183: $name =~ s/\/+/\//g;
1.1 casties 184: }
185: return $name;
186: }
187:
188:
189: #
190: # $valid = valid_file_name($name)
191: #
192: # checks if $name is a valid file name
193: #
194: sub valid_file_name {
195: return valid_name($_[0], 0);
196: }
197:
198:
199: #
200: # $valid = valid_dir_name($name)
201: #
202: # checks if $name is a valid directory name
203: #
204: sub valid_dir_name {
205: return valid_name($_[0], 1);
206: }
207:
208:
209: #
210: # $valid = valid_name($name, $mode)
211: #
212: # checks if $name is a valid file ($mode=0) or directory name (mode=1)
213: #
214: sub valid_name {
215: my ($name, $mode) = @_;
216:
217: # whitespace?
218: if ($name =~ /\s+/) {
219: return 0;
220: }
221: # invalid characters
222: if ($name !~ /^[-\w.\/]+$/) {
223: return 0;
224: }
225: # files have extension
226: if ($mode == 0) {
227: if ($name !~ /\.[-\w]+$/) {
228: return 0;
229: }
230: }
231: return 1;
232: }
1.2 casties 233:
234:
235: #
236: # $newfilename = park_file($filename)
237: #
238: # parks a file under a new name (*.bak)
239: #
240: sub park_file {
241: my ($filename) = @_;
242: my $newfn = "";
243: if (-f $filename) {
244: $newfn = "$filename.bak";
245: if (! rename $filename, $newfn) {
246: logger("ABORT", "unable to rename file $filename!");
247: exit 1;
248: }
249: }
250: return $newfn;
251: }
252:
253: #
254: # $filename = unpark_file($filename)
255: #
256: # unparks a file
257: #
258: sub unpark_file {
259: my ($filename) = @_;
260: my $newfn = "$filename.bak";
261: if (-f $newfn) {
262: if (! rename $newfn, $filename) {
263: logger("ABORT", "unable to rename file $newfn!");
264: exit 1;
265: }
266: return $filename;
267: }
268: return "";
269: }
270:
1.1 casties 271:
272:
273: #
274: # ($document, $rootnode) = read_xml($file)
275: #
276: # reads xml meta file $file
277: # returns root node element
278: #
279: sub read_xml {
280: my ($file) = @_;
281: my $document;
282:
283: my $parser = XML::LibXML->new();
284: if (! $parser) {
285: logger("ABORT", "unable to create parser for metadata index file!!");
286: exit 1;
287: }
288:
1.3 casties 289: logger("DEBUG", "index file: $file");
1.1 casties 290: eval { $document = $parser->parse_file($file) };
291: # catch parsing errors
292: if ($@) {
1.3 casties 293: logger("ABORT", "XML syntax error in file $file!!");
1.1 casties 294: exit 1;
295: }
296: my $rootnode = $document->documentElement;
1.3 casties 297: logger("DEBUG", "root element: \'" . $rootnode->nodeName . "\'");
1.1 casties 298:
299: return ($document, $rootnode);
300: }
301:
302:
303: #
304: # write_xml($document, $file)
305: #
306: # saves the XML tree of $document to the file $file
307: #
308: sub write_xml {
309: my ($document, $filename) = @_;
310: # keep backup copy
311: if (-f $filename) {
312: if (! rename $filename, "$filename.old") {
313: logger("ABORT", "unable to change file $filename!");
314: exit 1;
315: }
316: }
317: # write new file
1.3 casties 318: my ($fn, $dir) = split_file_path($filename);
319: if (-d $dir && $document->toFile($filename)) {
1.1 casties 320: logger("INFO", "written new file $filename");
321: chmod $index_file_perm, $filename;
322: } else {
323: logger("ABORT", "unable to write file $filename!");
324: exit 1;
325: }
326: }
1.3 casties 327:
328: #
329: # $elem = add_text_element($node, $name, $value, $namespace)
330: #
331: # creates an XML element with the name $name and the text content
332: # $value attached to the node $node and returns it.
333: #
334: sub add_text_element {
335: my ($node, $name, $value, $namespace) = @_;
336:
337: my $doc = $node->ownerDocument;
338: my $text = $doc->createTextNode($value);
339: my $newnode = $node->addNewChild($namespace, $name);
340: $newnode->addChild($text);
341:
342: return $newnode;
343: }
344:
345: #
346: # $elem = create_element_path($path, $root, $namespace)
347: #
348: # creates and returns a DOM element at the given path from the
349: # given root. path is e.g. meta/bib@type=book. elements are separated
350: # by /, an additional attribute can be specified after the @.
351: #
352: sub create_element_path {
353: my ($path, $root, $namespace) = @_;
354: my $attribute = "";
355: # get attribute
356: if ($path =~ /^(.+)@(.+)$/) {
357: $attribute = $2;
358: $path = $1;
359: }
360: my $point = $root;
361: for my $p (split /\//, $path) {
362: # check if the next path element exists
363: my $n = ($point->findnodes($p))[0];
364: if ($n) {
365: $point = $n;
366: } else {
367: # create if it doesn't exist
368: $point = $point->addNewChild($namespace, $p);
369: }
370: }
371: # add the attribute
372: if ($attribute) {
373: my $dom = $root->getOwner();
374: my ($attkey, $attval) = split /=/, $attribute; #/ silly fontlock...
375: $point->addChild($dom->createAttributeNS($namespace, $attkey, $attval));
376: }
377: return $point;
378: }
379:
380: #
381: # $elem = create_text_path($path, $text, $root, $namespace)
382: #
383: # creates and returns a DOM text element with the given content at the
384: # given path from the given root.
385: #
386: sub create_text_path {
387: my ($path, $text, $root, $namespace) = @_;
388: my $elem = create_element_path($path, $root, $namespace)->appendTextNode($text);
389: return $elem;
390: }
391:
1.1 casties 392:
393:
394: # module init
395: 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