########################################################################### # # GAPlug.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. # 12/05/02 Added usage datastructure - John Thompson package GAPlug; use XMLPlug; sub BEGIN { @ISA = ('XMLPlug'); } sub get_default_process_exp { my $self = shift (@_); return q^(?i)doc\.xml$^; } my $options = { 'name' => "GAPlug", 'desc' => "{GAPlug.desc}", 'abstract' => "no", 'inherits' => "yes" }; sub new { my $class = shift (@_); my $self = new XMLPlug ($class, @_); # 14-05-02 To allow for proper inheritance of arguments - John Thompson my $option_list = $self->{'option_list'}; push( @{$option_list}, $options ); $self->{'section'} = ""; $self->{'section_level'} = 0; $self->{'metadata_name'} = ""; $self->{'metadata_value'} = ""; $self->{'content'} = ""; return bless $self, $class; } sub xml_start_document { } sub xml_end_document { } 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 "GAPlug: processing $self->{'file'}\n" if $self->{'verbosity'} > 1; } 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'}); $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); if (defined ($assoc_filepath)) { # make absolute rather than relative... $self->{'filename'} =~ m@^(.*[\\/]archives)@; $assoc_filepath = "$1/$assoc_filepath/"; } else { $assoc_filepath = $self->{'filename'}; $assoc_filepath =~ s/[^\\\/]*$//; } foreach my $assoc_file_info (@$assoc_files) { my ($assoc_file, $mime_type, $dir) = split (":", $assoc_file_info); 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); } $self->{'doc_obj'}->delete_metadata($self->{'doc_obj'}->get_top_section(), "gsdlassocfile"); # process the document $self->{'processor'}->process($self->{'doc_obj'}, $self->{'file'}); } 1;