Index: dl/trunk/perllib/plugouts/BasPlugout.pm
===================================================================
--- /gsdl/trunk/perllib/plugouts/BasPlugout.pm	(revision 17199)
+++ 	(revision )
@@ -1,971 +1,0 @@
-###########################################################################
-#
-# BasPlugout.pm -- base class for all the plugout modules
-# 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 BasPlugout;
-
-eval {require bytes};
-
-use strict;
-no strict 'subs';
-no strict 'refs';
-
-use gsprintf 'gsprintf';
-use printusage;
-use parse2;
-use GDBMUtils;
-
-
-# suppress the annoying "subroutine redefined" warning that various
-# gets cause under perl 5.6
-$SIG{__WARN__} = sub {warn($_[0]) unless ($_[0] =~ /Subroutine\s+\S+\sredefined/)};
-
-my $arguments = [ 
-       { 'name' => "group_size", 
-	'desc' => "{BasPlugout.group_size}",
-	'type' => "int",
-        'deft' =>  "1",
-	'reqd' => "no",
-	'hiddengli' => "no"},
-       { 'name' => "output_info", 
-	'desc' => "{BasPlugout.output_info}",
-	'type' => "string",   
-	'reqd' => "yes",
-	'hiddengli' => "yes"},        
-       { 'name' => "xslt_file", 
-	'desc' => "{BasPlugout.xslt_file}",
-	'type' => "string",
-	'reqd' => "no",
-	'hiddengli' => "no"},
-       { 'name' => "output_handle", 
-	'desc' => "{BasPlugout.output_handle}",
-	'type' => "string",
-        'deft' =>  'STDERR',
-	'reqd' => "no",
-	'hiddengli' => "yes"},
-       { 'name' => "verbosity", 
-	'desc' => "{BasPlugout.verbosity}",
-	'type' => "int",
-        'deft' =>  "0",
-	'reqd' => "no",  
-     	'hiddengli' => "no"},
-       { 'name' => "gzip_output", 
-	'desc' => "{BasPlugout.gzip_output}",
-	'type' => "flag",
-	'reqd' => "no",  
-     	'hiddengli' => "no"},
-       { 'name' => "debug",
-	 'desc' => "{BasPlugout.debug}",
-	 'type' => "flag",
-	 'reqd' => "no",
-	 'hiddengli' => "yes"}
-];
-
-my $options = { 'name'     => "BasPlugout",
-		'desc'     => "{BasPlugout.desc}",
-		'abstract' => "yes",
-		'inherits' => "no",
-		'args'     => $arguments};
-
-sub new 
-{
-    my $class = shift (@_);
-
-    my ($plugoutlist,$args,$hashArgOptLists) = @_;
-    push(@$plugoutlist, $class);
-
-    my $strPlugoutName = (defined $plugoutlist->[0]) ? $plugoutlist->[0] : $class;
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = {};
-    $self->{'plugout_type'} = $class;
-    $self->{'option_list'} = $hashArgOptLists->{"OptList"};
-    $self->{"info_only"} = 0;
-
-    # Check if gsdlinfo is in the argument list or not - if it is, don't parse 
-    # the args, just return the object.  
-    foreach my $strArg (@{$args})
-    {
-	if(defined $strArg && $strArg eq "-gsdlinfo")
-	{
-	    $self->{"info_only"} = 1;
-	    return bless $self, $class;
-	}
-    }
-    
-    delete $self->{"info_only"};
-    
-    if(parse2::parse($args,$hashArgOptLists->{"ArgList"},$self) == -1)
-    {
-	my $classTempClass = bless $self, $class;
-	print STDERR "<BadPlugout d=$self->{'plugout_name'}>\n";
-	&gsprintf(STDERR, "\n{BasPlugout.bad_general_option}\n", $self->{'plugout_name'});
-	$classTempClass->print_txt_usage("");  # Use default resource bundle
-	die "\n";
-    }
-
- 
-    if(defined $self->{'xslt_file'} &&  $self->{'xslt_file'} ne "")
-    {
-      ##$self->{'xslt_file'} =~ s/\"//g;##working on Windows???
-	print STDERR "Can not find $self->{'xslt_file'}, please make sure you have supplied the correct file path\n" and  die "\n" unless (-e $self->{'xslt_file'});
-    }
-
-    $self->{'gs_count'} = 0;    
-
-    $self->{'keep_import_structure'} = 0; 
-
-    return bless $self, $class;
-
-}
-
-sub print_xml_usage
-{
-    my $self = shift(@_);
-    my $header = shift(@_);
-    my $high_level_information_only = shift(@_);
-    
-    # XML output is always in UTF-8
-    gsprintf::output_strings_in_UTF8;
-
-    if ($header) {
-	&PrintUsage::print_xml_header("plugout");
-    }
-    $self->print_xml($high_level_information_only);
-}
-
-
-sub print_xml
-{
-    my $self = shift(@_);
-    my $high_level_information_only = shift(@_);
-
-    my $optionlistref = $self->{'option_list'};
-    my @optionlist = @$optionlistref;
-    my $plugoutoptions = shift(@$optionlistref);
-    return if (!defined($plugoutoptions));
-
-    gsprintf(STDERR, "<PlugoutInfo>\n");
-    gsprintf(STDERR, "  <Name>$plugoutoptions->{'name'}</Name>\n");
-    my $desc = gsprintf::lookup_string($plugoutoptions->{'desc'});
-    $desc =~ s/</&amp;lt;/g; # doubly escaped
-    $desc =~ s/>/&amp;gt;/g;
-    gsprintf(STDERR, "  <Desc>$desc</Desc>\n");
-    gsprintf(STDERR, "  <Abstract>$plugoutoptions->{'abstract'}</Abstract>\n");
-    gsprintf(STDERR, "  <Inherits>$plugoutoptions->{'inherits'}</Inherits>\n");
-    unless (defined($high_level_information_only)) {
-	gsprintf(STDERR, "  <Arguments>\n");
-	if (defined($plugoutoptions->{'args'})) {
-	    &PrintUsage::print_options_xml($plugoutoptions->{'args'});
-	}
-	gsprintf(STDERR, "  </Arguments>\n");
-
-	# Recurse up the plugout hierarchy
-	$self->print_xml();
-    }
-    gsprintf(STDERR, "</PlugoutInfo>\n");
-}
-
-
-sub print_txt_usage
-{
-    my $self = shift(@_);
-
-    # Print the usage message for a plugout (recursively)
-    my $descoffset = $self->determine_description_offset(0);
-    $self->print_plugout_usage($descoffset, 1);
-}
-
-sub determine_description_offset
-{
-    my $self = shift(@_);
-    my $maxoffset = shift(@_);
-
-    my $optionlistref = $self->{'option_list'};
-    my @optionlist = @$optionlistref;
-    my $plugoutoptions = pop(@$optionlistref);
-    return $maxoffset if (!defined($plugoutoptions));
-
-    # Find the length of the longest option string of this download
-    my $plugoutargs = $plugoutoptions->{'args'};
-    if (defined($plugoutargs)) {
-	my $longest = &PrintUsage::find_longest_option_string($plugoutargs);
-	if ($longest > $maxoffset) {
-	    $maxoffset = $longest;
-	}
-    }
-
-    # Recurse up the download hierarchy
-    $maxoffset = $self->determine_description_offset($maxoffset);
-    $self->{'option_list'} = \@optionlist;
-    return $maxoffset;
-}
-
-
-sub print_plugout_usage
-{
-    my $self = shift(@_);
-    my $descoffset = shift(@_);
-    my $isleafclass = shift(@_);
-
-    my $optionlistref = $self->{'option_list'};
-    my @optionlist = @$optionlistref;
-    my $plugoutoptions = shift(@$optionlistref);
-    return if (!defined($plugoutoptions));
-
-    my $plugoutname = $plugoutoptions->{'name'};
-    my $plugoutargs = $plugoutoptions->{'args'};
-    my $plugoutdesc = $plugoutoptions->{'desc'};
-
-    # Produce the usage information using the data structure above
-    if ($isleafclass) {
-	if (defined($plugoutdesc)) {
-	    gsprintf(STDERR, "$plugoutdesc\n\n");
-	}
-	gsprintf(STDERR, " {common.usage}: plugout $plugoutname [{common.options}]\n\n");
-    }
-
-    # Display the download options, if there are some
-    if (defined($plugoutargs)) {
-	# Calculate the column offset of the option descriptions
-	my $optiondescoffset = $descoffset + 2;  # 2 spaces between options & descriptions
-
-	if ($isleafclass) {
-	    gsprintf(STDERR, " {common.specific_options}:\n");
-	}
-	else {
-	    gsprintf(STDERR, " {common.general_options}:\n", $plugoutname);
-	}
-
-	# Display the download options
-	&PrintUsage::print_options_txt($plugoutargs, $optiondescoffset);
-    }
-
-    # Recurse up the download hierarchy
-    $self->print_plugout_usage($descoffset, 0);
-    $self->{'option_list'} = \@optionlist;
-}
-
-
-sub error
-{
-      my ($strFunctionName,$strError) = @_;
-    {
-	print "Error occoured in BasPlugout.pm\n".
-	    "In Function: ".$strFunctionName."\n".
-	    "Error Message: ".$strError."\n";
-	exit(-1);
-    }  
-}
-
-# OIDtype may be "hash" or "incremental" or "dirname" or "assigned"
-sub set_OIDtype {
-    my $self = shift (@_);
-    my ($type, $metadata) = @_;
-
-    if ($type =~ /^(hash|incremental|dirname|assigned)$/) {
-	$self->{'OIDtype'} = $type;
-    } else {
-	$self->{'OIDtype'} = "hash";
-    }
-    if ($type =~ /^assigned$/) {
-	if (defined $metadata) {
-	    $self->{'OIDmetadata'} = $metadata;
-	} else {
-	    $self->{'OIDmetadata'} = "dc.Identifier";
-	}
-    }
-}
-
-sub set_output_dir 
-{
-    my $self = shift @_;
-    my ($output_dir) = @_;
-
-   $self->{'output_dir'} = $output_dir;
-}
-
-sub setoutputdir 
-{
-    my $self = shift @_;
-    my ($output_dir) = @_;
-
-    $self->{'output_dir'} = $output_dir;
-}
-
-sub get_output_dir 
-{
-    my $self = shift (@_);
-
-   return $self->{'output_dir'};
-}
-
-sub getoutputdir 
-{
-    my $self = shift (@_);
-
-    return $self->{'output_dir'};
-}
-
-sub getoutputinfo 
-{
-    my $self = shift (@_);
-
-    return $self->{'output_info'};
-}
-
-
-sub get_output_handler
-{
-    my $self = shift (@_);
-
-    my ($output_file_name) = @_;
-     
-    open(*OUTPUT, ">$output_file_name") or die "Can not open a file handler for  $output_file_name\n";
-
-    return *OUTPUT;            
-}
-
-sub release_output_handler
-{
-    my $self = shift (@_);
-    my ($outhandler) = @_;
-
-    close($outhandler);
-
-}
-
-sub output_xml_header {
-    my $self = shift (@_);
-    my ($handle,$docroot,$nondoctype) = @_;
-    
-    print $handle '<?xml version="1.0" encoding="UTF-8" standalone="no"?>' . "\n";
-   
-    if (!defined $nondoctype){
-	print $handle '<!DOCTYPE Archive SYSTEM "http://greenstone.org/dtd/Archive/1.0/Archive.dtd">' . "\n";
-    }
-
-    print $handle "<$docroot>\n" if defined $docroot;
-}
-
-sub output_xml_footer {
-    my $self = shift (@_);
-    my ($handle,$docroot) = @_;
-    print $handle "</$docroot>\n" if defined $docroot;
-}
-
-sub process {
-    my $self = shift (@_);
-    my ($doc_obj) = @_;
-    
-    $doc_obj->set_lastmodified();
-
-     if ($self->{'group_size'} > 1) {
-	 $self->group_process ($doc_obj);
-	return;
-    }
-
-    my $OID = $doc_obj->get_OID();
-    $OID = "NULL" unless defined $OID;     
-
-    my $top_section = $doc_obj->get_top_section();
-
-    #get document's directory
-    my $doc_dir = $self->get_doc_dir ($OID, $doc_obj->get_source_filename());
-    
-    my $output_info = $self->{'output_info'};
-    return if (!defined $output_info);
-     
-    ##############################
-    # call subclass' saveas method
-    ##############################
-    $self->saveas($doc_obj,$doc_dir);
-##    $self->archiveinf_gdbm($doc_obj,$doc_dir); 
-
-}
-
-sub store_output_info_reference {
-    my $self = shift (@_);
-    my ($doc_obj) = @_;
-
-    my $output_info = $self->{'output_info'};
-    my $metaname = $self->{'sortmeta'};
-    if (!defined $metaname || $metaname !~ /\S/) {
-	$output_info->add_info($doc_obj->get_OID(),$self->{'short_doc_file'}, undef, "");
-	return;
-    }
-    
-    my $metadata = "";
-    my $top_section = $doc_obj->get_top_section();
-    
-    my @commameta_list = split(/,/, $metaname);
-    foreach my $cmn (@commameta_list) {
-	my $meta = $doc_obj->get_metadata_element($top_section, $cmn);
-	if ($meta) {
-	    # do remove prefix/suffix - this will apply to all values
-	    $meta =~ s/^$self->{'removeprefix'}// if defined $self->{'removeprefix'};	       
-	    $meta =~ s/$self->{'removesuffix'}$// if defined $self->{'removesuffix'};
-	    $meta = &sorttools::format_metadata_for_sorting($cmn, $meta, $doc_obj);
-	    $metadata .= $meta if ($meta);
-	}
-    }
-
-    # store reference in the output_info     
-    $output_info->add_info($doc_obj->get_OID(),$self->{'short_doc_file'}, undef, $metadata);
-    
-}
-
-sub group_process {
-
-    my $self = shift (@_);
-    my ($doc_obj) = @_;
-    
-    my $OID = $doc_obj->get_OID(); 
-    $OID = "NULL" unless defined $OID;
-
-    my $groupsize = $self->{'group_size'};
-    my $gs_count = $self->{'gs_count'};
-    my $open_new_file = (($gs_count % $groupsize)==0);
-    my $outhandle = $self->{'output_handle'};
-
-    # opening a new file, or document has assoicated files => directory needed
-    if (($open_new_file) || (scalar(@{$doc_obj->get_assoc_files()})>0)) {
-		  
-        # The directory the archive file (doc.xml) and all associated files
-        # should end up in
-        my $doc_dir;
-        # If we've determined its time for a new file, open it now
-        if ($open_new_file || !defined($self->{'gs_doc_dir'}))
-          {
-            $doc_dir = $self->get_doc_dir ($OID, $doc_obj->get_source_filename());
-            # only if opening new file
-	    my $output_dir = $self->get_output_dir();
-	    &util::mk_all_dir ($output_dir) unless -e $output_dir;
-	    my $doc_file = &util::filename_cat ($output_dir, $doc_dir, "doc.xml");
-	    my $short_doc_file = &util::filename_cat ($doc_dir, "doc.xml");
-	    
-	    if ($gs_count>0)
-	    {
-		return if (!$self->close_file_output());
-	    }
-
-	    open (GROUPPROCESS, ">$doc_file") or (print $outhandle "BasPlugout::group_process could not write to file $doc_file\n" and return);
-		    
-
-	    $self->{'gs_filename'} = $doc_file;
-	    $self->{'short_doc_file'} = $short_doc_file;
-	    $self->{'gs_OID'} = $OID;
-            $self->{'gs_doc_dir'} = $doc_dir;
-
-	    $self->output_xml_header('BasPlugout::GROUPPROCESS','Archive');
-	}
-        # Otherwise load the same archive document directory used last time
-        else
-          {
-            $doc_dir = $self->{'gs_doc_dir'};
-          }
-
-	# copy all the associated files, add this information as metadata
-	# to the document
-        print $outhandle "Writing associated files to $doc_dir\n";
-	$self->process_assoc_files ($doc_obj, $doc_dir);
-    }
-
-    # save this document
-    my $section_text = &docprint::get_section_xml($doc_obj,$doc_obj->get_top_section());
-    print GROUPPROCESS $section_text;
-
-    $self->{'gs_count'}++;
-}
-
-
-sub saveas {
-    my $self = shift (@_);
-   
-    die "Basplug::saveas function must be implemented in sub classes\n";
-}
-
-sub get_doc_dir {
-    my $self = shift (@_);
-    my ($OID, $source_filename) = @_;
-
-    my $working_dir  = $self->get_output_dir();
-    my $working_info = $self->{output_info}; 
-    return if (!defined $working_info);
-
-    my $doc_info = $working_info->get_info($OID);
-    my $doc_dir = '';
-
-    if (defined $doc_info && scalar(@$doc_info) >= 1)
-    {
-	# This OID already has an archives directory, so use it again
-	$doc_dir = $doc_info->[0];
-	$doc_dir =~ s/\/?((doc(mets)?)|(dublin_core))\.xml(\.gz)?$//;
-    }
-    elsif ($self->{'keep_import_structure'})
-    {
-	$source_filename = &File::Basename::dirname($source_filename);
-	$source_filename =~ s/[\\\/]+/\//g;
-	$source_filename =~ s/\/$//;
-
-      	$doc_dir = substr($source_filename, length($ENV{'GSDLIMPORTDIR'}) + 1);
-    }
-
-    # We have to use a new archives directory for this document
-    if ($doc_dir eq "")
-    {
-	$doc_dir = $self->get_new_doc_dir ($working_info, $working_dir, $OID);
-    }
-
-    if (!defined $self->{'group'} || !$self->{'group'}){
-	&util::mk_all_dir (&util::filename_cat ($working_dir, $doc_dir));
-    }
-
-    return $doc_dir;
-}
-
-sub get_new_doc_dir{
-   my $self = shift (@_);  
-   my($working_info,$working_dir,$OID) = @_;      
-   
-   my $doc_dir = "";
-   my $doc_dir_rest = $OID;
-   my $doc_dir_num = 0;
-
-   do {
-       $doc_dir .= "/" if $doc_dir_num > 0;
-       if ($doc_dir_rest =~ s/^(.{1,8})//) {
-	   $doc_dir .= $1;
-	   $doc_dir_num++;
-       }
-   } while ($doc_dir_rest ne "" && 
-	    ((-d &util::filename_cat ($working_dir, "$doc_dir.dir")) || 
-	     ($working_info->size() >= 1024 && $doc_dir_num < 2)));
-   
-   return "$doc_dir.dir";
-}
-
-sub process_assoc_files {
-    my $self = shift (@_);
-    my ($doc_obj, $doc_dir, $handle) = @_;
-
-    my $outhandle = $self->{'output_handle'};
-    
-    my $output_dir = $self->get_output_dir();
-    return if (!defined $output_dir);
-
-    &util::mk_all_dir ($output_dir) unless -e $output_dir;
-      
-    my $working_dir = &util::filename_cat($output_dir, $doc_dir);
-    &util::mk_all_dir ($working_dir) unless -e $working_dir;
-
-    my @assoc_files = ();
-    my $filename;;
-
-    my $source_filename = $doc_obj->get_source_filename();
-
-    my $collect_dir = $ENV{'GSDLCOLLECTDIR'};
-
-    if (defined $collect_dir) {
-	my $dirsep_regexp = &util::get_os_dirsep();
-
-	if ($collect_dir !~ /$dirsep_regexp$/) {
-	    $collect_dir .= &util::get_dirsep(); # ensure there is a slash at the end
-	}
-
-	# This test is never going to fail on Windows -- is this a problem?
-     
-	if ($source_filename !~ /^$dirsep_regexp/) {
-	    $source_filename = &util::filename_cat($collect_dir, $source_filename);
-	}
-    }
-
-
-    # set the assocfile path (even if we have no assoc files - need this for lucene)
-    $doc_obj->set_utf8_metadata_element ($doc_obj->get_top_section(),
-					 "assocfilepath",
-					 "$doc_dir");
-    foreach my $assoc_file_rec (@{$doc_obj->get_assoc_files()}) {
-	my ($dir, $afile) = $assoc_file_rec->[1] =~ /^(.*?)([^\/\\]+)$/;
-	$dir = "" unless defined $dir;
-	    
-	
-	my $real_filename = $assoc_file_rec->[0];
-	# for some reasons the image associate file has / before the full path
-	$real_filename =~ s/^\\(.*)/$1/i;
-	if (-e $real_filename) {
-
-	    $filename = &util::filename_cat($working_dir, $afile);
-
-	    &util::hard_link ($real_filename, $filename);
-	    
-	    $doc_obj->add_utf8_metadata ($doc_obj->get_top_section(),
-					 "gsdlassocfile",
-					 "$afile:$assoc_file_rec->[2]:$dir");
-	} elsif ($self->{'verbosity'} > 2) {
-	    print $outhandle "BasPlugout::process couldn't copy the associated file " .
-		"$real_filename to $afile\n";
-	}
-    }
-}
-
-
-sub archiveinf_gdbm
-{
-    my $self = shift (@_);
-    my ($doc_obj) = @_;
-
-    my $verbosity = $self->{'verbosity'};
-
-    my $collect_dir = $ENV{'GSDLCOLLECTDIR'};
-    if (defined $collect_dir) {
-	my $dirsep_regexp = &util::get_os_dirsep();
-
-	if ($collect_dir !~ /$dirsep_regexp$/) {
-	    # ensure there is a slash at the end
-	    $collect_dir .= &util::get_dirsep(); 
-	}
-    }
-
-    my $oid = $doc_obj->get_OID();
-    my $source_filename = $doc_obj->get_source_filename();
-
-    my $oid_files = { 'src-file' => $source_filename,
-		      'assoc-files' => [] };
-    
-    my @reverse_lookups = ($source_filename);
-
-    foreach my $assoc_file_rec (@{$doc_obj->get_assoc_files()}) {
-	my $real_filename = $assoc_file_rec->[0];
-	my $full_afile = $assoc_file_rec->[1];
-
-	# for some reasons the image associate file has / before the full path
-	$real_filename =~ s/^\\(.*)/$1/i;
-	if (-e $real_filename) {
-
-	    if (defined $collect_dir) {
-		my $collect_dir_re_safe = $collect_dir;
-		$collect_dir_re_safe =~ s/\\/\\\\/g;
-		$collect_dir_re_safe =~ s/\./\\./g;
-
-		$real_filename =~ s/^$collect_dir_re_safe//;
-	    }
-
-	    push(@reverse_lookups,$real_filename);
-
-	    push(@{$oid_files->{'assoc-files'}},$full_afile);
-
-	}
-	else {
-	    print STDERR "Warning: archiveinf_gdbm()\n  $real_filename does not appear to be on the file system\n";
-	}
-    }
-
-    # better not to commit to a particular db implementation, but
-    # for simplicity, will use GDBM for now.
-
-    my $output_dir = $self->{'output_dir'};
-    my $db_ext = &util::is_little_endian() ? ".ldb" : ".bdb";
-
-    my $doc_db = &util::filename_cat($output_dir,"archiveinf-doc$db_ext");
-    my $src_db = &util::filename_cat($output_dir,"archiveinf-src$db_ext");
-
-    my $doc_db_text = "";
-    $doc_db_text .= "<src-file>$oid_files->{'src-file'}\n";
-    foreach my $af (@{$oid_files->{'assoc-files'}}) {
-	$doc_db_text .= "<assoc-file>$af\n";
-    }
-    chomp($doc_db_text); # remove trailing \n
-
-    &GDBMUtils::gdbmDatabaseSet($doc_db,$oid,$doc_db_text);
-
-    foreach my $rl (@reverse_lookups) {
-	&GDBMUtils::gdbmDatabaseAppend($src_db,$rl,"<oid>$oid\n");
-    }
-    
-}
-
-
-sub set_sortmeta {
-    my $self = shift (@_);
-    my ($sortmeta, $removeprefix, $removesuffix) = @_;
-    
-    $self->{'sortmeta'} = $sortmeta;
-    if (defined ($removeprefix) && $removeprefix ) {
-	$removeprefix =~ s/^\^//; # don't need a leading ^
-	$self->{'removeprefix'} = $removeprefix;
-    }
-    if (defined ($removesuffix) && $removesuffix) {
-	$removesuffix =~ s/\$$//; # don't need a trailing $
-	$self->{'removesuffix'} = $removesuffix;
-    }
-}
-
-sub open_xslt_pipe
-{
-    my $self = shift @_;
-    my ($output_file_name, $xslt_file)=@_;
-
-   return unless defined $xslt_file and $xslt_file ne "" and -e $xslt_file;
-
-    my $java_class_path =  &util::filename_cat ($ENV{'GSDLHOME'},"bin","java");
-
-    my $mapping_file_path = "";
-
-    if ($ENV{'GSDLOS'} eq "windows"){
-	$java_class_path .=";".&util::filename_cat ($ENV{'GSDLHOME'},"bin","java","xalan.jar");
-	$xslt_file = "\"file:///".$xslt_file."\"";
-	$mapping_file_path = "\"file:///";
-    }
-    else{
-	$java_class_path .=":".&util::filename_cat ($ENV{'GSDLHOME'},"bin","java","xalan.jar");
-    }
-
-
-    $java_class_path = "\"".$java_class_path."\"";
-
-    my $cmd = "| java -cp $java_class_path org.nzdl.gsdl.ApplyXSLT -t $xslt_file "; 
-
-    if (defined $self->{'mapping_file'} and $self->{'mapping_file'} ne ""){
-	my $mapping_file_path = "\"".$self->{'mapping_file'}."\""; 
-	$cmd .= "-m $mapping_file_path";
-    }
-
-    open(*XMLWRITER, $cmd)
-	or die "can't open pipe to xslt: $!";
-
-    
-    $self->{'xslt_writer'} = *XMLWRITER;
-
-    print XMLWRITER "<?DocStart?>\n";	    
-    print XMLWRITER "$output_file_name\n";
-
- 
-  }
-  
-
-sub close_xslt_pipe
-{
-  my $self = shift @_;
-
-  
-  return unless defined $self->{'xslt_writer'} ;
-    
-  my $xsltwriter = $self->{'xslt_writer'};
-  
-  print $xsltwriter "<?DocEnd?>\n";
-  close($xsltwriter);
-
-  undef $self->{'xslt_writer'};
-
-}
-
-sub close_file_output
-{
-    my ($self) = @_;
- 
-    # make sure that the handle has been opened - it won't be if we failed
-    # to import any documents...
-    if (defined(fileno(GROUPPROCESS))) {
-	$self->output_xml_footer('GROUPPROCESS','Archive');    
-	close GROUPPROCESS;
-    }
-
-    my $OID = $self->{'gs_OID'};
-    my $short_doc_file = $self->{'short_doc_file'};
-   
-    if ($self->{'gzip'}) {
-	my $doc_file = $self->{'gs_filename'};
-	`gzip $doc_file`;
-	$doc_file .= ".gz";
-	$short_doc_file .= ".gz";
-	if (!-e $doc_file) {
-	     my $outhandle = $self->{'output_handle'};
-	    print $outhandle "error while gzipping: $doc_file doesn't exist\n";
-	    return 0;
-	}
-    }
-
-    # store reference in output_info
-    my $output_info = $self->{'output_info'};
-    return 0 if (!defined $output_info);
-    $output_info->add_info($OID, $short_doc_file, undef, undef);
-    return 1;
-}
-
-
-#the subclass should implement this method if is_group method could return 1.
-sub close_group_output{
-   my $self = shift (@_);        
-}
-
-sub is_group {
-    my $self = shift (@_);
-    return 0;        
-}
-
-my $dc_set = { Title => 1,       
-	       Creator => 1, 
-	       Subject => 1, 
-	       Description => 1, 
-	       Publisher => 1, 
-	       Contributor => 1, 
-	       Date => 1, 
-	       Type => 1, 
-	       Format => 1, 
-	       Identifier => 1, 
-	       Source => 1, 
-	       Language => 1, 
-	       Relation => 1, 
-	       Coverage => 1, 
-	       Rights => 1};
-
-
-# returns an XML representation of the dublin core metadata
-# if dc meta is not found, try ex mete
-sub get_dc_metadata {
-    my $self = shift(@_);
-    my ($doc_obj, $section, $version) = @_;
-    
-    # build up string of dublin core metadata
-    $section="" unless defined $section;
-    
-    my $section_ptr = $doc_obj->_lookup_section($section);
-    return "" unless defined $section_ptr;
-
-
-    my $explicit_dc = {};
-    my $explicit_ex = {};
-
-    my $all_text="";
-    foreach my $data (@{$section_ptr->{'metadata'}}){
-	my $escaped_value = &docprint::escape_text($data->[1]);
-	if ($data->[0]=~ m/^dc\./) {
-	    $data->[0] =~ tr/[A-Z]/[a-z]/;
-
-	    $data->[0] =~ m/^dc\.(.*)/;
-	    my $dc_element =  $1;
-
-	    if (!defined $explicit_dc->{$dc_element}) {
-		$explicit_dc->{$dc_element} = [];
-	    }
-	    push(@{$explicit_dc->{$dc_element}},$escaped_value);
-
-	    if (defined $version && ($version eq "oai_dc")) {
-		$all_text .= "   <dc:$dc_element>$escaped_value</dc:$dc_element>\n";
-	    }
-	    else {
-		# qualifier???
-		$all_text .= '   <dcvalue element="'. $dc_element.'">'. $escaped_value. "</dcvalue>\n";
-	    }
-
-	} 
-	elsif (($data->[0] =~ m/^ex\./) || ($data->[0] !~ m/\./)) {
-	    $data->[0] =~ m/^(ex\.)?(.*)/;
-	    my $ex_element =  $2;
-	    my $lc_ex_element = lc($ex_element);
-
-	    if (defined $dc_set->{$ex_element}) {
-		if (!defined $explicit_ex->{$lc_ex_element}) {
-		    $explicit_ex->{$lc_ex_element} = [];
-		}
-		push(@{$explicit_ex->{$lc_ex_element}},$escaped_value);
-	    }
-	}
-    }
-
-    # go through dc_set and for any element *not* defined in explicit_dc
-    # that does exist in explicit_ex, add it in as metadata
-    foreach my $k ( keys %$dc_set ) {
-	my $lc_k = lc($k);
-
-	if (!defined $explicit_dc->{$lc_k}) {
-	    if (defined $explicit_ex->{$lc_k}) {
-
-		foreach my $v (@{$explicit_ex->{$lc_k}}) {
-		    my $dc_element    = $lc_k;
-		    my $escaped_value = $v;
-
-		    if (defined $version && ($version eq "oai_dc")) {
-			$all_text .= "   <dc:$dc_element>$escaped_value</dc:$dc_element>\n";
-		    }
-		    else {
-			$all_text .= '   <dcvalue element="'. $dc_element.'">'. $escaped_value. "</dcvalue>\n";
-		    }
-		    
-		}
-	    }
-	}
-    }
-
-    if ($all_text eq "") {
-	$all_text .= "   There is no Dublin Core metatdata in this document\n";
-    }	
-    $all_text =~ s/[\x00-\x09\x0B\x0C\x0E-\x1F]//g;
-
-    return $all_text;
-}
-
-# Build up dublin_core metadata.  Priority given to dc.* over ex.*
-# This method was apparently added by Jeffrey and committed by Shaoqun.
-# But we don't know why it was added, so not using it anymore.
-sub new_get_dc_metadata {
-    
-    my $self = shift(@_);
-    my ($doc_obj, $section, $version) = @_;
-
-    # build up string of dublin core metadata
-    $section="" unless defined $section;
-    
-    my $section_ptr=$doc_obj->_lookup_section($section);
-    return "" unless defined $section_ptr;
-
-    my $all_text = "";
-    foreach my $data (@{$section_ptr->{'metadata'}}){
-	my $escaped_value = &docprint::escape_text($data->[1]);
-	my $dc_element =  $data->[0];
-	
-	my @array = split('\.',$dc_element);
-	my ($type,$name);
-
-	if(defined $array[1])
-	{
-	    $type = $array[0];
-	    $name = $array[1];
-	}
-	else
-	{
-	    $type = "ex";
-	    $name = $array[0];
-	}
-	
-	$all_text .= '   <Metadata Type="'. $type.'" Name="'.$name.'">'. $escaped_value. "</Metadata>\n";
-    }
-    return $all_text;
-}
-
-
-1;
Index: /gsdl/trunk/perllib/plugouts/BasePlugout.pm
===================================================================
--- /gsdl/trunk/perllib/plugouts/BasePlugout.pm	(revision 17200)
+++ /gsdl/trunk/perllib/plugouts/BasePlugout.pm	(revision 17200)
@@ -0,0 +1,971 @@
+###########################################################################
+#
+# BasPlugout.pm -- base class for all the plugout modules
+# 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 BasPlugout;
+
+eval {require bytes};
+
+use strict;
+no strict 'subs';
+no strict 'refs';
+
+use gsprintf 'gsprintf';
+use printusage;
+use parse2;
+use GDBMUtils;
+
+
+# suppress the annoying "subroutine redefined" warning that various
+# gets cause under perl 5.6
+$SIG{__WARN__} = sub {warn($_[0]) unless ($_[0] =~ /Subroutine\s+\S+\sredefined/)};
+
+my $arguments = [ 
+       { 'name' => "group_size", 
+	'desc' => "{BasPlugout.group_size}",
+	'type' => "int",
+        'deft' =>  "1",
+	'reqd' => "no",
+	'hiddengli' => "no"},
+       { 'name' => "output_info", 
+	'desc' => "{BasPlugout.output_info}",
+	'type' => "string",   
+	'reqd' => "yes",
+	'hiddengli' => "yes"},        
+       { 'name' => "xslt_file", 
+	'desc' => "{BasPlugout.xslt_file}",
+	'type' => "string",
+	'reqd' => "no",
+	'hiddengli' => "no"},
+       { 'name' => "output_handle", 
+	'desc' => "{BasPlugout.output_handle}",
+	'type' => "string",
+        'deft' =>  'STDERR',
+	'reqd' => "no",
+	'hiddengli' => "yes"},
+       { 'name' => "verbosity", 
+	'desc' => "{BasPlugout.verbosity}",
+	'type' => "int",
+        'deft' =>  "0",
+	'reqd' => "no",  
+     	'hiddengli' => "no"},
+       { 'name' => "gzip_output", 
+	'desc' => "{BasPlugout.gzip_output}",
+	'type' => "flag",
+	'reqd' => "no",  
+     	'hiddengli' => "no"},
+       { 'name' => "debug",
+	 'desc' => "{BasPlugout.debug}",
+	 'type' => "flag",
+	 'reqd' => "no",
+	 'hiddengli' => "yes"}
+];
+
+my $options = { 'name'     => "BasPlugout",
+		'desc'     => "{BasPlugout.desc}",
+		'abstract' => "yes",
+		'inherits' => "no",
+		'args'     => $arguments};
+
+sub new 
+{
+    my $class = shift (@_);
+
+    my ($plugoutlist,$args,$hashArgOptLists) = @_;
+    push(@$plugoutlist, $class);
+
+    my $strPlugoutName = (defined $plugoutlist->[0]) ? $plugoutlist->[0] : $class;
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = {};
+    $self->{'plugout_type'} = $class;
+    $self->{'option_list'} = $hashArgOptLists->{"OptList"};
+    $self->{"info_only"} = 0;
+
+    # Check if gsdlinfo is in the argument list or not - if it is, don't parse 
+    # the args, just return the object.  
+    foreach my $strArg (@{$args})
+    {
+	if(defined $strArg && $strArg eq "-gsdlinfo")
+	{
+	    $self->{"info_only"} = 1;
+	    return bless $self, $class;
+	}
+    }
+    
+    delete $self->{"info_only"};
+    
+    if(parse2::parse($args,$hashArgOptLists->{"ArgList"},$self) == -1)
+    {
+	my $classTempClass = bless $self, $class;
+	print STDERR "<BadPlugout d=$self->{'plugout_name'}>\n";
+	&gsprintf(STDERR, "\n{BasPlugout.bad_general_option}\n", $self->{'plugout_name'});
+	$classTempClass->print_txt_usage("");  # Use default resource bundle
+	die "\n";
+    }
+
+ 
+    if(defined $self->{'xslt_file'} &&  $self->{'xslt_file'} ne "")
+    {
+      ##$self->{'xslt_file'} =~ s/\"//g;##working on Windows???
+	print STDERR "Can not find $self->{'xslt_file'}, please make sure you have supplied the correct file path\n" and  die "\n" unless (-e $self->{'xslt_file'});
+    }
+
+    $self->{'gs_count'} = 0;    
+
+    $self->{'keep_import_structure'} = 0; 
+
+    return bless $self, $class;
+
+}
+
+sub print_xml_usage
+{
+    my $self = shift(@_);
+    my $header = shift(@_);
+    my $high_level_information_only = shift(@_);
+    
+    # XML output is always in UTF-8
+    gsprintf::output_strings_in_UTF8;
+
+    if ($header) {
+	&PrintUsage::print_xml_header("plugout");
+    }
+    $self->print_xml($high_level_information_only);
+}
+
+
+sub print_xml
+{
+    my $self = shift(@_);
+    my $high_level_information_only = shift(@_);
+
+    my $optionlistref = $self->{'option_list'};
+    my @optionlist = @$optionlistref;
+    my $plugoutoptions = shift(@$optionlistref);
+    return if (!defined($plugoutoptions));
+
+    gsprintf(STDERR, "<PlugoutInfo>\n");
+    gsprintf(STDERR, "  <Name>$plugoutoptions->{'name'}</Name>\n");
+    my $desc = gsprintf::lookup_string($plugoutoptions->{'desc'});
+    $desc =~ s/</&amp;lt;/g; # doubly escaped
+    $desc =~ s/>/&amp;gt;/g;
+    gsprintf(STDERR, "  <Desc>$desc</Desc>\n");
+    gsprintf(STDERR, "  <Abstract>$plugoutoptions->{'abstract'}</Abstract>\n");
+    gsprintf(STDERR, "  <Inherits>$plugoutoptions->{'inherits'}</Inherits>\n");
+    unless (defined($high_level_information_only)) {
+	gsprintf(STDERR, "  <Arguments>\n");
+	if (defined($plugoutoptions->{'args'})) {
+	    &PrintUsage::print_options_xml($plugoutoptions->{'args'});
+	}
+	gsprintf(STDERR, "  </Arguments>\n");
+
+	# Recurse up the plugout hierarchy
+	$self->print_xml();
+    }
+    gsprintf(STDERR, "</PlugoutInfo>\n");
+}
+
+
+sub print_txt_usage
+{
+    my $self = shift(@_);
+
+    # Print the usage message for a plugout (recursively)
+    my $descoffset = $self->determine_description_offset(0);
+    $self->print_plugout_usage($descoffset, 1);
+}
+
+sub determine_description_offset
+{
+    my $self = shift(@_);
+    my $maxoffset = shift(@_);
+
+    my $optionlistref = $self->{'option_list'};
+    my @optionlist = @$optionlistref;
+    my $plugoutoptions = pop(@$optionlistref);
+    return $maxoffset if (!defined($plugoutoptions));
+
+    # Find the length of the longest option string of this download
+    my $plugoutargs = $plugoutoptions->{'args'};
+    if (defined($plugoutargs)) {
+	my $longest = &PrintUsage::find_longest_option_string($plugoutargs);
+	if ($longest > $maxoffset) {
+	    $maxoffset = $longest;
+	}
+    }
+
+    # Recurse up the download hierarchy
+    $maxoffset = $self->determine_description_offset($maxoffset);
+    $self->{'option_list'} = \@optionlist;
+    return $maxoffset;
+}
+
+
+sub print_plugout_usage
+{
+    my $self = shift(@_);
+    my $descoffset = shift(@_);
+    my $isleafclass = shift(@_);
+
+    my $optionlistref = $self->{'option_list'};
+    my @optionlist = @$optionlistref;
+    my $plugoutoptions = shift(@$optionlistref);
+    return if (!defined($plugoutoptions));
+
+    my $plugoutname = $plugoutoptions->{'name'};
+    my $plugoutargs = $plugoutoptions->{'args'};
+    my $plugoutdesc = $plugoutoptions->{'desc'};
+
+    # Produce the usage information using the data structure above
+    if ($isleafclass) {
+	if (defined($plugoutdesc)) {
+	    gsprintf(STDERR, "$plugoutdesc\n\n");
+	}
+	gsprintf(STDERR, " {common.usage}: plugout $plugoutname [{common.options}]\n\n");
+    }
+
+    # Display the download options, if there are some
+    if (defined($plugoutargs)) {
+	# Calculate the column offset of the option descriptions
+	my $optiondescoffset = $descoffset + 2;  # 2 spaces between options & descriptions
+
+	if ($isleafclass) {
+	    gsprintf(STDERR, " {common.specific_options}:\n");
+	}
+	else {
+	    gsprintf(STDERR, " {common.general_options}:\n", $plugoutname);
+	}
+
+	# Display the download options
+	&PrintUsage::print_options_txt($plugoutargs, $optiondescoffset);
+    }
+
+    # Recurse up the download hierarchy
+    $self->print_plugout_usage($descoffset, 0);
+    $self->{'option_list'} = \@optionlist;
+}
+
+
+sub error
+{
+      my ($strFunctionName,$strError) = @_;
+    {
+	print "Error occoured in BasPlugout.pm\n".
+	    "In Function: ".$strFunctionName."\n".
+	    "Error Message: ".$strError."\n";
+	exit(-1);
+    }  
+}
+
+# OIDtype may be "hash" or "incremental" or "dirname" or "assigned"
+sub set_OIDtype {
+    my $self = shift (@_);
+    my ($type, $metadata) = @_;
+
+    if ($type =~ /^(hash|incremental|dirname|assigned)$/) {
+	$self->{'OIDtype'} = $type;
+    } else {
+	$self->{'OIDtype'} = "hash";
+    }
+    if ($type =~ /^assigned$/) {
+	if (defined $metadata) {
+	    $self->{'OIDmetadata'} = $metadata;
+	} else {
+	    $self->{'OIDmetadata'} = "dc.Identifier";
+	}
+    }
+}
+
+sub set_output_dir 
+{
+    my $self = shift @_;
+    my ($output_dir) = @_;
+
+   $self->{'output_dir'} = $output_dir;
+}
+
+sub setoutputdir 
+{
+    my $self = shift @_;
+    my ($output_dir) = @_;
+
+    $self->{'output_dir'} = $output_dir;
+}
+
+sub get_output_dir 
+{
+    my $self = shift (@_);
+
+   return $self->{'output_dir'};
+}
+
+sub getoutputdir 
+{
+    my $self = shift (@_);
+
+    return $self->{'output_dir'};
+}
+
+sub getoutputinfo 
+{
+    my $self = shift (@_);
+
+    return $self->{'output_info'};
+}
+
+
+sub get_output_handler
+{
+    my $self = shift (@_);
+
+    my ($output_file_name) = @_;
+     
+    open(*OUTPUT, ">$output_file_name") or die "Can not open a file handler for  $output_file_name\n";
+
+    return *OUTPUT;            
+}
+
+sub release_output_handler
+{
+    my $self = shift (@_);
+    my ($outhandler) = @_;
+
+    close($outhandler);
+
+}
+
+sub output_xml_header {
+    my $self = shift (@_);
+    my ($handle,$docroot,$nondoctype) = @_;
+    
+    print $handle '<?xml version="1.0" encoding="UTF-8" standalone="no"?>' . "\n";
+   
+    if (!defined $nondoctype){
+	print $handle '<!DOCTYPE Archive SYSTEM "http://greenstone.org/dtd/Archive/1.0/Archive.dtd">' . "\n";
+    }
+
+    print $handle "<$docroot>\n" if defined $docroot;
+}
+
+sub output_xml_footer {
+    my $self = shift (@_);
+    my ($handle,$docroot) = @_;
+    print $handle "</$docroot>\n" if defined $docroot;
+}
+
+sub process {
+    my $self = shift (@_);
+    my ($doc_obj) = @_;
+    
+    $doc_obj->set_lastmodified();
+
+     if ($self->{'group_size'} > 1) {
+	 $self->group_process ($doc_obj);
+	return;
+    }
+
+    my $OID = $doc_obj->get_OID();
+    $OID = "NULL" unless defined $OID;     
+
+    my $top_section = $doc_obj->get_top_section();
+
+    #get document's directory
+    my $doc_dir = $self->get_doc_dir ($OID, $doc_obj->get_source_filename());
+    
+    my $output_info = $self->{'output_info'};
+    return if (!defined $output_info);
+     
+    ##############################
+    # call subclass' saveas method
+    ##############################
+    $self->saveas($doc_obj,$doc_dir);
+##    $self->archiveinf_gdbm($doc_obj,$doc_dir); 
+
+}
+
+sub store_output_info_reference {
+    my $self = shift (@_);
+    my ($doc_obj) = @_;
+
+    my $output_info = $self->{'output_info'};
+    my $metaname = $self->{'sortmeta'};
+    if (!defined $metaname || $metaname !~ /\S/) {
+	$output_info->add_info($doc_obj->get_OID(),$self->{'short_doc_file'}, undef, "");
+	return;
+    }
+    
+    my $metadata = "";
+    my $top_section = $doc_obj->get_top_section();
+    
+    my @commameta_list = split(/,/, $metaname);
+    foreach my $cmn (@commameta_list) {
+	my $meta = $doc_obj->get_metadata_element($top_section, $cmn);
+	if ($meta) {
+	    # do remove prefix/suffix - this will apply to all values
+	    $meta =~ s/^$self->{'removeprefix'}// if defined $self->{'removeprefix'};	       
+	    $meta =~ s/$self->{'removesuffix'}$// if defined $self->{'removesuffix'};
+	    $meta = &sorttools::format_metadata_for_sorting($cmn, $meta, $doc_obj);
+	    $metadata .= $meta if ($meta);
+	}
+    }
+
+    # store reference in the output_info     
+    $output_info->add_info($doc_obj->get_OID(),$self->{'short_doc_file'}, undef, $metadata);
+    
+}
+
+sub group_process {
+
+    my $self = shift (@_);
+    my ($doc_obj) = @_;
+    
+    my $OID = $doc_obj->get_OID(); 
+    $OID = "NULL" unless defined $OID;
+
+    my $groupsize = $self->{'group_size'};
+    my $gs_count = $self->{'gs_count'};
+    my $open_new_file = (($gs_count % $groupsize)==0);
+    my $outhandle = $self->{'output_handle'};
+
+    # opening a new file, or document has assoicated files => directory needed
+    if (($open_new_file) || (scalar(@{$doc_obj->get_assoc_files()})>0)) {
+		  
+        # The directory the archive file (doc.xml) and all associated files
+        # should end up in
+        my $doc_dir;
+        # If we've determined its time for a new file, open it now
+        if ($open_new_file || !defined($self->{'gs_doc_dir'}))
+          {
+            $doc_dir = $self->get_doc_dir ($OID, $doc_obj->get_source_filename());
+            # only if opening new file
+	    my $output_dir = $self->get_output_dir();
+	    &util::mk_all_dir ($output_dir) unless -e $output_dir;
+	    my $doc_file = &util::filename_cat ($output_dir, $doc_dir, "doc.xml");
+	    my $short_doc_file = &util::filename_cat ($doc_dir, "doc.xml");
+	    
+	    if ($gs_count>0)
+	    {
+		return if (!$self->close_file_output());
+	    }
+
+	    open (GROUPPROCESS, ">$doc_file") or (print $outhandle "BasPlugout::group_process could not write to file $doc_file\n" and return);
+		    
+
+	    $self->{'gs_filename'} = $doc_file;
+	    $self->{'short_doc_file'} = $short_doc_file;
+	    $self->{'gs_OID'} = $OID;
+            $self->{'gs_doc_dir'} = $doc_dir;
+
+	    $self->output_xml_header('BasPlugout::GROUPPROCESS','Archive');
+	}
+        # Otherwise load the same archive document directory used last time
+        else
+          {
+            $doc_dir = $self->{'gs_doc_dir'};
+          }
+
+	# copy all the associated files, add this information as metadata
+	# to the document
+        print $outhandle "Writing associated files to $doc_dir\n";
+	$self->process_assoc_files ($doc_obj, $doc_dir);
+    }
+
+    # save this document
+    my $section_text = &docprint::get_section_xml($doc_obj,$doc_obj->get_top_section());
+    print GROUPPROCESS $section_text;
+
+    $self->{'gs_count'}++;
+}
+
+
+sub saveas {
+    my $self = shift (@_);
+   
+    die "Basplug::saveas function must be implemented in sub classes\n";
+}
+
+sub get_doc_dir {
+    my $self = shift (@_);
+    my ($OID, $source_filename) = @_;
+
+    my $working_dir  = $self->get_output_dir();
+    my $working_info = $self->{output_info}; 
+    return if (!defined $working_info);
+
+    my $doc_info = $working_info->get_info($OID);
+    my $doc_dir = '';
+
+    if (defined $doc_info && scalar(@$doc_info) >= 1)
+    {
+	# This OID already has an archives directory, so use it again
+	$doc_dir = $doc_info->[0];
+	$doc_dir =~ s/\/?((doc(mets)?)|(dublin_core))\.xml(\.gz)?$//;
+    }
+    elsif ($self->{'keep_import_structure'})
+    {
+	$source_filename = &File::Basename::dirname($source_filename);
+	$source_filename =~ s/[\\\/]+/\//g;
+	$source_filename =~ s/\/$//;
+
+      	$doc_dir = substr($source_filename, length($ENV{'GSDLIMPORTDIR'}) + 1);
+    }
+
+    # We have to use a new archives directory for this document
+    if ($doc_dir eq "")
+    {
+	$doc_dir = $self->get_new_doc_dir ($working_info, $working_dir, $OID);
+    }
+
+    if (!defined $self->{'group'} || !$self->{'group'}){
+	&util::mk_all_dir (&util::filename_cat ($working_dir, $doc_dir));
+    }
+
+    return $doc_dir;
+}
+
+sub get_new_doc_dir{
+   my $self = shift (@_);  
+   my($working_info,$working_dir,$OID) = @_;      
+   
+   my $doc_dir = "";
+   my $doc_dir_rest = $OID;
+   my $doc_dir_num = 0;
+
+   do {
+       $doc_dir .= "/" if $doc_dir_num > 0;
+       if ($doc_dir_rest =~ s/^(.{1,8})//) {
+	   $doc_dir .= $1;
+	   $doc_dir_num++;
+       }
+   } while ($doc_dir_rest ne "" && 
+	    ((-d &util::filename_cat ($working_dir, "$doc_dir.dir")) || 
+	     ($working_info->size() >= 1024 && $doc_dir_num < 2)));
+   
+   return "$doc_dir.dir";
+}
+
+sub process_assoc_files {
+    my $self = shift (@_);
+    my ($doc_obj, $doc_dir, $handle) = @_;
+
+    my $outhandle = $self->{'output_handle'};
+    
+    my $output_dir = $self->get_output_dir();
+    return if (!defined $output_dir);
+
+    &util::mk_all_dir ($output_dir) unless -e $output_dir;
+      
+    my $working_dir = &util::filename_cat($output_dir, $doc_dir);
+    &util::mk_all_dir ($working_dir) unless -e $working_dir;
+
+    my @assoc_files = ();
+    my $filename;;
+
+    my $source_filename = $doc_obj->get_source_filename();
+
+    my $collect_dir = $ENV{'GSDLCOLLECTDIR'};
+
+    if (defined $collect_dir) {
+	my $dirsep_regexp = &util::get_os_dirsep();
+
+	if ($collect_dir !~ /$dirsep_regexp$/) {
+	    $collect_dir .= &util::get_dirsep(); # ensure there is a slash at the end
+	}
+
+	# This test is never going to fail on Windows -- is this a problem?
+     
+	if ($source_filename !~ /^$dirsep_regexp/) {
+	    $source_filename = &util::filename_cat($collect_dir, $source_filename);
+	}
+    }
+
+
+    # set the assocfile path (even if we have no assoc files - need this for lucene)
+    $doc_obj->set_utf8_metadata_element ($doc_obj->get_top_section(),
+					 "assocfilepath",
+					 "$doc_dir");
+    foreach my $assoc_file_rec (@{$doc_obj->get_assoc_files()}) {
+	my ($dir, $afile) = $assoc_file_rec->[1] =~ /^(.*?)([^\/\\]+)$/;
+	$dir = "" unless defined $dir;
+	    
+	
+	my $real_filename = $assoc_file_rec->[0];
+	# for some reasons the image associate file has / before the full path
+	$real_filename =~ s/^\\(.*)/$1/i;
+	if (-e $real_filename) {
+
+	    $filename = &util::filename_cat($working_dir, $afile);
+
+	    &util::hard_link ($real_filename, $filename);
+	    
+	    $doc_obj->add_utf8_metadata ($doc_obj->get_top_section(),
+					 "gsdlassocfile",
+					 "$afile:$assoc_file_rec->[2]:$dir");
+	} elsif ($self->{'verbosity'} > 2) {
+	    print $outhandle "BasPlugout::process couldn't copy the associated file " .
+		"$real_filename to $afile\n";
+	}
+    }
+}
+
+
+sub archiveinf_gdbm
+{
+    my $self = shift (@_);
+    my ($doc_obj) = @_;
+
+    my $verbosity = $self->{'verbosity'};
+
+    my $collect_dir = $ENV{'GSDLCOLLECTDIR'};
+    if (defined $collect_dir) {
+	my $dirsep_regexp = &util::get_os_dirsep();
+
+	if ($collect_dir !~ /$dirsep_regexp$/) {
+	    # ensure there is a slash at the end
+	    $collect_dir .= &util::get_dirsep(); 
+	}
+    }
+
+    my $oid = $doc_obj->get_OID();
+    my $source_filename = $doc_obj->get_source_filename();
+
+    my $oid_files = { 'src-file' => $source_filename,
+		      'assoc-files' => [] };
+    
+    my @reverse_lookups = ($source_filename);
+
+    foreach my $assoc_file_rec (@{$doc_obj->get_assoc_files()}) {
+	my $real_filename = $assoc_file_rec->[0];
+	my $full_afile = $assoc_file_rec->[1];
+
+	# for some reasons the image associate file has / before the full path
+	$real_filename =~ s/^\\(.*)/$1/i;
+	if (-e $real_filename) {
+
+	    if (defined $collect_dir) {
+		my $collect_dir_re_safe = $collect_dir;
+		$collect_dir_re_safe =~ s/\\/\\\\/g;
+		$collect_dir_re_safe =~ s/\./\\./g;
+
+		$real_filename =~ s/^$collect_dir_re_safe//;
+	    }
+
+	    push(@reverse_lookups,$real_filename);
+
+	    push(@{$oid_files->{'assoc-files'}},$full_afile);
+
+	}
+	else {
+	    print STDERR "Warning: archiveinf_gdbm()\n  $real_filename does not appear to be on the file system\n";
+	}
+    }
+
+    # better not to commit to a particular db implementation, but
+    # for simplicity, will use GDBM for now.
+
+    my $output_dir = $self->{'output_dir'};
+    my $db_ext = &util::is_little_endian() ? ".ldb" : ".bdb";
+
+    my $doc_db = &util::filename_cat($output_dir,"archiveinf-doc$db_ext");
+    my $src_db = &util::filename_cat($output_dir,"archiveinf-src$db_ext");
+
+    my $doc_db_text = "";
+    $doc_db_text .= "<src-file>$oid_files->{'src-file'}\n";
+    foreach my $af (@{$oid_files->{'assoc-files'}}) {
+	$doc_db_text .= "<assoc-file>$af\n";
+    }
+    chomp($doc_db_text); # remove trailing \n
+
+    &GDBMUtils::gdbmDatabaseSet($doc_db,$oid,$doc_db_text);
+
+    foreach my $rl (@reverse_lookups) {
+	&GDBMUtils::gdbmDatabaseAppend($src_db,$rl,"<oid>$oid\n");
+    }
+    
+}
+
+
+sub set_sortmeta {
+    my $self = shift (@_);
+    my ($sortmeta, $removeprefix, $removesuffix) = @_;
+    
+    $self->{'sortmeta'} = $sortmeta;
+    if (defined ($removeprefix) && $removeprefix ) {
+	$removeprefix =~ s/^\^//; # don't need a leading ^
+	$self->{'removeprefix'} = $removeprefix;
+    }
+    if (defined ($removesuffix) && $removesuffix) {
+	$removesuffix =~ s/\$$//; # don't need a trailing $
+	$self->{'removesuffix'} = $removesuffix;
+    }
+}
+
+sub open_xslt_pipe
+{
+    my $self = shift @_;
+    my ($output_file_name, $xslt_file)=@_;
+
+   return unless defined $xslt_file and $xslt_file ne "" and -e $xslt_file;
+
+    my $java_class_path =  &util::filename_cat ($ENV{'GSDLHOME'},"bin","java");
+
+    my $mapping_file_path = "";
+
+    if ($ENV{'GSDLOS'} eq "windows"){
+	$java_class_path .=";".&util::filename_cat ($ENV{'GSDLHOME'},"bin","java","xalan.jar");
+	$xslt_file = "\"file:///".$xslt_file."\"";
+	$mapping_file_path = "\"file:///";
+    }
+    else{
+	$java_class_path .=":".&util::filename_cat ($ENV{'GSDLHOME'},"bin","java","xalan.jar");
+    }
+
+
+    $java_class_path = "\"".$java_class_path."\"";
+
+    my $cmd = "| java -cp $java_class_path org.nzdl.gsdl.ApplyXSLT -t $xslt_file "; 
+
+    if (defined $self->{'mapping_file'} and $self->{'mapping_file'} ne ""){
+	my $mapping_file_path = "\"".$self->{'mapping_file'}."\""; 
+	$cmd .= "-m $mapping_file_path";
+    }
+
+    open(*XMLWRITER, $cmd)
+	or die "can't open pipe to xslt: $!";
+
+    
+    $self->{'xslt_writer'} = *XMLWRITER;
+
+    print XMLWRITER "<?DocStart?>\n";	    
+    print XMLWRITER "$output_file_name\n";
+
+ 
+  }
+  
+
+sub close_xslt_pipe
+{
+  my $self = shift @_;
+
+  
+  return unless defined $self->{'xslt_writer'} ;
+    
+  my $xsltwriter = $self->{'xslt_writer'};
+  
+  print $xsltwriter "<?DocEnd?>\n";
+  close($xsltwriter);
+
+  undef $self->{'xslt_writer'};
+
+}
+
+sub close_file_output
+{
+    my ($self) = @_;
+ 
+    # make sure that the handle has been opened - it won't be if we failed
+    # to import any documents...
+    if (defined(fileno(GROUPPROCESS))) {
+	$self->output_xml_footer('GROUPPROCESS','Archive');    
+	close GROUPPROCESS;
+    }
+
+    my $OID = $self->{'gs_OID'};
+    my $short_doc_file = $self->{'short_doc_file'};
+   
+    if ($self->{'gzip'}) {
+	my $doc_file = $self->{'gs_filename'};
+	`gzip $doc_file`;
+	$doc_file .= ".gz";
+	$short_doc_file .= ".gz";
+	if (!-e $doc_file) {
+	     my $outhandle = $self->{'output_handle'};
+	    print $outhandle "error while gzipping: $doc_file doesn't exist\n";
+	    return 0;
+	}
+    }
+
+    # store reference in output_info
+    my $output_info = $self->{'output_info'};
+    return 0 if (!defined $output_info);
+    $output_info->add_info($OID, $short_doc_file, undef, undef);
+    return 1;
+}
+
+
+#the subclass should implement this method if is_group method could return 1.
+sub close_group_output{
+   my $self = shift (@_);        
+}
+
+sub is_group {
+    my $self = shift (@_);
+    return 0;        
+}
+
+my $dc_set = { Title => 1,       
+	       Creator => 1, 
+	       Subject => 1, 
+	       Description => 1, 
+	       Publisher => 1, 
+	       Contributor => 1, 
+	       Date => 1, 
+	       Type => 1, 
+	       Format => 1, 
+	       Identifier => 1, 
+	       Source => 1, 
+	       Language => 1, 
+	       Relation => 1, 
+	       Coverage => 1, 
+	       Rights => 1};
+
+
+# returns an XML representation of the dublin core metadata
+# if dc meta is not found, try ex mete
+sub get_dc_metadata {
+    my $self = shift(@_);
+    my ($doc_obj, $section, $version) = @_;
+    
+    # build up string of dublin core metadata
+    $section="" unless defined $section;
+    
+    my $section_ptr = $doc_obj->_lookup_section($section);
+    return "" unless defined $section_ptr;
+
+
+    my $explicit_dc = {};
+    my $explicit_ex = {};
+
+    my $all_text="";
+    foreach my $data (@{$section_ptr->{'metadata'}}){
+	my $escaped_value = &docprint::escape_text($data->[1]);
+	if ($data->[0]=~ m/^dc\./) {
+	    $data->[0] =~ tr/[A-Z]/[a-z]/;
+
+	    $data->[0] =~ m/^dc\.(.*)/;
+	    my $dc_element =  $1;
+
+	    if (!defined $explicit_dc->{$dc_element}) {
+		$explicit_dc->{$dc_element} = [];
+	    }
+	    push(@{$explicit_dc->{$dc_element}},$escaped_value);
+
+	    if (defined $version && ($version eq "oai_dc")) {
+		$all_text .= "   <dc:$dc_element>$escaped_value</dc:$dc_element>\n";
+	    }
+	    else {
+		# qualifier???
+		$all_text .= '   <dcvalue element="'. $dc_element.'">'. $escaped_value. "</dcvalue>\n";
+	    }
+
+	} 
+	elsif (($data->[0] =~ m/^ex\./) || ($data->[0] !~ m/\./)) {
+	    $data->[0] =~ m/^(ex\.)?(.*)/;
+	    my $ex_element =  $2;
+	    my $lc_ex_element = lc($ex_element);
+
+	    if (defined $dc_set->{$ex_element}) {
+		if (!defined $explicit_ex->{$lc_ex_element}) {
+		    $explicit_ex->{$lc_ex_element} = [];
+		}
+		push(@{$explicit_ex->{$lc_ex_element}},$escaped_value);
+	    }
+	}
+    }
+
+    # go through dc_set and for any element *not* defined in explicit_dc
+    # that does exist in explicit_ex, add it in as metadata
+    foreach my $k ( keys %$dc_set ) {
+	my $lc_k = lc($k);
+
+	if (!defined $explicit_dc->{$lc_k}) {
+	    if (defined $explicit_ex->{$lc_k}) {
+
+		foreach my $v (@{$explicit_ex->{$lc_k}}) {
+		    my $dc_element    = $lc_k;
+		    my $escaped_value = $v;
+
+		    if (defined $version && ($version eq "oai_dc")) {
+			$all_text .= "   <dc:$dc_element>$escaped_value</dc:$dc_element>\n";
+		    }
+		    else {
+			$all_text .= '   <dcvalue element="'. $dc_element.'">'. $escaped_value. "</dcvalue>\n";
+		    }
+		    
+		}
+	    }
+	}
+    }
+
+    if ($all_text eq "") {
+	$all_text .= "   There is no Dublin Core metatdata in this document\n";
+    }	
+    $all_text =~ s/[\x00-\x09\x0B\x0C\x0E-\x1F]//g;
+
+    return $all_text;
+}
+
+# Build up dublin_core metadata.  Priority given to dc.* over ex.*
+# This method was apparently added by Jeffrey and committed by Shaoqun.
+# But we don't know why it was added, so not using it anymore.
+sub new_get_dc_metadata {
+    
+    my $self = shift(@_);
+    my ($doc_obj, $section, $version) = @_;
+
+    # build up string of dublin core metadata
+    $section="" unless defined $section;
+    
+    my $section_ptr=$doc_obj->_lookup_section($section);
+    return "" unless defined $section_ptr;
+
+    my $all_text = "";
+    foreach my $data (@{$section_ptr->{'metadata'}}){
+	my $escaped_value = &docprint::escape_text($data->[1]);
+	my $dc_element =  $data->[0];
+	
+	my @array = split('\.',$dc_element);
+	my ($type,$name);
+
+	if(defined $array[1])
+	{
+	    $type = $array[0];
+	    $name = $array[1];
+	}
+	else
+	{
+	    $type = "ex";
+	    $name = $array[0];
+	}
+	
+	$all_text .= '   <Metadata Type="'. $type.'" Name="'.$name.'">'. $escaped_value. "</Metadata>\n";
+    }
+    return $all_text;
+}
+
+
+1;
