--- 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;