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