########################################################################### # # metadataaction.pm -- # A component of the Greenstone digital library software # from the New Zealand Digital Library Project at the # University of Waikato, New Zealand. # # Copyright (C) 2009 New Zealand Digital Library Project # # This program is free software; you can redistr te it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # ########################################################################### package metadataaction; use strict; use cgiactions::baseaction; BEGIN { unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan/perl-5.8"); require XML::Rules; } @metadataaction::ISA = ('baseaction'); my $action_table = { "get-live-metadata" => { 'compulsory-args' => [ "d", "metaname" ], 'optional-args' => [] }, "set-live-metadata" => { 'compulsory-args' => [ "d", "metaname", "metavalue" ], 'optional-args' => [] }, "set-import-metadata" => { 'compulsory-args' => [ "metaname", "metavalue" ], 'optional-args' => [ "d", "f", "metamode" ] # metamode can be "accumulate", "override", or "unique-id" } }; sub new { my $class = shift (@_); my ($gsdl_cgi,$iis6_mode) = @_; my $self = new baseaction($action_table,$gsdl_cgi,$iis6_mode); return bless $self, $class; } sub get_live_metadata { my $self = shift @_; my $username = $self->{'username'}; my $collect = $self->{'collect'}; my $gsdl_cgi = $self->{'gsdl_cgi'}; my $gsdlhome = $self->{'gsdlhome'}; my $collect_dir = &util::filename_cat($gsdlhome, "collect"); # $gsdl_cgi->checked_chdir($collect_dir); # Make sure the collection isn't locked by someone else $self->lock_collection($username, $collect); # look up additional args my $docid = $self->{'d'}; if ((!defined $docid) || ($docid =~ m/^\s*$/)) { $gsdl_cgi->generate_error("No docid (d=...) specified."); } my $metaname = $self->{'metaname'}; my $dbkey = "$docid.$metaname"; my $collect_tail = $collect; $collect_tail =~ s/^.*[\/|\\]//; my $gdbm_directory = &util::filename_cat($collect_dir,$collect,"index","text"); my $gdbm_db = &util::filename_cat($gdbm_directory,"live-$collect_tail.gdb"); my $cmd = "gdbmget $gdbm_db $dbkey"; if (open(GIN,"$cmd |") == 0) { my $mess = "Failed to get metadata key: $metaname\n"; $mess .= "$!\n"; $gsdl_cgi->generate_error($mess); } else { my $metavalue = ""; my $line; while (defined ($line=)) { $metavalue .= $line; } close(GIN); $gsdl_cgi->generate_ok_message("$metavalue"); } } sub set_live_metadata { my $self = shift @_; my $username = $self->{'username'}; my $collect = $self->{'collect'}; my $gsdl_cgi = $self->{'gsdl_cgi'}; my $gsdlhome = $self->{'gsdlhome'}; # don't user authenticate for now if ($baseaction::authentication_enabled) { # Ensure the user is allowed to edit this collection &authenticate_user($gsdl_cgi, $username, $collect); } my $collect_dir = &util::filename_cat($gsdlhome, "collect"); # $gsdl_cgi->checked_chdir($collect_dir); # Make sure the collection isn't locked by someone else $self->lock_collection($username, $collect); # look up additional args my $docid = $self->{'d'}; my $metaname = $self->{'metaname'}; my $metavalue = $self->{'metavalue'}; my $dbkey = "$docid.$metaname"; my $collect_tail = $collect; $collect_tail =~ s/^.*[\/\\]//; my $gdbm_directory = &util::filename_cat($collect_dir,$collect,"index","text"); my $gdbm_db = &util::filename_cat($gdbm_directory,"live-$collect_tail.gdb"); my $cmd = "gdbmset \"$gdbm_db\" \"$dbkey\" \"$metavalue\""; my $status = system($cmd); if ($status != 0) { my $mess = "Failed to set metadata key: $dbkey\n"; $mess .= "PATH: $ENV{'PATH'}\n"; $mess .= "cmd = $cmd\n"; $mess .= "Exit status: $status\n"; $mess .= "System Error Message: $!\n"; $gsdl_cgi->generate_error($mess ); } else { $gsdl_cgi->generate_ok_message("DB set successful: Key[$metaname]=$metavalue"); } } sub mxml_metadata { my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_; my $metaname = $parser->{'parameters'}->{'metaname'}; my $metamode = $parser->{'parameters'}->{'metamode'}; my $name_attr = $attrHash->{'name'}; if (($name_attr eq $metaname) && ($metamode eq "override")) { my $metavalue = $parser->{'parameters'}->{'metavalue'}; $attrHash->{'_content'} = $metavalue; # Don't want it to wipe out any other pieces of metadata $parser->{'parameters'}->{'metamode'} = "done"; } # raw extended return (':'.$tagname => $attrHash, [$tagname => $attrHash]); } sub mxml_description { my ($tagname, $attrHash, $contextArray, $parentDataArray, $parser) = @_; my $metamode = $parser->{'parameters'}->{'metamode'}; if ($metamode eq "accumulate") { # tack a new metadata tag on to the end of the + block my $metaname = $parser->{'parameters'}->{'metaname'}; my $metavalue = $parser->{'parameters'}->{'metavalue'}; my $metadata_attr = { '_content' => $metavalue, 'name' => $metaname, 'mode' => "accumulate" }; my $append_metadata = [ "Metadata" => $metadata_attr ]; my $description_content = $attrHash->{'_content'}; push(@$description_content," ", $append_metadata ,"\n "); } # raw return $tagname => $attrHash; } sub edit_metadata_xml { my $self = shift @_; my ($gsdl_cgi, $metadata_xml_filename, $file, $metaname, $metavalue, $metamode) = @_; # use XML::Rules to add it in (read in and out again) my @rules = ( _default => 'raw extended', 'Metadata' => \&mxml_metadata, 'Description' => \&mxml_description ); my $parser = XML::Rules->new(rules => \@rules, style => 'filter' ); my $xml_in = ""; if (!open(MIN,"<$metadata_xml_filename")) { $gsdl_cgi->generate_error("Unable to read in $metadata_xml_filename: $!"); } else { my $line; while (defined ($line=)) { $xml_in .= $line; } close(MIN); my $xml_out = ""; $parser->filter($xml_in,\$xml_out, { metaname => $metaname, metavalue => $metavalue, metamode => $metamode } ); if (!open(MOUT,">$metadata_xml_filename")) { $gsdl_cgi->generate_error("Unable to write out to $metadata_xml_filename: $!"); } else { print MOUT $xml_out; close(MOUT); } } } sub set_import_metadata { my $self = shift @_; my $username = $self->{'username'}; my $collect = $self->{'collect'}; my $gsdl_cgi = $self->{'gsdl_cgi'}; my $gsdlhome = $self->{'gsdlhome'}; # don't user authenticate for now if ($baseaction::authentication_enabled) { # Ensure the user is allowed to edit this collection $self->authenticate_user($username, $collect); } my $collect_dir = &util::filename_cat($gsdlhome, "collect"); # $gsdl_cgi->checked_chdir($collect_dir); my $archive_dir = &util::filename_cat($collect_dir,$collect,"archives"); # Make sure the collection isn't locked by someone else $self->lock_collection($username, $collect); # look up additional args # want either d= or f= my $docid = $self->{'d'}; my $import_file = $self->{'f'}; if ((!defined $docid) && (!defined $import_file)) { $gsdl_cgi->generate_error("No docid (d=...) or import file (f=) specified."); } my $metaname = $self->{'metaname'}; my $metavalue = $self->{'metavalue'}; my $metamode = $self->{'metamode'}; if ((!defined $metamode) || ($metamode =~ m/^\s*$/)) { # make "accumulate" the default (less destructive, as won't actually # delete any existing values) $metamode = "accumulate"; } my $metadata_xml_file; if (defined $docid) { my $doc_db = "archiveinf-doc.gdb"; my $arcinfo_doc_filename = &util::filename_cat ($archive_dir, $doc_db); my $doc_rec = GDBMUtils::gdbmRecordToHash($arcinfo_doc_filename,$docid); $import_file = $doc_rec->{'src-file'}->[0]; } my $import_filename = &util::filename_cat($collect_dir,$collect,$import_file); # Assuming that the metadata field is being indexed, then # **** "touch" (in the Unix sense) $import_filename so we know it needs to # be reindexed? # (to be implemented) # figure out correct metadata.xml file my ($import_tailname, $import_dirname) = File::Basename::fileparse($import_filename); my $metadata_xml_filename = &util::filename_cat($import_dirname,"metadata.xml"); $self->edit_metadata_xml($gsdl_cgi,$metadata_xml_filename,$import_tailname, $metaname,$metavalue,$metamode); } 1;