########################################################################### # # 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; use GDBMUtils; use ghtml; 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' => [] }, "get-metadata" => { 'compulsory-args' => [ "d", "metaname" ], 'optional-args' => [ "metapos" ] }, "set-live-metadata" => { 'compulsory-args' => [ "d", "metaname", "metavalue" ], 'optional-args' => [ ] }, "set-metadata" => { 'compulsory-args' => [ "d", "metaname", "metavalue" ], 'optional-args' => [ "metapos" ] }, "set-archives-metadata" => { 'compulsory-args' => [ "d", "metaname", "metavalue" ], 'optional-args' => [ "metapos" ] }, "set-import-metadata" => { 'compulsory-args' => [ "metaname", "metavalue" ], 'optional-args' => [ "d", "f", "metamode" ] # metamode can be "accumulate", "override", or "unique-id" }, "remove-live-metadata" => { 'compulsory-args' => [ "d", "metaname" ], 'optional-args' => [ ] }, "remove-metadata" => { 'compulsory-args' => [ "d", "metaname" ], 'optional-args' => [ "metapos" ] } }; 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); chomp($metavalue); $gsdl_cgi->generate_ok_message("$metavalue"); } } sub get_metadata { my $self = shift @_; my $username = $self->{'username'}; my $collect = $self->{'collect'}; my $gsdl_cgi = $self->{'gsdl_cgi'}; my $gsdlhome = $self->{'gsdlhome'}; 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 $metapos = $self->{'metapos'}; 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,"$collect_tail.gdb"); my $doc_rec = GDBMUtils::gdbmRecordToHash($gdbm_db,$docid); foreach my $k (keys %$doc_rec) { my @escaped_v = (); foreach my $v (@{$doc_rec->{$k}}) { my $ev = &ghtml::unescape_html($v); push(@escaped_v, $ev); } $doc_rec->{$k} = \@escaped_v; } $metapos = 0 if (!defined $metapos); my $metavalue = $doc_rec->{$metaname}->[$metapos]; $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("set-live-metadata successful: Key[$metaname]=$metavalue"); } } sub set_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 $metapos = $self->{'metapos'}; my $metavalue = $self->{'metavalue'}; 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,"$collect_tail.gdb"); my $doc_rec = GDBMUtils::gdbmRecordToHash($gdbm_db,$docid); foreach my $k (keys %$doc_rec) { my @escaped_v = (); foreach my $v (@{$doc_rec->{$k}}) { if ($k eq "contains") { # protect quotes in ".2;".3 etc $v =~ s/\"/\\\"/g; push(@escaped_v, $v); } else { my $ev = &ghtml::unescape_html($v); $ev =~ s/\"/\\\"/g; push(@escaped_v, $ev); } } $doc_rec->{$k} = \@escaped_v; } ## print STDERR "**** metavalue = $metavalue\n"; $metavalue =~ s/\"/\\\"/g; if (defined $metapos) { $doc_rec->{$metaname}->[$metapos] = $metavalue; } else { $doc_rec->{$metaname} = [ $metavalue ]; } ## print STDERR "**** metavalue = $metavalue\n"; my $serialized_doc_rec = GDBMUtils::serializeHash($doc_rec); print STDERR "**** ser dr\n$serialized_doc_rec\n\n\n"; my $cmd = "gdbmset \"$gdbm_db\" \"$docid\" \"$serialized_doc_rec\""; my $status = system($cmd); if ($status != 0) { my $mess = "Failed to set metadata key: $docid\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 { my $mess = "set-document-metadata successful: Key[$docid]\n"; $mess .= " $metaname"; $mess .= "->[$metapos]" if (defined $metapos); $mess .= " = $metavalue"; $gsdl_cgi->generate_ok_message($mess); } } sub dxml_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 dxml_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_xml_file { my $self = shift @_; my ($gsdl_cgi, $filename, $rules, $options) = @_; # use XML::Rules to add it in (read in and out again) my $parser = XML::Rules->new(rules => $rules, style => 'filter' ); my $xml_in = ""; if (!open(MIN,"<$filename")) { $gsdl_cgi->generate_error("Unable to read in $filename: $!"); } else { my $line; while (defined ($line=)) { $xml_in .= $line; } close(MIN); my $xml_out = ""; $parser->filter($xml_in,\$xml_out, $options); if (!open(MOUT,">$filename")) { $gsdl_cgi->generate_error("Unable to write out to $filename: $!"); } else { print MOUT $xml_out; close(MOUT); } } } sub edit_doc_xml { my $self = shift @_; my ($gsdl_cgi, $doc_xml_filename, $metaname, $metavalue, $metapos) = @_; # use XML::Rules to add it in (read in and out again) my @rules = ( _default => 'raw extended', 'Metadata' => \&dxml_metadata, 'Description' => \&dxml_description ); my $options = { 'metaname' => $metaname, 'metapos' => $metapos, 'metavalue' => $metavalue }; $self->edit_xml_file($gsdl_cgi,$doc_xml_filename,\@rules,$options); } sub set_archives_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 my $docid = $self->{'d'}; my $metaname = $self->{'metaname'}; my $metavalue = $self->{'metavalue'}; my $metapos = $self->{'metapos'}; $metapos = 0 if (!defined $metapos); 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); my $doc_xml_file = $doc_rec->{'doc-file'}->[0]; my $archives_dir = &util::filename_cat($collect_dir,$collect,"archives"); my $doc_xml_filename = &util::filename_cat($archives_dir,$doc_xml_file); $self->edit_doc_xml($gsdl_cgi,$doc_xml_filename, $metaname,$metavalue,$metapos); } 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, $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; my $import_filename = undef; 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); # This now stores the full pathname $import_filename = $doc_rec->{'src-file'}->[0]; } else { $import_filename = &util::filename_cat($collect_dir,$collect,$import_file); } # 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, $metaname,$metavalue,$metamode); } sub remove_live_metadata { my $self = shift @_; my $username = $self->{'username'}; my $collect = $self->{'collect'}; my $gsdl_cgi = $self->{'gsdl_cgi'}; my $gsdlhome = $self->{'gsdlhome'}; 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 $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 = "gdbmdel \"$gdbm_db\" \"$dbkey\""; 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 remove successful: Key[$metaname]"); } } sub remove_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 $metapos = $self->{'metapos'}; 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,"$collect_tail.gdb"); my $doc_rec = GDBMUtils::gdbmRecordToHash($gdbm_db,$docid); foreach my $k (keys %$doc_rec) { my @escaped_v = (); foreach my $v (@{$doc_rec->{$k}}) { if ($k eq "contains") { # protect quotes in ".2;".3 etc $v =~ s/\"/\\\"/g; push(@escaped_v, $v); } else { my $ev = &ghtml::unescape_html($v); $ev =~ s/\"/\\\"/g; push(@escaped_v, $ev); } } $doc_rec->{$k} = \@escaped_v; } $metapos = 0 if (!defined $metapos); # consider check key is defined before deleting? my $filtered_metadata = []; my $num_metadata_vals = scalar(@{$doc_rec->{$metaname}}); for (my $i=0; $i<$num_metadata_vals; $i++) { my $metavalue = shift(@{$doc_rec->{$metaname}}); if ($i != $metapos) { push(@$filtered_metadata,$metavalue) } } $doc_rec->{$metaname} = $filtered_metadata; my $serialized_doc_rec = GDBMUtils::serializeHash($doc_rec); my $cmd = "gdbmset \"$gdbm_db\" \"$docid\" \"$serialized_doc_rec\""; my $status = system($cmd); if ($status != 0) { my $mess = "Failed to set metadata key: $docid\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 { my $mess = "DB set (with item deleted) successful: Key[$docid]\n"; $mess .= " $metaname"; $mess .= "->[$metapos]" if (defined $metapos); $gsdl_cgi->generate_ok_message($mess); } } 1;