version 1.1, 2004/06/17 15:58:42
|
version 1.9, 2007/03/21 14:22:27
|
Line 1
|
Line 1
|
#!/usr/local/bin/perl -w |
|
|
|
# |
# |
# Library with definitions and common routines for MPIWG storage system |
# Library with definitions and common routines for MPIWG storage system |
Line 13 use vars qw(@ISA @EXPORT $VERSION
|
Line 12 use vars qw(@ISA @EXPORT $VERSION
|
$file_perm); |
$file_perm); |
use Exporter; |
use Exporter; |
|
|
$VERSION = 0.3; # ROC 24.9.2003 |
$VERSION = 0.6.3; # ROC 6.3.2007 |
|
|
@ISA = qw(Exporter); |
@ISA = qw(Exporter); |
|
|
@EXPORT = qw($debug %junk_files %index_files $index_file_perm $archived_index_file_perm |
@EXPORT = qw($debug %junk_files %index_files $index_file_perm $archived_index_file_perm |
$file_perm |
$file_perm |
&parseargs &logger &stime &s2stime &ymd_date &split_file_path &sstrip |
&parseargs &logger &stime &s2stime &ymd_date &split_file_path &sstrip |
&valid_file_name &valid_dir_name &read_xml &write_xml); |
&valid_file_name &valid_dir_name &park_file &unpark_file |
|
&read_xml &write_xml &add_text_element &create_element_path &create_text_path); |
|
|
# debug level |
# debug level |
$debug = 0; |
$debug = 0; |
|
|
# junk files |
# junk files |
%junk_files = ( |
%junk_files = ( |
'.HSResource' => '.HSResource', |
# netatalk stuff |
'.HSancillary' => '.HSancillary', |
'.AppleDB' => '.AppleDB', |
'.HSicon' => '.HSicon', |
'.AppleDesktop' => '.AppleDesktop', |
|
'.AppleDouble' => '.AppleDouble', |
|
'.FBCIndex' => '.FBCIndex', |
|
'.FBCLockFolder' => '.FBCLockFolder', |
|
':2eTemporaryItems' => ':2eTemporaryItems', |
|
':2eDS_Store' => ':2eDS_Store', |
|
':2eBridgeSort' => ':2eBridgeSort', |
|
# standard appleshare stuff |
|
'.DS_Store' => '.DS_Store', |
|
'.TemporaryItems' => '.TemporaryItems', |
'Network Trash Folder' => 'Network Trash Folder', |
'Network Trash Folder' => 'Network Trash Folder', |
'TheVolumeSettingsFolder' => 'TheVolumeSettingsFolder', |
'TheVolumeSettingsFolder' => 'TheVolumeSettingsFolder', |
'.DS_Store' => '.DS_Store' |
# old appleshare software turds |
|
'.HSResource' => '.HSResource', |
|
'.HSancillary' => '.HSancillary', |
|
'.HSicon' => '.HSicon' |
); |
); |
|
|
# filenames to not delete (but archive) |
# filenames to not delete (but archive) |
Line 140 sub ymd_date {
|
Line 152 sub ymd_date {
|
# file name (the last path element) and path |
# file name (the last path element) and path |
# |
# |
sub split_file_path { |
sub split_file_path { |
my ($fn) = @_; |
my ($fn, $nodot) = @_; |
|
|
if ($fn =~ /^(.*)\/([^\/]+)$/) { |
if ($fn =~ /^(.*)\/([^\/]+)$/) { |
return ($2, $1); |
return ($2, $1); |
} |
} |
return $fn; |
# only file name |
|
if ($nodot) { |
|
return ($fn, ''); |
|
} else { |
|
return ($fn, '.'); |
|
} |
} |
} |
|
|
|
|
# |
# |
# $name = sstrip($name) |
# $name = sstrip($name, $slash) |
# |
# |
# strips leading and trailing whitespace from $name |
# strips leading and trailing whitespace from $name |
|
# replaces double slashes with single ones with $slash. |
# |
# |
sub sstrip { |
sub sstrip { |
my ($name) = @_; |
my ($name, $slash) = @_; |
|
|
if ($name =~ /\s*(.*)\s*/) { |
if ($name =~ /^\s*(.*?)\s*$/) { |
return $1; |
$name = $1; |
|
} |
|
if ($slash) { |
|
# trim multiple slashes |
|
$name =~ s/\/+/\//g; |
} |
} |
return $name; |
return $name; |
} |
} |
Line 211 sub valid_name {
|
Line 233 sub valid_name {
|
|
|
|
|
# |
# |
|
# $newfilename = park_file($filename) |
|
# |
|
# parks a file under a new name (*.bak) |
|
# |
|
sub park_file { |
|
my ($filename) = @_; |
|
my $newfn = ""; |
|
if (-f $filename) { |
|
$newfn = "$filename.bak"; |
|
if (! rename $filename, $newfn) { |
|
logger("ABORT", "unable to rename file $filename!"); |
|
exit 1; |
|
} |
|
} |
|
return $newfn; |
|
} |
|
|
|
# |
|
# $filename = unpark_file($filename) |
|
# |
|
# unparks a file |
|
# |
|
sub unpark_file { |
|
my ($filename) = @_; |
|
my $newfn = "$filename.bak"; |
|
if (-f $newfn) { |
|
if (! rename $newfn, $filename) { |
|
logger("ABORT", "unable to rename file $newfn!"); |
|
exit 1; |
|
} |
|
return $filename; |
|
} |
|
return ""; |
|
} |
|
|
|
|
|
|
|
# |
# ($document, $rootnode) = read_xml($file) |
# ($document, $rootnode) = read_xml($file) |
# |
# |
# reads xml meta file $file |
# reads xml meta file $file |
Line 226 sub read_xml {
|
Line 286 sub read_xml {
|
exit 1; |
exit 1; |
} |
} |
|
|
logger("INFO", "index file: $file"); |
logger("DEBUG", "index file: $file"); |
eval { $document = $parser->parse_file($file) }; |
eval { $document = $parser->parse_file($file) }; |
# catch parsing errors |
# catch parsing errors |
if ($@) { |
if ($@) { |
logger("ABORT", "XML syntax error in index file!!"); |
logger("ABORT", "XML syntax error in file $file!!"); |
exit 1; |
exit 1; |
} |
} |
my $rootnode = $document->documentElement; |
my $rootnode = $document->documentElement; |
logger("INFO", "root element: \'" . $rootnode->nodeName . "\'"); |
logger("DEBUG", "root element: \'" . $rootnode->nodeName . "\'"); |
|
|
return ($document, $rootnode); |
return ($document, $rootnode); |
} |
} |
Line 255 sub write_xml {
|
Line 315 sub write_xml {
|
} |
} |
} |
} |
# write new file |
# write new file |
if ($document->toFile($filename)) { |
my ($fn, $dir) = split_file_path($filename); |
|
if (-d $dir && $document->toFile($filename)) { |
logger("INFO", "written new file $filename"); |
logger("INFO", "written new file $filename"); |
chmod $index_file_perm, $filename; |
chmod $index_file_perm, $filename; |
} else { |
} else { |
Line 264 sub write_xml {
|
Line 325 sub write_xml {
|
} |
} |
} |
} |
|
|
|
# |
|
# $elem = add_text_element($node, $name, $value, $namespace) |
|
# |
|
# creates an XML element with the name $name and the text content |
|
# $value attached to the node $node and returns it. |
|
# |
|
sub add_text_element { |
|
my ($node, $name, $value, $namespace) = @_; |
|
|
|
my $doc = $node->ownerDocument; |
|
my $text = $doc->createTextNode($value); |
|
my $newnode = $node->addNewChild($namespace, $name); |
|
$newnode->addChild($text); |
|
|
|
return $newnode; |
|
} |
|
|
|
# |
|
# $elem = create_element_path($path, $root, $namespace) |
|
# |
|
# creates and returns a DOM element at the given path from the |
|
# given root. path is e.g. meta/bib@type=book. elements are separated |
|
# by /, an additional attribute can be specified after the @. |
|
# |
|
sub create_element_path { |
|
my ($path, $root, $namespace) = @_; |
|
my $attribute = ""; |
|
# get attribute |
|
if ($path =~ /^(.+)@(.+)$/) { |
|
$attribute = $2; |
|
$path = $1; |
|
} |
|
my $point = $root; |
|
for my $p (split /\//, $path) { |
|
# check if the next path element exists |
|
my $n = ($point->findnodes($p))[0]; |
|
if ($n) { |
|
$point = $n; |
|
} else { |
|
# create if it doesn't exist |
|
$point = $point->addNewChild($namespace, $p); |
|
} |
|
} |
|
# add the attribute |
|
if ($attribute) { |
|
my $dom = $root->getOwner(); |
|
my ($attkey, $attval) = split /=/, $attribute; #/ silly fontlock... |
|
$point->addChild($dom->createAttributeNS($namespace, $attkey, $attval)); |
|
} |
|
return $point; |
|
} |
|
|
|
# |
|
# $elem = create_text_path($path, $text, $root, $namespace) |
|
# |
|
# creates and returns a DOM text element with the given content at the |
|
# given path from the given root. |
|
# |
|
sub create_text_path { |
|
my ($path, $text, $root, $namespace) = @_; |
|
my $elem = create_element_path($path, $root, $namespace)->appendTextNode($text); |
|
return $elem; |
|
} |
|
|
|
|
|
|
# module init |
# module init |
return 1; |
return 1; |