#!/usr/bin/perl -w
use strict;
use XML::LibXML;
use lib '/usr/local/mpiwg/archive';
use MPIWGStor;
# make output unbuffered
$|=1;
# program version
my $version = "0.3 (11.12.2006 ROC)";
my $help =
"use: changemeta [options] dir
options:
-debug show debugging info
-dry-run simulate, dont'do anything
-access=free set free access tag (use access=mpiwg for restricted access)
-derived-from=/mpiwg/archive/data/DBDDHKP
-production-comment=\"scanned with flatbed scanner\"
";
logger("INFO", "changemeta $version");
#######################################################
# internal parameters
#
# read command line parameters
my $args = MPIWGStor::parseargs;
if (! scalar(%$args)) {
print $help, "\n";
exit 1;
}
# debug level
$debug = (exists $$args{'debug'}) ? $$args{'debug'} : 0;
# simulate action only
my $dry_run = (exists $$args{'dry-run'}) ? $$args{'dry-run'} : 0;
logger('DEBUG', "dry-run: $dry_run");
# access type
my $access_type = (exists $$args{'access'}) ? $$args{'access'} : "";
logger('DEBUG', "access: $access_type");
# derived-from
my $derived_from = (exists $$args{'derived-from'}) ? $$args{'derived-from'} : "";
logger('DEBUG', "derived-from: $derived_from");
# production-comment
my $production_comment = (exists $$args{'production-comment'}) ? $$args{'production-comment'} : "";
logger('DEBUG', "production-comment: $production_comment");
# index.meta namespace (not really implemented!)
my $namespace = "";
my $xml_changed = 0;
my $errcnt = 0;
my $warncnt = 0;
#######################################################
# check parameters that were passed to the program
#
my $docdir = $$args{'path'};
if (! $docdir) {
logger("ABORT", "no document directory given!");
exit 1;
}
# strip double slashes
$docdir = sstrip($docdir, 1);
if (! -d $docdir) {
logger("ABORT", "document directory \'$docdir\' doesn't exist!");
exit 1;
}
#######################################################
# subroutines
#
#
# sets access tag to given access_type
# removes access tag if access_type is empty
#
sub change_access {
my ($access_type, $index_root) = @_;
my $parent_tag = $index_root->findnodes('//meta/access-conditions')->get_node(1);
if ($parent_tag) {
my $access_tag = $parent_tag->findnodes('access')->get_node(1);
# remove access tag if it exists
if ($access_tag) {
$parent_tag->removeChild($access_tag);
}
} else {
$parent_tag = create_element_path('meta/access-conditions', $index_root, $namespace);
}
# add new access tag (if $access_Type is not empty)
if ($access_type eq "free") {
create_element_path('access@type=free', $parent_tag, $namespace);
} elsif (length $access_type > 0) {
my $acc_tag = create_element_path('access@type=institution', $parent_tag, $namespace);
create_text_path('name', $access_type, $acc_tag, $namespace);
}
$xml_changed++
}
#
# sets derived-from tag to given value
# removes tag if derived_from is empty
#
sub change_derived {
my ($derived_from, $index_root) = @_;
my $derived_tag = $index_root->findnodes('derived-from')->get_node(1);
# remove derived tag if it exists
if ($derived_tag) {
$index_root->removeChild($derived_tag);
}
# add new derived tag (if $derived_Type is not empty)
if (length $derived_from > 0) {
create_text_path('derived-from/archive-path', $derived_from, $index_root, $namespace);
}
$xml_changed++
}
#
# sets production-comment tag to given value
# removes production tag if production_comment is empty
#
sub change_production {
my ($production_comment, $index_root) = @_;
my $parent_tag = $index_root->findnodes('//meta/image-acquisition')->get_node(1);
if ($parent_tag) {
my $production_tag = $parent_tag->findnodes('production-comment')->get_node(1);
# remove production tag if it exists
if ($production_tag) {
$parent_tag->removeChild($production_tag);
}
} else {
$parent_tag = create_element_path('meta/image-acquisition', $index_root, $namespace);
}
# add new production tag (if $production_comment is not empty)
if (length $production_comment > 0) {
create_text_path('production-comment', $production_comment, $parent_tag, $namespace);
}
$xml_changed++
}
#######################################################
# Main
#
my $index_doc;
my $index_root;
# load index.meta file
if (-f "$docdir/index.meta") {
($index_doc, $index_root) = read_xml("$docdir/index.meta");
} else {
logger("ABORT", "index file \'$docdir/index.meta\' doesn't exist!");
exit 1;
}
if ($access_type) {
change_access($access_type, $index_root);
}
if ($derived_from) {
change_derived($derived_from, $index_root);
}
if ($production_comment) {
change_production($production_comment, $index_root);
}
logger("INFO", "$warncnt warnings");
logger("INFO", "$errcnt errors");
if ($errcnt > 0) {
logger("ABORT", "there were errors!");
exit 1;
} elsif ($xml_changed) {
# write new index.meta file
if ($dry_run) {
logger('DEBUG', "would write $docdir/index.meta");
logger('DEBUG', $index_doc->toString(1));
} else {
write_xml($index_doc, "$docdir/index.meta");
}
logger("DONE", "changed index file successfully!");
} else {
logger("DONE", "didn't change index file");
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>