########################################################################### # # GreenstoneXMLPlugin.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) 2001 New Zealand Digital Library Project # # This program is free software; you can redistribute 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. # ########################################################################### # Processes GreenstoneArchive XML documents. Note that this plugin does no # syntax checking (though the XML::Parser module tests for # well-formedness). It's assumed that the GreenstoneArchive files conform # to their DTD. package GreenstoneXMLPlugin; use ReadXMLFile; use strict; no strict 'refs'; # allow filehandles to be variables and viceversa sub BEGIN { @GreenstoneXMLPlugin::ISA = ('ReadXMLFile'); } sub get_default_process_exp { my $self = shift (@_); return q^(?i)doc\.xml$^; } my $arguments = [ { 'name' => "process_exp", 'desc' => "{BasePlugin.process_exp}", 'type' => "regexp", 'deft' => &get_default_process_exp(), 'reqd' => "no" } ]; my $options = { 'name' => "GreenstoneXMLPlugin", 'desc' => "{GreenstoneXMLPlugin.desc}", 'abstract' => "no", 'inherits' => "yes", 'args' => $arguments }; sub new { my ($class) = shift (@_); my ($pluginlist,$inputargs,$hashArgOptLists) = @_; push(@$pluginlist, $class); push(@{$hashArgOptLists->{"ArgList"}},@{$arguments}); push(@{$hashArgOptLists->{"OptList"}},$options); my $self = new ReadXMLFile($pluginlist, $inputargs, $hashArgOptLists); $self->{'section'} = ""; $self->{'section_level'} = 0; $self->{'metadata_name'} = ""; $self->{'metadata_value'} = ""; $self->{'content'} = ""; # # Currently used to store information for previous values controls. In # # the next contract I'll move to using information directly from Lucene. # $self->{'sqlfh'} = 0; return bless $self, $class; } sub xml_start_document { } sub xml_end_document { } sub get_doctype { my $self = shift(@_); return "(Greenstone)?Archive"; } sub xml_doctype { my $self = shift(@_); my ($expat, $name, $sysid, $pubid, $internal) = @_; # allow the short-lived and badly named "GreenstoneArchive" files to be processed # as well as the "Archive" files which should now be created by import.pl die "" if ($name !~ /^(Greenstone)?Archive$/); my $outhandle = $self->{'outhandle'}; print $outhandle "GreenstoneXMLPlugin: processing $self->{'file'}\n" if $self->{'verbosity'} > 1; print STDERR "\n" if $self->{'gli'}; } sub xml_start_tag { my $self = shift(@_); my ($expat, $element) = @_; $self->{'element'} = $element; if ($element eq "Section") { if ($self->{'section_level'} == 0) { $self->open_document(); } else { my $doc_obj = $self->{'doc_obj'}; $self->{'section'} = $doc_obj->insert_section($doc_obj->get_end_child($self->{'section'})); } $self->{'section_level'} ++; } elsif ($element eq "Metadata") { $self->{'metadata_name'} = $_{'name'}; } } sub xml_end_tag { my $self = shift(@_); my ($expat, $element) = @_; if ($element eq "Section") { $self->{'section_level'} --; $self->{'section'} = $self->{'doc_obj'}->get_parent_section ($self->{'section'}); $self->close_document() if $self->{'section_level'} == 0; } elsif ($element eq "Metadata") { $self->{'doc_obj'}->add_utf8_metadata($self->{'section'}, $self->{'metadata_name'},$self->{'metadata_value'}); # Ensure this value is added to the allvalues database in gseditor. # Note that the database constraints prevent multiple occurances of the # same key-value pair. # We write these out to a file, so they can all be commited in one # transaction #if (!$self->{'sqlfh'}) # { # my $sql_file = $ENV{'GSDLHOME'} . "/collect/lld/tmp/gseditor.sql"; # # If the file doesn't already exist, open it and begin a transaction # my $sql_fh; # if (!-e $sql_file) # { # open($sql_fh, ">" . $sql_file); # print $sql_fh "BEGIN TRANSACTION;\n"; # } # else # { # open($sql_fh, ">>" . $sql_file); # } # print STDERR "Opened SQL log\n"; # $self->{'sqlfh'} = $sql_fh; # } #my $mvalue = $self->{'metadata_value'}; #$mvalue =~ s/\'/\'\'/g; #$mvalue =~ s/_claimantsep_/ \& /g; #my $fh = $self->{'sqlfh'}; #if ($fh) # { # print $fh "INSERT INTO allvalues (mkey, mvalue) VALUES ('" . $self->{'metadata_name'} . "', '" . $mvalue . "');\n"; # } # Clean Up $self->{'metadata_name'} = ""; $self->{'metadata_value'} = ""; } elsif ($element eq "Content" && $self->{'content'} ne "") { $self->{'doc_obj'}->add_utf8_text($self->{'section'}, $self->{'content'}); $self->{'content'} = ""; } $self->{'element'} = ""; } sub xml_text { my $self = shift(@_); my ($expat) = @_; if ($self->{'element'} eq "Metadata") { $self->{'metadata_value'} .= $_; } elsif ($self->{'element'} eq "Content") { $self->{'content'} .= $_; } } sub open_document { my $self = shift(@_); # create a new document $self->{'doc_obj'} = new doc (); $self->{'section'} = ""; } sub close_document { my $self = shift(@_); # add the associated files my $assoc_files = $self->{'doc_obj'}->get_metadata($self->{'doc_obj'}->get_top_section(), "gsdlassocfile"); # for when "assocfilepath" isn't the same directory that doc.xml is in... my $assoc_filepath_list= $self->{'doc_obj'}->get_metadata($self->{'doc_obj'}->get_top_section(), "assocfilepath"); my $assoc_filepath=shift (@$assoc_filepath_list); #rint STDERR "Filename is: " . $self->{'filename'} . "\n"; #rint STDERR "Initially my assoc_filepath is: $assoc_filepath\n"; #rint STDERR "Custom archive dir is: " . $self->{'base_dir'} . "\n"; # Correct the assoc filepath if one is defined if (defined ($assoc_filepath)) { # Check whether the assoc_filepath already includes the base dir if (index($assoc_filepath, $self->{'base_dir'}) == -1) { # And if not, append it so as to make this absolute $assoc_filepath = &util::filename_cat($self->{'base_dir'}, $assoc_filepath); } } else { $assoc_filepath = $self->{'filename'}; $assoc_filepath =~ s/[^\\\/]*$//; } #rint STDERR "Goned and made it absolute: $assoc_filepath\n"; foreach my $assoc_file_info (@$assoc_files) { my ($assoc_file, $mime_type, $dir) = split (":", $assoc_file_info); #rint STDERR "assoc_file: $assoc_file\n"; #rint STDERR "mime_type: $mime_type\n"; #rint STDERR "dir: $dir\n"; my $real_dir = &util::filename_cat($assoc_filepath, $assoc_file), my $assoc_dir = (defined $dir && $dir ne "") ? &util::filename_cat($dir, $assoc_file) : $assoc_file; $self->{'doc_obj'}->associate_file($real_dir, $assoc_dir, $mime_type); #rint STDERR "According to me the real assoc_filepath is: $real_dir\n"; } $self->{'doc_obj'}->delete_metadata($self->{'doc_obj'}->get_top_section(), "gsdlassocfile"); # process the document $self->{'processor'}->process($self->{'doc_obj'}, $self->{'file'}); } 1;