Annotation of scaleomat/MPIWGlib.pm, revision 1.2
1.1 casties 1: #!/usr/local/bin/perl -w
2:
1.2 ! casties 3: # Copyright (C) 2003,2004 Robert Casties, IT-Group MPIWG
! 4: #
! 5: # This program is free software; you can redistribute it and/or modify it
! 6: # under the terms of the GNU General Public License as published by the Free
! 7: # Software Foundation; either version 2 of the License, or (at your option)
! 8: # any later version.
! 9: #
! 10: # Please read license.txt for the full details. A copy of the GPL may be found
! 11: # at http://www.gnu.org/copyleft/lgpl.html
! 12: #
! 13: # You should have received a copy of the GNU General Public License along with
! 14: # this program; if not, write to the Free Software Foundation, Inc., 59 Temple
! 15: # Place, Suite 330, Boston, MA 02111-1307 USA
! 16:
1.1 casties 17: #
18: # Library with definitions and common routines for MPIWG storage system
19: # scripts
20: #
21:
22: package MPIWGlib;
23:
24: use strict;
25: use vars qw(@ISA @EXPORT $VERSION
26: $debug %junk_files $file_perm $index_file_perm);
27: use Exporter;
28:
29: $VERSION = 0.1; # ROC 19.2.2004
30:
31: @ISA = qw(Exporter);
32:
33: @EXPORT = qw($debug %junk_files $file_perm $index_file_perm
34: &parseargs &logger &stime &ymd_date &split_file_path &sstrip &valid_file_name
35: &valid_dir_name &read_xml &write_xml);
36:
37: # debug level
38: $debug = 0;
39:
40: # junk files
41: %junk_files = (
42: '.HSResource' => '.HSResource',
43: '.HSancillary' => '.HSancillary',
44: '.HSicon' => '.HSicon',
45: 'Network Trash Folder' => 'Network Trash Folder',
46: 'TheVolumeSettingsFolder' => 'TheVolumeSettingsFolder',
47: '.DS_Store' => '.DS_Store'
48: );
49:
50: # default permissions for normal index files (rw-rw-r--)
51: $index_file_perm = 0664;
52: # default permissions for other files (rw-rw-r--)
53: $file_perm = 0664;
54:
55:
56: #
57: # $param_hash = parseargs;
58: #
59: # reads @ARGV and returns a hash with all options like "-option=value"
60: # and the last part of the string as "path"
61: #
62: sub parseargs {
63: my %opts;
64: foreach my $s (@ARGV) {
65: if ($s =~ /^-([^=]+)=*(.*)$/) {
66: $opts{$1} = ($2) ? $2 : $1;
67: } else {
68: $opts{'path'} = $s;
69: }
70: }
71: return \%opts;
72: }
73:
74:
75: #
76: # logger($level, $message)
77: #
78: # logs the $message (mostly to stdout)
79: # Messages with the level DEBUG will be suppressed if $debug is false.
80: #
81: sub logger {
82: my ($level, $message) = @_;
83: if ($debug || ($level ne "DEBUG")) {
84: print "$level: $message\n";
85: }
86: }
87:
88: #
89: # $stime = stime($utime)
90: #
91: # format utime (seconds since epoch) into string
92: # representation: "YYYY/MM/DD HH:MM:SS"
93: #
94: sub stime {
95: my ($utime) = @_;
96: my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
97: localtime($utime);
98: my $yy = $year + 1900;
99: my $mm = $mon + 1;
100: my $stime = sprintf("%d/%02d/%02d %02d:%02d:%02d",
101: $yy, $mm, $mday, $hour, $min, $sec);
102: return $stime;
103: }
104:
105: #
106: # $date = ymd_date($olddate)
107: #
108: # converts a date string in mm/dd/yy format to yyyy/mm/dd format
109: #
110: sub ymd_date {
111: my ($mdy) = @_;
112: my $ydm;
113: if ($mdy =~ /(\d+)\/(\d+)\/(\d+)/) {
114: my $m = $1;
115: my $d = $2;
116: my $y = $3;
117: # extend yy to yyyy
118: $y = ($y < 70) ? (2000 + $y) : (($y < 100) ? ($y + 1900) : $y);
119: $ydm = sprintf "%d/%02d/%02d", $y, $m, $d;
120: }
121: return $ydm;
122: }
123:
124: #
125: # ($name, $path) = split_file_path($fn)
126: #
127: # splits the file path $fn into
128: # file name (the last path element) and path
129: #
130: sub split_file_path {
131: my ($fn) = @_;
132:
133: if ($fn =~ /^(.*)\/([^\/]+)$/) {
134: return ($2, $1);
135: }
136: return $fn;
137: }
138:
139:
140: #
141: # $name = sstrip($name)
142: #
143: # strips leading and trailing whitespace from $name
144: #
145: sub sstrip {
146: my ($name) = @_;
147:
148: if ($name =~ /\s*(.*)\s*/) {
149: return $1;
150: }
151: return $name;
152: }
153:
154:
155: #
156: # $valid = valid_file_name($name)
157: #
158: # checks if $name is a valid file name
159: #
160: sub valid_file_name {
161: return valid_name($_[0], 0);
162: }
163:
164:
165: #
166: # $valid = valid_dir_name($name)
167: #
168: # checks if $name is a valid directory name
169: #
170: sub valid_dir_name {
171: return valid_name($_[0], 1);
172: }
173:
174:
175: #
176: # $valid = valid_name($name, $mode)
177: #
178: # checks if $name is a valid file ($mode=0) or directory name (mode=1)
179: #
180: sub valid_name {
181: my ($name, $mode) = @_;
182:
183: # whitespace?
184: if ($name =~ /\s+/) {
185: return 0;
186: }
187: # invalid characters
188: if ($name !~ /^[-\w.\/]+$/) {
189: return 0;
190: }
191: # files have extension
192: if ($mode == 0) {
193: if ($name !~ /\.[-\w]+$/) {
194: return 0;
195: }
196: }
197: return 1;
198: }
199:
200:
201: #
202: # ($document, $rootnode) = read_xml($file)
203: #
204: # reads xml meta file $file
205: # returns root node element
206: #
207: sub read_xml {
208: my ($file) = @_;
209: my $document;
210:
211: my $parser = XML::LibXML->new();
212: if (! $parser) {
213: logger("ABORT", "unable to create parser for metadata index file!!");
214: exit 1;
215: }
216:
217: logger("INFO", "index file: $file");
218: eval { $document = $parser->parse_file($file) };
219: # catch parsing errors
220: if ($@) {
221: logger("ABORT", "XML syntax error in index file!!");
222: exit 1;
223: }
224: my $rootnode = $document->documentElement;
225: logger("INFO", "root element: \'" . $rootnode->nodeName . "\'");
226:
227: return ($document, $rootnode);
228: }
229:
230:
231: #
232: # write_xml($document, $file)
233: #
234: # saves the XML tree of $document to the file $file
235: #
236: sub write_xml {
237: my ($document, $filename) = @_;
238: # keep backup copy
239: if (-f $filename) {
240: if (! rename $filename, "$filename.old") {
241: logger("ABORT", "unable to change file $filename!");
242: exit 1;
243: }
244: }
245: # write new file
246: if ($document->toFile($filename)) {
247: logger("INFO", "written new file $filename");
248: chmod $index_file_perm, $filename;
249: } else {
250: logger("ABORT", "unable to write file $filename!");
251: exit 1;
252: }
253: }
254:
255:
256: # module init
257: return 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>