###########################################################################
#
# GreenstoneMETSPlugout.pm -- the plugout module for METS archives
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the
# University of Waikato, New Zealand.
#
# Copyright (C) 2006 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.
#
###########################################################################
package GreenstoneMETSPlugout;
use strict;
no strict 'refs';
#eval {require bytes};
#use util;
use METSPlugout;
#use docprint; # for escape_text
sub BEGIN {
@GreenstoneMETSPlugout::ISA = ('METSPlugout');
}
my $arguments = [
];
my $options = { 'name' => "GreenstoneMETSPlugout",
'desc' => "{GreenstoneMETSPlugout.desc}",
'abstract' => "no",
'inherits' => "yes",
'args' => $arguments
};
sub new {
my ($class) = shift (@_);
my ($plugoutlist, $inputargs,$hashArgOptLists) = @_;
push(@$plugoutlist, $class);
push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
push(@{$hashArgOptLists->{"OptList"}},$options);
my $self = new METSPlugout($plugoutlist,$inputargs,$hashArgOptLists);
return bless $self, $class;
}
sub output_mets_xml_header
{
my $self = shift(@_);
my ($handle, $OID, $doc_title) = @_;
my $extra_attr = "OBJID=\"$OID:2\"";
$self->output_mets_xml_header_extra_attribute($handle,$extra_attr);
}
#
# Print out docmets.xml file
#
sub output_mets_section
{
my $self = shift(@_);
my ($handle, $doc_obj, $section, $working_dir) = @_;
# print out the dmdSection
print $handle $self->buffer_mets_dmdSection_section_xml($doc_obj,$section);
print $handle "\n";
# print out the fileSection by sections
print $handle $self->buffer_mets_fileSection_section_xml($doc_obj,$section,$working_dir);
# print out the whole fileSection
print $handle $self->buffer_mets_fileWhole_section_xml($doc_obj,$section,$working_dir);
print $handle "\n";
# print out the StructMapSection by sections
my $struct_type = "Section";
# consider making the following its own subroutine
print $handle "\n";
my $order_num=0;
print $handle $self->buffer_mets_StructMapSection_section_xml($doc_obj,$section, \$order_num);
print $handle "\n";
print $handle ''."\n";
print $handle $self->buffer_mets_StructMapWhole_section_xml($doc_obj,$section);
print $handle "\n";
}
sub buffer_mets_dmdSection_section_xml
{
my $self = shift(@_);
my ($doc_obj,$section) = @_;
$section="" unless defined $section;
my $section_ptr=$doc_obj->_lookup_section($section);
return "" unless defined $section_ptr;
# convert section number
my $section_num ="1". $section;
my $dmd_num = $section_num;
my $all_text = "";
my $label_attr = "";
# TODO::
#print STDERR "***** Check that GROUPID in dmdSec is valid!!!\n";
#print STDERR "***** Check to see if required\n";
# if it isn't allowed, go back and set $mdTag = dmdSec/amdSec
$all_text .= "\n";
$all_text .= " \n";
$all_text .= " \n";
foreach my $data (@{$section_ptr->{'metadata'}}){
my $escaped_value = &docprint::escape_text($data->[1]);
$all_text .= ' '. $escaped_value. "\n";
if ($data->[0] eq "dc.Title") {
$all_text .= ' '. $escaped_value."\n";
}
}
$all_text .= " \n";
$all_text .= " \n";
$all_text .= "\n";
foreach my $subsection (@{$section_ptr->{'subsection_order'}}){
$all_text .= $self->buffer_mets_dmdSection_section_xml($doc_obj,"$section.$subsection");
}
$all_text =~ s/[\x00-\x09\x0B\x0C\x0E-\x1F]//g;
return $all_text;
}
sub doctxt_to_xlink
{
my $self = shift @_;
my ($fname,$working_dir) = @_;
my $xlink_href = "file:$fname";
return $xlink_href;
}
sub buffer_mets_fileSection_section_xml
{
my $self = shift(@_);
my ($doc_obj,$section,$working_dir,$is_recursive) = @_;
my $is_txt_split = undef;
my $all_text
= $self->SUPER::buffer_mets_fileSection_section_xml($doc_obj,$section,$working_dir,$is_txt_split);
return $all_text;
}
sub buffer_mets_fileWhole_section_xml
{
my $self = shift(@_);
my ($doc_obj,$section,$working_dir) = @_;
my $section_ptr = $doc_obj-> _lookup_section($section);
return "" unless defined $section_ptr;
my $all_text="";
my $fileID=0;
# Output the fileSection for the whole section
# => get the sourcefile and associative file
my $id_root = "default";
my $opt_owner_id = "";
$all_text .= " \n";
foreach my $data (@{$section_ptr->{'metadata'}}){
my $escaped_value = &docprint::escape_text($data->[1]);
if ($data->[0] eq "gsdlsourcefilename") {
my ($dirPath) = $escaped_value =~ m/^(.*)[\/\\][^\/\\]*$/;
++$fileID;
$all_text .= " \n";
$all_text .= ' '."\n";
$all_text .= " \n";
}
if ($data->[0] eq "gsdlassocfile"){
$escaped_value =~ m/^(.*?):(.*):(.*)$/;
my $assoc_file = $1;
my $mime_type = $2;
my $assoc_dir = $3;
my $assfilePath = ($assoc_dir eq "") ? $assoc_file : "$assoc_dir/$assoc_file";
++$fileID;
my $mime_attr = "MIMETYPE=\"$mime_type\"";
my $xlink_title = "xlink:title=\"$assoc_file\"";
my $id_attr;
my $xlink_href;
$id_attr = "ID=\"$id_root.$fileID\"";
$xlink_href = "xlink:href=\"$assfilePath\"";
$all_text .= " \n";
$all_text .= " \n";
$all_text .= " \n";
}
}
$all_text .= " \n";
$all_text =~ s/[\x00-\x09\x0B\x0C\x0E-\x1F]//g;
return $all_text;
}
1;