[BACK]Return to MPIWGStor.pm CVS log [TXT] [DIR] Up to [Repository] / foxridge-archiver

Diff for /foxridge-archiver/MPIWGStor.pm between versions 1.1 and 1.3

version 1.1, 2004/06/17 15:58:42 version 1.3, 2005/05/26 14:31:28
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; #  ROC 26.5.2005
   
 @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;
Line 211  sub valid_name { Line 211  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 264  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 293  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 303  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;
Removed from v.1.1  
changed lines
  Added in v.1.3

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>