source: trunk/gsdl/perllib/plugins/GAPlug.pm@ 4744

###########################################################################
#
# 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');
}

my $options = { 'name'     => "GAPlug",
        'desc'     => "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.",
        '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";
}


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;