--- foxridge-archiver/MPIWGStor.pm 2005/01/21 14:33:26 1.2 +++ foxridge-archiver/MPIWGStor.pm 2005/05/26 14:31:28 1.3 @@ -1,4 +1,3 @@ -#!/usr/local/bin/perl -w # # Library with definitions and common routines for MPIWG storage system @@ -13,14 +12,15 @@ use vars qw(@ISA @EXPORT $VERSION $file_perm); use Exporter; -$VERSION = 0.4; # ROC 20.1.2005 +$VERSION = 0.6; # ROC 26.5.2005 @ISA = qw(Exporter); @EXPORT = qw($debug %junk_files %index_files $index_file_perm $archived_index_file_perm $file_perm &parseargs &logger &stime &s2stime &ymd_date &split_file_path &sstrip - &valid_file_name &valid_dir_name &park_file &unpark_file &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 = 0; @@ -264,15 +264,15 @@ sub read_xml { exit 1; } - logger("INFO", "index file: $file"); + logger("DEBUG", "index file: $file"); eval { $document = $parser->parse_file($file) }; # catch parsing errors if ($@) { - logger("ABORT", "XML syntax error in index file!!"); + logger("ABORT", "XML syntax error in file $file!!"); exit 1; } my $rootnode = $document->documentElement; - logger("INFO", "root element: \'" . $rootnode->nodeName . "\'"); + logger("DEBUG", "root element: \'" . $rootnode->nodeName . "\'"); return ($document, $rootnode); } @@ -293,7 +293,8 @@ sub write_xml { } } # 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"); chmod $index_file_perm, $filename; } else { @@ -302,6 +303,71 @@ 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 return 1;