Index: dl/trunk/perllib/plugins/ArcPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ArcPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,174 +1,0 @@
-###########################################################################
-#
-# ArcPlug.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) 1999 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.
-#
-###########################################################################
-
-# plugin which recurses through an archives.inf file
-# (i.e. the file generated in the archives directory
-# when an import is done), processing each file it finds 
-
-# 12-05-02 Added usage datastructure - John Thompson
-
-package ArcPlug;
-
-use util;
-use BasPlug;
-use plugin;
-use arcinfo;
-use gsprintf;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-BEGIN {
-    @ArcPlug::ISA = ('BasPlug');
-}
-
-my $arguments = [
-		 ];
-
-my $options = { 'name'     => "ArcPlug",
-		'desc'     => "{ArcPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes" };
-         
-sub gsprintf
-{
-    return &gsprintf::gsprintf(@_);
-}
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-sub deinit {
-    my ($self) = @_;
-
-    my $archive_info = $self->{'archive_info'};
-
-    if (defined $archive_info) {
-	my $archive_info_filename = $self->{'archive_info_filename'};
-
-       	my $file_list = $archive_info->get_file_list();
-
-	# change each file to "Been Indexed"
-
-	foreach my $subfile (@$file_list) {
-	    my $doc_oid = $subfile->[1];
-	    # why do we get this when it is not used???
-	    my $index_status = $archive_info->get_status_info($doc_oid);
-	    $archive_info->set_status_info($doc_oid,"B");
-	}
-
-	$archive_info->save_info($archive_info_filename);
-    }
-}
-
-# return 1 if this class might recurse using $pluginfo
-sub is_recursive {
-    my $self = shift (@_);
-
-    return 1;
-}
-
-
-
-
-# return number of files processed, undef if can't process
-# Note that $base_dir might be "" and that $file might 
-# include directories
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs,$total_count, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    my $count = 0;
-
-    # see if this has a archives information file within it
-    my $archive_info_filename = &util::filename_cat($base_dir,$file,"archives.inf");
-
-    if (-e $archive_info_filename) {
-
-	# found an archives.inf file
-	&gsprintf($outhandle, "ArcPlug: {common.processing} $archive_info_filename\n") if $self->{'verbosity'} > 1;
-
-	# read in the archives information file
-	my $archive_info = new arcinfo ();
-	$self->{'archive_info'} = $archive_info;
-	$self->{'archive_info_filename'} = $archive_info_filename;
-
-	$archive_info->load_info ($archive_info_filename);
-	
-	my $file_list = $archive_info->get_file_list();
-
-	# process each file
-	foreach my $subfile (@$file_list) {
-	    last if ($maxdocs != -1 && ($total_count + $count) >= $maxdocs);
-
-	    my $tmp = &util::filename_cat ($file, $subfile->[0]);
-	    next if $tmp eq $file;
-
-	    # Decide if file needs to be processed
-	    my $doc_oid = $subfile->[1];
-	    my $index_status = $archive_info->get_status_info($doc_oid);
-
-	    my $process_file = 0;
-	    
-	    if (!$processor->is_incremental_capable() || !$self->{'incremental'}) {
-		$process_file = 1;
-	    }
-	    else {
-	        # is incremental
-
-	        # check to see if file needs to be indexed
-		$index_status = $archive_info->get_status_info($doc_oid);
-
-		if ($index_status eq "I") {
-		    $process_file = 1;
-		}
-	    }
-
-	    if ($process_file) {
-		# note: metadata is not carried on to the next level
-		$count += &plugin::read ($pluginfo, $base_dir, $tmp, {}, $processor, $maxdocs, ($total_count+$count), $gli);
-	    }
-
-	}
-
-	return $count;
-    }
-
-    # wasn't an archives directory, someone else will have to process it
-    return undef;
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/ArchivesInfPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ArchivesInfPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/ArchivesInfPlugin.pm	(revision 15865)
@@ -0,0 +1,174 @@
+###########################################################################
+#
+# ArcPlug.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) 1999 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.
+#
+###########################################################################
+
+# plugin which recurses through an archives.inf file
+# (i.e. the file generated in the archives directory
+# when an import is done), processing each file it finds 
+
+# 12-05-02 Added usage datastructure - John Thompson
+
+package ArcPlug;
+
+use util;
+use BasPlug;
+use plugin;
+use arcinfo;
+use gsprintf;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+BEGIN {
+    @ArcPlug::ISA = ('BasPlug');
+}
+
+my $arguments = [
+		 ];
+
+my $options = { 'name'     => "ArcPlug",
+		'desc'     => "{ArcPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes" };
+         
+sub gsprintf
+{
+    return &gsprintf::gsprintf(@_);
+}
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+sub deinit {
+    my ($self) = @_;
+
+    my $archive_info = $self->{'archive_info'};
+
+    if (defined $archive_info) {
+	my $archive_info_filename = $self->{'archive_info_filename'};
+
+       	my $file_list = $archive_info->get_file_list();
+
+	# change each file to "Been Indexed"
+
+	foreach my $subfile (@$file_list) {
+	    my $doc_oid = $subfile->[1];
+	    # why do we get this when it is not used???
+	    my $index_status = $archive_info->get_status_info($doc_oid);
+	    $archive_info->set_status_info($doc_oid,"B");
+	}
+
+	$archive_info->save_info($archive_info_filename);
+    }
+}
+
+# return 1 if this class might recurse using $pluginfo
+sub is_recursive {
+    my $self = shift (@_);
+
+    return 1;
+}
+
+
+
+
+# return number of files processed, undef if can't process
+# Note that $base_dir might be "" and that $file might 
+# include directories
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs,$total_count, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    my $count = 0;
+
+    # see if this has a archives information file within it
+    my $archive_info_filename = &util::filename_cat($base_dir,$file,"archives.inf");
+
+    if (-e $archive_info_filename) {
+
+	# found an archives.inf file
+	&gsprintf($outhandle, "ArcPlug: {common.processing} $archive_info_filename\n") if $self->{'verbosity'} > 1;
+
+	# read in the archives information file
+	my $archive_info = new arcinfo ();
+	$self->{'archive_info'} = $archive_info;
+	$self->{'archive_info_filename'} = $archive_info_filename;
+
+	$archive_info->load_info ($archive_info_filename);
+	
+	my $file_list = $archive_info->get_file_list();
+
+	# process each file
+	foreach my $subfile (@$file_list) {
+	    last if ($maxdocs != -1 && ($total_count + $count) >= $maxdocs);
+
+	    my $tmp = &util::filename_cat ($file, $subfile->[0]);
+	    next if $tmp eq $file;
+
+	    # Decide if file needs to be processed
+	    my $doc_oid = $subfile->[1];
+	    my $index_status = $archive_info->get_status_info($doc_oid);
+
+	    my $process_file = 0;
+	    
+	    if (!$processor->is_incremental_capable() || !$self->{'incremental'}) {
+		$process_file = 1;
+	    }
+	    else {
+	        # is incremental
+
+	        # check to see if file needs to be indexed
+		$index_status = $archive_info->get_status_info($doc_oid);
+
+		if ($index_status eq "I") {
+		    $process_file = 1;
+		}
+	    }
+
+	    if ($process_file) {
+		# note: metadata is not carried on to the next level
+		$count += &plugin::read ($pluginfo, $base_dir, $tmp, {}, $processor, $maxdocs, ($total_count+$count), $gli);
+	    }
+
+	}
+
+	return $count;
+    }
+
+    # wasn't an archives directory, someone else will have to process it
+    return undef;
+}
+
+1;
Index: dl/trunk/perllib/plugins/BasPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/BasPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,1720 +1,0 @@
-###########################################################################
-#
-# BasPlug.pm -- base class for all the import plugins
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999-2005 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 BasPlug;
-
-BEGIN {
-    die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
-}
-
-eval {require bytes};
-
-# suppress the annoying "subroutine redefined" warning that various
-# plugins cause under perl 5.6
-$SIG{__WARN__} = sub {warn($_[0]) unless ($_[0] =~ /Subroutine\s+\S+\sredefined/)};
-
-use strict; 
-no strict 'subs';
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-use File::Basename;
-
-use Kea;
-use multiread;
-use encodings;
-use unicode;
-use cnseg;
-use acronym;
-use textcat;
-use doc;
-eval "require diagnostics"; # some perl distros (eg mac) don't have this
-use DateExtract;
-use ghtml;
-use gsprintf 'gsprintf';
-use printusage;
-use parse2;
-
-
-use GISBasPlug;
-
-@BasPlug::ISA = ( GISBasPlug );
-
-my $unicode_list =
-    [ { 'name' => "ascii",
-	'desc' => "{BasPlug.input_encoding.ascii}" },
-      { 'name' => "utf8",
-	'desc' => "{BasPlug.input_encoding.utf8}" },
-      { 'name' => "unicode",
-	'desc' => "{BasPlug.input_encoding.unicode}" } ];
-
-my $auto_unicode_list = 
-    [ { 'name' => "auto",
-	'desc' => "{BasPlug.input_encoding.auto}" } ];
-
-my $e = $encodings::encodings;
-foreach my $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) 
-{
-    my $hashEncode =
-    {'name' => $enc,
-     'desc' => $e->{$enc}->{'name'}};
-    
-    push(@{$unicode_list},$hashEncode);
-}
-
-push(@{$auto_unicode_list},@{$unicode_list});
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' => "",
-	'reqd' => "no" },
-      { 'name' => "block_exp",
-	'desc' => "{BasPlug.block_exp}",
-	'type' => "regexp",
-	'deft' => "",
-	'reqd' => "no" },
-      { 'name' => "smart_block",
-	'desc' => "{BasPlug.smart_block}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "associate_ext",
-	'desc' => "{BasPlug.associate_ext}",
-	'type' => "string",
-	'reqd' => "no" },
-      { 'name' => "associate_tail_re",
-	'desc' => "{BasPlug.associate_tail_re}",
-	'type' => "string",
-	'reqd' => "no" },
-      { 'name' => "use_as_doc_identifier",
-	'desc' => "{BasPlug.use_as_doc_identifier}",
-	'type' => "string",
-	'reqd' => "no" ,
-	'deft' => "" } ,
-      { 'name' => "input_encoding",
-	'desc' => "{BasPlug.input_encoding}",
-	'type' => "enum",
-	'list' => $auto_unicode_list,
-	'reqd' => "no" ,
-	'deft' => "auto" } ,
-      { 'name' => "default_encoding",
-	'desc' => "{BasPlug.default_encoding}",
-	'type' => "enum",
-	'list' => $unicode_list,
-	'reqd' => "no",
-        'deft' => "utf8" },
-      { 'name' => "extract_language",
-	'desc' => "{BasPlug.extract_language}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "default_language",
-	'desc' => "{BasPlug.default_language}",
-	'type' => "string",
-	'deft' => "en",
-	'reqd' => "no" },
-      { 'name' => "extract_acronyms",
-	'desc' => "{BasPlug.extract_acronyms}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "markup_acronyms",
-	'desc' => "{BasPlug.markup_acronyms}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "extract_keyphrases",
-	'desc' => "{BasPlug.extract_keyphrases}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "extract_keyphrases_kea4",
-	'desc' => "{BasPlug.extract_keyphrases_kea4}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "extract_keyphrase_options",
-	'desc' => "{BasPlug.extract_keyphrase_options}",
-	'type' => "string",
-	'deft' => "",
-	'reqd' => "no" },
-      { 'name' => "first",
-	'desc' => "{BasPlug.first}",
-	'type' => "string",
-	'reqd' => "no" },
-      { 'name' => "extract_email",
-	'desc' => "{BasPlug.extract_email}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "extract_historical_years",
-	'desc' => "{BasPlug.extract_historical_years}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "maximum_year",
-	'desc' => "{BasPlug.maximum_year}",
-	'type' => "int",
-	'deft' => (localtime)[5]+1900,
-	'char_length' => "4",
-	#'range' => "2,100",
-	'reqd' => "no"},
-      { 'name' => "maximum_century",
-	'desc' => "{BasPlug.maximum_century}",
-	'type' => "string",
-	'deft' => "-1",
-	'reqd' => "no" },
-      { 'name' => "no_bibliography",
-	'desc' => "{BasPlug.no_bibliography}",
-	'type' => "flag",
-	'reqd' => "no"},
-      { 'name' => "no_cover_image",
-	'desc' => "{BasPlug.no_cover_image}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "separate_cjk",
-	'desc' => "{BasPlug.separate_cjk}",
-	'type' => "flag",
-	'reqd' => "no",
-	'hiddengli' => "yes" },
-      { 'name' => "new_extract_email",
-	'desc' => "",
-	'type' => "flag",
-	'reqd' => "no",
-	'hiddengli' => "yes" } ];
-
-my $gis_arguments = 
-    [ { 'name' => "extract_placenames",
-	'desc' => "{GISBasPlug.extract_placenames}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "gazetteer",
-	'desc' => "{GISBasPlug.gazetteer}",
-	'type' => "string",
-	'reqd' => "no" },
-      { 'name' => "place_list",
-	'desc' => "{GISBasPlug.place_list}",
-	'type' => "flag",
-	'reqd' => "no" } ];
-
-
-my $options = { 'name'     => "BasPlug",
-		'desc'     => "{BasPlug.desc}",
-		'abstract' => "yes",
-		'inherits' => "no",
-		'args'     => $arguments };
-
-
-sub set_incremental {
-    my $self = shift(@_);
-    my ($incremental) = @_;
-
-    $self->{'incremental'} = $incremental;
-}
-
-sub get_arguments
-{
-    my $self = shift(@_);
-    my $optionlistref = $self->{'option_list'};
-    my @optionlist = @$optionlistref;
-    my $pluginoptions = pop(@$optionlistref);
-    my $pluginarguments = $pluginoptions->{'args'};
-    return $pluginarguments;
-}
-
-
-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("plugin");
-    }
-    $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 $pluginoptions = shift(@$optionlistref);
-    return if (!defined($pluginoptions));
-
-    # Find the process and block default expressions in the plugin arguments
-    my $process_exp = "";
-    my $block_exp = "";
-    if (defined($pluginoptions->{'args'})) {
-	foreach my $option (@{$pluginoptions->{'args'}}) {
-	    if ($option->{'name'} eq "process_exp") {
-		$process_exp = $option->{'deft'};
-	    }
-	    if ($option->{'name'} eq "block_exp") {
-		$block_exp = $option->{'deft'};
-	    }
-	}
-    }
-
-    gsprintf(STDERR, "<PlugInfo>\n");
-    gsprintf(STDERR, "  <Name>$pluginoptions->{'name'}</Name>\n");
-    my $desc = gsprintf::lookup_string($pluginoptions->{'desc'});
-    $desc =~ s/</&amp;lt;/g; # doubly escaped
-    $desc =~ s/>/&amp;gt;/g;
-    gsprintf(STDERR, "  <Desc>$desc</Desc>\n");
-    gsprintf(STDERR, "  <Abstract>$pluginoptions->{'abstract'}</Abstract>\n");
-    gsprintf(STDERR, "  <Inherits>$pluginoptions->{'inherits'}</Inherits>\n");
-    gsprintf(STDERR, "  <Processes>$process_exp</Processes>\n");
-    gsprintf(STDERR, "  <Blocks>$block_exp</Blocks>\n");
-    gsprintf(STDERR, "  <Explodes>" . ($pluginoptions->{'explodes'} || "no") . "</Explodes>\n");
-    # adding new option that works with replace_srcdoc_with_html.pl
-    gsprintf(STDERR, "  <SourceReplaceable>" . ($pluginoptions->{'srcreplaceable'} || "no") . "</SourceReplaceable>\n");
-    unless (defined($high_level_information_only)) {
-	gsprintf(STDERR, "  <Arguments>\n");
-	if (defined($pluginoptions->{'args'})) {
-	    &PrintUsage::print_options_xml($pluginoptions->{'args'});
-	}
-	gsprintf(STDERR, "  </Arguments>\n");
-
-	# Recurse up the plugin hierarchy
-	$self->print_xml();
-    }
-    gsprintf(STDERR, "</PlugInfo>\n");
-}
-
-
-sub print_txt_usage
-{
-    my $self = shift(@_);
-    # Print the usage message for a plugin (recursively)
-    my $descoffset = $self->determine_description_offset(0);
-    $self->print_plugin_usage($descoffset, 1);
-}
-
-
-sub determine_description_offset
-{
-    my $self = shift(@_);
-    my $maxoffset = shift(@_);
-
-    my $optionlistref = $self->{'option_list'};
-    my @optionlist = @$optionlistref;
-    my $pluginoptions = shift(@$optionlistref);
-    return $maxoffset if (!defined($pluginoptions));
-
-    # Find the length of the longest option string of this plugin
-    my $pluginargs = $pluginoptions->{'args'};
-    if (defined($pluginargs)) {
-	my $longest = &PrintUsage::find_longest_option_string($pluginargs);
-	if ($longest > $maxoffset) {
-	    $maxoffset = $longest;
-	}
-    }
-
-    # Recurse up the plugin hierarchy
-    $maxoffset = $self->determine_description_offset($maxoffset);
-    $self->{'option_list'} = \@optionlist;
-    return $maxoffset;
-}
-
-
-sub print_plugin_usage
-{
-    my $self = shift(@_);
-    my $descoffset = shift(@_);
-    my $isleafclass = shift(@_);
-
-    my $optionlistref = $self->{'option_list'};
-    my @optionlist = @$optionlistref;
-    my $pluginoptions = shift(@$optionlistref);
-    return if (!defined($pluginoptions));
-
-    my $pluginname = $pluginoptions->{'name'};
-    my $pluginargs = $pluginoptions->{'args'};
-    my $plugindesc = $pluginoptions->{'desc'};
-
-    # Produce the usage information using the data structure above
-    if ($isleafclass) {
-	if (defined($plugindesc)) {
-	    gsprintf(STDERR, "$plugindesc\n\n");
-	}
-	gsprintf(STDERR, " {common.usage}: plugin $pluginname [{common.options}]\n\n");
-    }
-
-    # Display the plugin options, if there are some
-    if (defined($pluginargs)) {
-	# 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", $pluginname);
-	}
-
-	# Display the plugin options
-	&PrintUsage::print_options_txt($pluginargs, $optiondescoffset);
-    }
-
-    # Recurse up the plugin hierarchy
-    $self->print_plugin_usage($descoffset, 0);
-    $self->{'option_list'} = \@optionlist;
-}
-
-
-sub new {
-    # Set Encodings to the list!!
-
-
-    # Start the BasPlug Constructor
-    my $class = shift (@_);
-    my ($pluginlist,$args,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-    my $plugin_name = (defined $pluginlist->[0]) ? $pluginlist->[0] : $class;
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    if (GISBasPlug::has_mapdata()) {
-	push(@$arguments,@$gis_arguments);
-    }
-    
-    my $self = {};
-    $self->{'outhandle'} = STDERR;
-    $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($strArg eq "-gsdlinfo")
-	{
-	    $self->{"info_only"} = 1;
-	    return bless $self, $class;
-	}
-    }
-
-    if(parse2::parse($args,$hashArgOptLists->{"ArgList"},$self) == -1)
-    {
-	my $classTempClass = bless $self, $class;
-	print STDERR "<BadPlugin p=$plugin_name>\n";
-	&gsprintf(STDERR, "\n{BasPlug.bad_general_option}\n", $plugin_name);
-	$classTempClass->print_txt_usage("");  # Use default resource bundle
-	die "\n";
-    }
-
-
-    delete $self->{"info_only"};
-    # else parsing was successful.
-
-    $self->{'plugin_type'} = $plugin_name;
-    #$self->{'outhandle'} = STDERR;
-    $self->{'num_processed'} = 0;
-    $self->{'num_not_processed'} = 0;
-    $self->{'num_blocked'} = 0;
-    $self->{'num_archives'} = 0;
-    $self->{'cover_image'} = 1; # cover image is on by default
-    $self->{'cover_image'} = 0 if ($self->{'no_cover_image'});
-    #$self->{'option_list'} = $hashArgOptLists->{"OptList"};
-    
-    my $associate_ext = $self->{'associate_ext'};
-    if ((defined $associate_ext) && ($associate_ext ne "")) {
-
-	my $associate_tail_re = $self->{'associate_tail_re'};
-	if ((defined $associate_tail_re) && ($associate_tail_re ne "")) {
-	    my $outhandle = $self->{'outhandle'};
-	    print $outhandle "Warning: can only specify 'associate_ext' or 'associate_tail_re'\n";
-	    print $outhandle "         defaulting to 'associate_tail_re'\n";
-	}
-	else {
-	    my @exts = split(/,/,$associate_ext);
-
-	    my @exts_bracketed = map { $_ = "(?:\\.$_)" } @exts;
-	    my $associate_tail_re = join("|",@exts_bracketed);
-	    $self->{'associate_tail_re'} = $associate_tail_re;
-	}
-
-	delete $self->{'associate_ext'};
-    }
-
-    $self->{'shared_fileroot'} = {};
-    $self->{'file_blocks'} = {};
-
-    if ($self->{'extract_placenames'}) {
-
-	my $outhandle = $self->{'outhandle'};
-	
-	my $places_ref 
-	    = GISBasPlug::loadGISDatabase($outhandle,$self->{'gazetteer'});
-	
-	if (!defined $places_ref) {
-	    print $outhandle "Warning: Error loading mapdata gazetteer \"$self->{'gazetteer'}\"\n";
-	    print $outhandle "         No placename extraction will take place.\n";
-	    $self->{'extract_placenames'} = undef;
-	}
-	else {
-	    $self->{'places'} = $places_ref;
-	}
-    }
-
-    return bless $self, $class;
-    
-}
-
-# initialize BasPlug options
-# if init() is overridden in a sub-class, remember to call BasPlug::init()
-sub init {
-    my $self = shift (@_);
-    my ($verbosity, $outhandle, $failhandle) = @_;
-
-    # verbosity is passed through from the processor
-    $self->{'verbosity'} = $verbosity;
-
-    # as are the outhandle and failhandle
-    $self->{'outhandle'} = $outhandle if defined $outhandle;
-    $self->{'failhandle'} = $failhandle;
-
-    # set process_exp and block_exp to defaults unless they were
-    # explicitly set
-
-    if ((!$self->is_recursive()) and 
-	(!defined $self->{'process_exp'}) || ($self->{'process_exp'} eq "")) {
-
-	$self->{'process_exp'} = $self->get_default_process_exp ();
-	if ($self->{'process_exp'} eq "") {
-	    warn ref($self) . " Warning: Non-recursive plugin has no process_exp\n";
-	}
-    }
-
-    if ((!defined $self->{'block_exp'}) || ($self->{'block_exp'} eq "")) {
-	$self->{'block_exp'} = $self->get_default_block_exp ();
-    }
-
-}
-
-sub begin {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $processor, $maxdocs) = @_;
-
-   #my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(0);
-   #print STDERR "Calling method; $cfilename:$cline $cpackage->$csubr\n";
-
-    $self->initialise_extractors();
-}
-
-sub end {
-    # potentially called at the end of each plugin pass 
-    # import.pl only has one plugin pass, but buildcol.pl has multiple ones
-
-    my ($self) = @_;
-    $self->finalise_extractors();
-}
-
-sub deinit {
-    # called only once, after all plugin passes have been done
-
-    my ($self) = @_;
-}
-
-# this function should be overridden to return 1
-# in recursive plugins
-sub is_recursive {
-    my $self = shift (@_);
-
-    return 0; 
-}
-
-sub get_default_block_exp {
-    my $self = shift (@_);
-
-    return "";
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return "";
-}
-
-# default implementation is to do nothing. 
-sub store_block_files
-{
-    my $self =shift (@_);
-    my ($filename) = @_;
-    return;
-}
-
-#default implementation is to block a file with same name as this, but extension jpg or JPG, if cover_images is on.
-sub block_cover_image
-{
-    my $self =shift;
-    my $filename = shift;
-
-    if ($self->{'cover_image'}) {
-	my $coverfile = $filename;
-	$coverfile =~ s/\.[^\\\/\.]+$/\.jpg/;
-	if (!-e $coverfile) {
-	    $coverfile =~ s/jpg$/JPG/;
-	} 	
-	if (-e $coverfile) {
-	    $self->{'file_blocks'}->{$coverfile} = 1;
-	} 
-    }
-
-    return;
-}
-
-sub root_ext_split
-{
-    my $self = shift (@_);
-    my ($filename,$tail_re) = @_;
-    
-    my ($file_prefix,$file_ext) = ($filename =~ m/^(.*?)($tail_re)$/);
-
-    if ((!defined $file_prefix) || (!defined $file_ext)) {
-	($file_prefix,$file_ext) = ($filename =~ m/^(.*)(\..*?)$/);
-    }
-
-    return ($file_prefix,$file_ext);
-}
-
-sub metadata_read {
-    my $self = shift (@_);  
-    my ($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli) = @_;
-    # Keep track of filenames with same root but different extensions
-    # Used to support -associate_ext and the more generalised
-    # -associate_tail_re
-
-    my $associate_tail_re = $self->{'associate_tail_re'};
-    if ((defined $associate_tail_re) && ($associate_tail_re ne "")) {
-
-	my ($file_prefix,$file_ext) 
-	    = $self->root_ext_split($file,$associate_tail_re);
-
-	if ((defined $file_prefix) && (defined $file_ext)) {
-
-	    my $shared_fileroot = $self->{'shared_fileroot'};
-	    if (!defined $shared_fileroot->{$file_prefix}) {
-		my $file_prefix_rec = { 'tie_to'  => undef, 
-				        'exts'    => {} };
-		$shared_fileroot->{$file_prefix} = $file_prefix_rec;
-	    }
-	    
-	    my $file_prefix_rec = $shared_fileroot->{$file_prefix};
-
-	    my $process_exp = $self->{'process_exp'};
-
-	    if ($file =~ m/$process_exp/) {
-		# This is the document the others should be tied to
-		$file_prefix_rec->{'tie_to'} = $file_ext;
-	    }
-	    else {
-		if ($file_ext =~ m/$associate_tail_re$/) {
-		    $file_prefix_rec->{'exts'}->{$file_ext} = 1;
-		}
-	    }
-
-	}
-    }
-
-    # now check whether we are actually processing this
-    my $filename = $file;
-    $filename = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
-    if ($self->{'process_exp'} eq "" || $filename !~ /$self->{'process_exp'}/ || !-f $filename) {
-	return undef; # can't recognise
-    }
-
-    # do smart blocking if appropriate
-    if ($self->{'smart_block'}) {
-	$self->store_block_files($filename);
-    }
-    # block the cover image if there is one
-    if ($self->{'cover_image'}) {
-	$self->block_cover_image($filename);
-    }
-       
-    return 1;
-}
-
-sub tie_to_filename
-{
-    my $self = shift (@_);  
-  
-    my ($file_ext,$file_prefix_rec) = @_;
-
-    if (defined $file_prefix_rec) {
-	my $tie_to = $file_prefix_rec->{'tie_to'};
-
-	if (defined $tie_to) {
-	    if ($tie_to eq $file_ext) {
-		return 1;
-	    }
-	}
-    }
-
-    return 0;
-}
-
-sub tie_to_assoc_file
-{
-    my $self = shift (@_);    
-    my ($file_ext,$file_prefix_rec) = @_;
-
-    if (defined $file_prefix_rec) {
-	my $tie_to = $file_prefix_rec->{'tie_to'};
-	if (defined $tie_to) {
-
-	    my $exts = $file_prefix_rec->{'exts'};
-
-	    my $has_file_ext = $exts->{$file_ext};
-
-	    if ($has_file_ext) {
-		return 1;
-	    }
-	}
-    }
-
-    return 0;
-}
-
-
-sub associate_with
-{
-    my $self = shift (@_);    
-    my ($file, $filename, $metadata) = @_;
-
-    my $associate_tail_re = $self->{'associate_tail_re'};
-    return 0 if (!$associate_tail_re);
-
-    # If file, see if matches with "tie_to" doc or is one of the
-    # associated filename extensions.
-
-    my ($file_prefix,$file_ext) = $self->root_ext_split($file,$associate_tail_re);
-
-    if ((defined $file_prefix) && (defined $file_ext)) {
-
-	my $file_prefix_rec = $self->{'shared_fileroot'}->{$file_prefix};
-	
-	if ($self->tie_to_filename($file_ext,$file_prefix_rec)) {
-
-	    # Set up gsdlassocfile_tobe
-
-	    my $exts = $file_prefix_rec->{'exts'};
-		
-	    if (!defined $metadata->{'gsdlassocfile_tobe'}) {
-		$metadata->{'gsdlassocfile_tobe'} = [];
-	    }
-
-	    my $assoc_tobe = $metadata->{'gsdlassocfile_tobe'};
-			
-	    my ($full_prefix) = ($filename =~ m/^(.*)\..*?$/);
-	    foreach my $e (keys %$exts) {		
-		my $assoc_file = "$full_prefix$e";
-		print STDERR "  $self->{'plugin_type'}: Associating $file_prefix$e with $file_prefix_rec->{'tie_to'} version\n";
-		my $mime_type = ""; # let system auto detect this
-		push(@$assoc_tobe,"$assoc_file:$mime_type:"); 
-	    }
-
-	}
-	elsif ($self->tie_to_assoc_file($file_ext,$file_prefix_rec)) {
-
-
-	    # a form of smart block	    
-	    return 1;
-	}
-    }
-
-    return 0;
-}
-
-
-sub read_block {
-    my $self = shift (@_);  
-  
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-
-    my $filename = $file;
-    $filename = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
-
-    if ($self->associate_with($file,$filename,$metadata)) {
-	# a form of smart block
-	$self->{'num_blocked'} ++;
-	return (0,undef); # blocked
-    }
-
-    my $smart_block = $self->{'smart_block'};
-    my $smart_block_BN = $self->{'smart_block_BN'};
-   
-    if ($smart_block || $smart_block_BN) {
-	if (defined $self->{'file_blocks'}->{$filename} && $self->{'file_blocks'}->{$filename} == 1){
-	    $self->{'num_blocked'} ++;
-	    return (0,undef); # blocked
-	}
-    } else {
-	if ($self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/) {
-	    $self->{'num_blocked'} ++;
-	    return (0,undef); # blocked
-	}
-	if ($self->{'cover_image'}) {
-	    if (defined $self->{'file_blocks'}->{$filename} && $self->{'file_blocks'}->{$filename} == 1){
-		$self->{'num_blocked'} ++;
-		return (0,undef); # blocked
-	    }
-	}
-    }
-
-    if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
-	return (undef,undef); # can't recognise
-    }
-    
-    return (1,$filename);
-}
-
-sub read_tidy_file {
-
-    my $self = shift (@_);  
-  
-    my ($file) = @_;
-
-    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
-
-    return $file;
-}
-
-
-sub filename_to_metadata
-{
-    my $self = shift (@_);  
-    my ($file, $encoding) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-
-    my $filesystem_encoding = undef;
-
-    eval {
-	use POSIX qw(locale_h);
-
-	# With only one parameter, setlocale retrieves the current value
-	my $current_locale = setlocale(LC_CTYPE);
-
-	if ($current_locale =~ m/^.*\.(.*?)$/) {
-	    my $char_encoding = lc($1);
-	    if ($char_encoding =~ m/^(iso)(8859)(\d{1,2})$/) {
-		$char_encoding = "$1\_$2\_$3";
-	    }
-
-	    $char_encoding =~ s/-/_/g;
-	    $char_encoding =~ s/^utf_8$/utf8/;
-
-	    if ($char_encoding =~ m/^\d+$/) {
-		if (defined $encodings::encodings->{"windows_$char_encoding"}) {
-		    $char_encoding = "windows_$char_encoding";
-		}
-		elsif (defined $encodings::encodings->{"dos_$char_encoding"}) {
-		    $char_encoding = "dos_$char_encoding";
-		}
-	    }
-
-	    if (($char_encoding =~ m/(?:ascii|utf8|unicode)/) 
-		|| (defined $encodings::encodings->{$char_encoding})) {
-		$filesystem_encoding = $char_encoding;
-	    }
-	    else {
-		print $outhandle "Warning: Unsupported character encoding '$char_encoding' from locale '$current_locale'\n";
-	    }
-	}
-
-
-    };
-    if ($@) {
-	print $outhandle "$@\n";
-	print $outhandle "Warning: Unable to establish locale.  Will assume filesytem is UTF-8\n";
-	
-    }
-    
-    my ($filemeta) = $file =~ /([^\\\/]+)$/; # getting the tail of the filepath (skips all string parts containing slashes upto the end)
-    
-    # how do we know what encoding the filename is in?
-    # => one answer is to check the locale
-
-    if (defined $filesystem_encoding) {
-	if ($filesystem_encoding !~ /(?:ascii|utf8|unicode)/) {
-	    $filemeta = unicode::unicode2utf8(
-		    unicode::convert2unicode($filesystem_encoding, \$filemeta)
-	          );
-	}
-    }
-    # assume it is in the same encoding as its contents
-    elsif ((defined $encoding) && ($encoding !~ /(?:ascii|utf8|unicode)/)) {
-	$filemeta = unicode::unicode2utf8(
-		unicode::convert2unicode($encoding, \$filemeta)
-	);
-    }
-    
-    my $dmsafe_filemeta = &ghtml::dmsafe($filemeta);
-
-    return $dmsafe_filemeta;
-}
-
-
-sub add_OID
-{
-    my $self = shift (@_);  
-    my ($doc_obj) = @_;
-
-    # See if a metadata field is specified as the field
-    if ((defined $self->{'use_as_doc_identifier'}) && ($self->{'use_as_doc_identifier'} ne "")) {
-	my $metadata_doc_id = $self->{'use_as_doc_identifier'};
-
-	# Consider "tidying" up metadata_doc_id to be something
-	# suitable in a URL
-	# Could even support a user specified plugin RE for this.
-
-	my $top_section = $doc_obj->get_top_section();
-	my $oid = $doc_obj->get_metadata_element($top_section,$metadata_doc_id);
-##	print STDERR "**** oid = $oid\n";
-    	$doc_obj->set_OID($oid);
-    }
-    # See if there is a plugin-specific set_OID function...
-    elsif (defined ($self->can('set_OID'))) {
-	# it will need $doc_obj to set the Identifier metadata...
-	$self->set_OID(@_); # pass through any extra arguments supplied
-    } else {
-	# use the default set_OID() in doc.pm
-	$doc_obj->set_OID();
-    }
-}
-
-# The BasPlug read_into_doc_obj() function. This function does all the
-# right things to make general options work for a given plugin.  It reads in
-# a file and sets up a slew of metadata all saved in doc_obj, which
-# it then returns as part of a tuple (process_status,doc_obj)
-#
-# Much of this functionality used to reside in read, but it was broken
-# down into a supporting routine to make the code more flexible.  
-#
-# recursive plugins (e.g. RecPlug) and specialized plugins like those
-# capable of processing many documents within a single file (e.g.
-# GMLPlug) will normally want to implement their own version of
-# read_into_doc_obj()
-#
-# Note that $base_dir might be "" and that $file might 
-# include directories
-sub read_into_doc_obj {
-    my $self = shift (@_);  
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    if ($self->is_recursive()) {
-	gsprintf(STDERR, "{BasPlug.read_must_be_implemented}") && die "\n";
-    }
-
-    my $outhandle   = $self->{'outhandle'};
-
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-    $file = $self->read_tidy_file($file);
-
-    # Do encoding stuff
-    my ($language, $encoding) = $self->textcat_get_language_encoding ($filename);
-    if ($self->{'verbosity'} > 2) {
-	print $outhandle "BasPlug: reading $file as ($encoding,$language)\n";
-    }
-
-    # create a new document
-    my $doc_obj = new doc ($filename, "indexed_doc");
-    my $top_section = $doc_obj->get_top_section();
-
-    $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
-    $doc_obj->add_utf8_metadata($top_section, "Language", $language);
-    $doc_obj->add_utf8_metadata($top_section, "Encoding", $encoding);
-    $doc_obj->add_utf8_metadata($top_section, "Plugin", "$self->{'plugin_type'}");
-    $doc_obj->add_utf8_metadata($top_section, "FileSize", (-s $filename));
-
-    my $filemeta = $self->filename_to_metadata($file,$encoding);
-    $doc_obj->add_utf8_metadata($top_section, "Source", $filemeta);
-    if ($self->{'cover_image'}) {
-	$self->associate_cover_image($doc_obj, $filename);
-    }
-    
-    # read in file ($text will be in utf8)
-    my $text = "";
-    $self->read_file ($filename, $encoding, $language, \$text);
-
-    if (!length ($text)) {
-	my $plugin_name = ref ($self);
-	if ($gli) {
-	    print STDERR "<ProcessingError n='$file' r='File contains no text'>\n";
-	}
-	gsprintf($outhandle, "$plugin_name: {BasPlug.file_has_no_text}\n", $filename) if $self->{'verbosity'};
-
-	my $failhandle = $self->{'failhandle'};
-	gsprintf($failhandle, "$file: " . ref($self) . ": {BasPlug.empty_file}\n");
-	# print $failhandle "$file: " . ref($self) . ": file contains no text\n";
-	$self->{'num_not_processed'} ++;
-
-	return (0,undef); # what should we return here?? error but don't want to pass it on
-    }
-   
-    # include any metadata passed in from previous plugins 
-    # note that this metadata is associated with the top level section
-
-    my $associate_tail_re = $self->{'associate_tail_re'};
-
-    $self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
-
-    # do plugin specific processing of doc_obj
-    unless (defined ($self->process (\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli))) {
-	$text = '';
-	undef $text;
-	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
-	return (-1,undef);
-    }
-    $text='';
-    undef $text;
-   
-    # do any automatic metadata extraction
-    $self->auto_extract_metadata ($doc_obj);
-
-    $self->add_OID($doc_obj);
-    
-    return (1,$doc_obj);
-}
-
-
-# The BasPlug read() function. This function calls read_into_doc_obj()
-# to ensure all the right things to make general options work for a
-# given plugin are done. It then calls the process() function which
-# does all the work specific to a plugin (like the old read functions
-# used to do). Most plugins should define their own process() function
-# and let this read() function keep control.  
-#
-# recursive plugins (e.g. RecPlug) and specialized plugins like those
-# capable of processing many documents within a single file (e.g.
-# GMLPlug) might want to implement their own version of read(), but
-# more likely need to implement their own version of read_into_doc_obj()
-#
-# Return number of files processed, undef if can't recognise, -1 if can't
-# process
-
-sub read {
-    my $self = shift (@_);  
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    my ($process_status,$doc_obj) = $self->read_into_doc_obj(@_);
-    
-    if ((defined $process_status) && ($process_status == 1)) {
-	# process the document
-	$processor->process($doc_obj);
-	
-	if(defined($self->{'places_filename'})){
-	    &util::rm($self->{'places_filename'});
-	    $self->{'places_filename'} = undef;
-	}
-	
-	$self->{'num_processed'} ++;
-	undef $doc_obj; 
-    }
-
-    # if process_status == 1, then the file has been processed.
-    return $process_status;
-
-}
-
-# returns undef if file is rejected by the plugin
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-
-    gsprintf(STDERR, "BasPlug::process {common.must_be_implemented}\n") && die "\n";
-    # die "Basplug::process function must be implemented in sub-class\n";
-
-    return undef; # never gets here
-}
-
-# uses the multiread package to read in the entire file pointed to
-# by filename and loads the resulting text into $$textref. Input text
-# may be in any of the encodings handled by multiread, output text
-# will be in utf8
-sub read_file {
-    my $self = shift (@_);
-    my ($filename, $encoding, $language, $textref) = @_;
-
-    if (!-r $filename)
-    {
-	my $outhandle = $self->{'outhandle'};
-	gsprintf($outhandle, "{BasPlug.read_denied}\n", $filename) if $self->{'verbosity'};
-	# print $outhandle "Read permission denied for $filename\n" if $self->{'verbosity'};
-	return;
-    }
-    $$textref = "";
-    if (!open (FILE, $filename)) {
-	gsprintf(STDERR, "BasPlug::read_file {BasPlug.could_not_open_for_reading} ($!)\n", $filename);
-	die "\n";
-    }
-     
-    if ($encoding eq "ascii") {
-	undef $/;
-	$$textref = <FILE>;
-	$/ = "\n";
-    } else {
-	my $reader = new multiread();
-	$reader->set_handle ('BasPlug::FILE');
-	$reader->set_encoding ($encoding);
-	$reader->read_file ($textref);
-        #Now segments chinese if the separate_cjk option is set
-	if ($self->{'separate_cjk'}) {
-	    # segment the Chinese words
-	    $$textref = &cnseg::segment($$textref);
-	}
-    }
-    close FILE;
-}
-
-# write_file -- used by ConvertToPlug, for example in post processing
-#
-sub utf8_write_file {
-    my $self = shift (@_);
-    my ($textref, $filename) = @_;
-    
-    if (!open (FILE, ">$filename")) {
-	gsprintf(STDERR, "ConvertToPlug::write_file {ConvertToPlug.could_not_open_for_writing} ($!)\n", $filename);
-	 die "\n";
-     }
-    print FILE $$textref;
-    
-    close FILE;
-}
-
-
-sub filename_based_title
-{
-    my $self = shift (@_);
-    my ($file) = @_;
-
-    my $file_derived_title = $file;
-    $file_derived_title =~ s/_/ /g;
-    $file_derived_title =~ s/\..*?$//;
-
-    return $file_derived_title;
-}
-
-
-sub title_fallback
-{
-    my $self = shift (@_);
-    my ($doc_obj,$section,$file) = @_;
-
-    if (!defined $doc_obj->get_metadata_element ($section, "Title")) {
-
-	my $file_derived_title = $self->filename_based_title($file);
-	
-	$doc_obj->add_utf8_metadata ($section, "Title", $self->filename_to_metadata($file_derived_title));
-    }
-}
-
-sub textcat_get_language_encoding {
-    my $self = shift (@_);
-    my ($filename) = @_;
-
-    
-    my ($language, $encoding, $extracted_encoding);
-    if ($self->{'input_encoding'} eq "auto") {
-        # use textcat to automatically work out the input encoding and language
-        ($language, $encoding) = $self->get_language_encoding ($filename);
-    } elsif ($self->{'extract_language'}) {
-        # use textcat to get language metadata
-        ($language, $extracted_encoding) = $self->get_language_encoding ($filename);
-        $encoding = $self->{'input_encoding'};
-	# don't print this message for english... english in utf8 is identical
-	# to english in iso-8859-1 (except for some punctuation). We don't have
-	# a language model for en_utf8, so textcat always says iso-8859-1!
-        if ($extracted_encoding ne $encoding && $language ne "en"
-	    && $self->{'verbosity'}) {
-	    my $plugin_name = ref ($self);
-	    my $outhandle = $self->{'outhandle'};
-	    gsprintf($outhandle, "$plugin_name: {BasPlug.wrong_encoding}\n", $filename, $encoding, $extracted_encoding);
-        }
-    } else {
-        $language = $self->{'default_language'};
-        $encoding = $self->{'input_encoding'};
-    }
-
-    return ($language, $encoding);
-}
-
-# Uses textcat to work out the encoding and language of the text in 
-# $filename. All html tags are removed before processing.
-# returns an array containing "language" and "encoding"
-sub get_language_encoding {
-    my $self = shift (@_);
-    my ($filename) = @_;
-    my $outhandle = $self->{'outhandle'};
-    my $unicode_format = "";
-    my $best_language = "";
-    my $best_encoding = "";
-    
-    # read in file
-    if (!open (FILE, $filename)) {
-	gsprintf(STDERR, "BasPlug::get_language_encoding {BasPlug.could_not_open_for_reading} ($!)\n", $filename);
-	# this is a pretty bad error, but try to continue anyway
-	return ($self->{'default_language'}, $self->{'input_encoding'});
-    }
-    undef $/;
-    my $text = <FILE>;
-    $/ = "\n";
-    close FILE;
-
-    # check if first few bytes have a Byte Order Marker
-    my $bom=substr($text,0,2); # check 16bit unicode
-    if ($bom eq "\xff\xfe") { # little endian 16bit unicode
-	$unicode_format="unicode";
-    } elsif ($bom eq "\xfe\xff") { # big endian 16bit unicode
-	$unicode_format="unicode";
-    } else {
-	$bom=substr($text,0,3); # check utf-8
-	if ($bom eq "\xef\xbb\xbf") { # utf-8 coded FEFF bom
-	    $unicode_format="utf8";
-#	} elsif ($bom eq "\xef\xbf\xbe") { # utf-8 coded FFFE bom. Error!?
-#	    $unicode_format="utf8";
-	}
-    }
-    
-
-    # handle html files specially
-    # XXX this doesn't match plugins derived from HTMLPlug (except ConvertTo)
-    if (ref($self) eq 'HTMLPlug' ||
-	(exists $self->{'converted_to'} && $self->{'converted_to'} eq 'HTML')){
-
-	# remove <title>stuff</title> -- as titles tend often to be in English
-	# for foreign language documents
-	$text =~ s!<title>.*?</title>!!si;
-
-	# see if this html file specifies its encoding
-	if ($text =~ /^<\?xml.*encoding="(.+?)"/) {
-	    $best_encoding = $1;
-	} elsif ($text =~ /<meta http-equiv.*content-type.*charset=(.+?)"/i) {#"
-	    $best_encoding = $1;
-	}
-	if ($best_encoding) { # we extracted an encoding
-	    $best_encoding =~ s/-+/_/g;
-	    $best_encoding = lc($best_encoding); # lowercase
-	    if ($best_encoding eq "utf_8") { $best_encoding = "utf8" }
-	    $self->{'input_encoding'} = $best_encoding;
-	}
-        
-	# remove all HTML tags
-	$text =~ s/<[^>]*>//sg;
-    }
-
-    # get the language/encoding
-    $self->{'textcat'} = new textcat() if (!defined($self->{'textcat'}));
-    my $results = $self->{'textcat'}->classify(\$text);
-
-    # if textcat returns 3 or less possibilities we'll use the 
-    # first one in the list - otherwise use the defaults
-    if (scalar @$results > 3) {
-	if ($unicode_format) { # in case the first had a BOM
-	    $best_encoding=$unicode_format;
-	} else {
-	    my %guessed_encodings = ();
-	    foreach my $result (@$results) {
-		$result =~ /([^\-]+)$/;
-		my $enc=$1;
-		if (!defined($guessed_encodings{$enc})) {
-		    $guessed_encodings{$enc}=0;
-		}
-		$guessed_encodings{$enc}++;
-	    }
-
-	    $guessed_encodings{""}=-1; # for default best_encoding of ""
-	    foreach my $enc (keys %guessed_encodings) {
-		if ($guessed_encodings{$enc} >
-		    $guessed_encodings{$best_encoding}){
-		    $best_encoding=$enc;
-		}
-	    }
-	}
-
-	if ($self->{'input_encoding'} ne 'auto') {
-	    if ($self->{'extract_language'} && ($self->{'verbosity'}>2)) {
-		gsprintf($outhandle,
-			 "BasPlug: {BasPlug.could_not_extract_language}\n",
-			 $filename, $self->{'default_language'});
-	    }		
-	    $best_language = $self->{'default_language'};
-	    $best_encoding = $self->{'input_encoding'};
-
-	} else {
-	    if ($self->{'verbosity'}>2) {
-		gsprintf($outhandle,
-			 "BasPlug: {BasPlug.could_not_extract_language}\n",
-			 $filename, $self->{'default_language'});
-	    }
-	    $best_language = $self->{'default_language'};
-	}
-    } else { # <= 3 suggestions
-	my ($language, $encoding) = $results->[0] =~ /^([^-]*)(?:-(.*))?$/;
-	if (!defined $language) {
-	    if ($self->{'verbosity'}>2) {
-		gsprintf($outhandle,
-		    "BasPlug: {BasPlug.could_not_extract_language}\n",
-		    $filename, $self->{'default_language'});
-	    }
-	    $language = $self->{'default_language'};
-	}
-	if (!defined $encoding) {
-	    if ($self->{'verbosity'}>2) {
-		gsprintf($outhandle,
-		    "BasPlug: {BasPlug.could_not_extract_encoding}\n",
-		    $filename, $self->{'default_encoding'});
-	    }
-	    $encoding = $self->{'default_encoding'};
-	}
-	$best_language = $language;
-	if (! $best_encoding ) { # may already be set... eg from html meta tag
-	    $best_encoding = $encoding;
-	}
-    }
-
-    my $text_copy = $text;
-    if ($best_encoding =~ /^iso_8859/ && unicode::ensure_utf8(\$text_copy)==0) {
-	# the text is valid utf8, so assume that's the real encoding
-	# (since textcat is based on probabilities)
-	$best_encoding = 'utf8';
-    }
-
-    # check for equivalents where textcat doesn't have some encodings...
-    # eg MS versions of standard encodings
-    if ($best_encoding =~ /^iso_8859_(\d+)/) {
-	my $iso = $1; # which variant of the iso standard?
-	# iso-8859 sets don't use chars 0x80-0x9f, windows codepages do
-	if ($text =~ /[\x80-\x9f]/) {
-	    # Western Europe
-	    if ($iso == 1 or $iso == 15) { $best_encoding = 'windows_1252' }
-	    elsif ($iso == 2) {$best_encoding = 'windows_1250'} # Central Europe
-	    elsif ($iso == 5) {$best_encoding = 'windows_1251'} # Cyrillic
-	    elsif ($iso == 6) {$best_encoding = 'windows_1256'} # Arabic
-	    elsif ($iso == 7) {$best_encoding = 'windows_1253'} # Greek
-	    elsif ($iso == 8) {$best_encoding = 'windows_1255'} # Hebrew
-	    elsif ($iso == 9) {$best_encoding = 'windows_1254'} # Turkish
-	}
-    }
-
-    if ($best_encoding !~ /^(ascii|utf8|unicode)$/ &&
-	!defined $encodings::encodings->{$best_encoding}) {
-	if ($self->{'verbosity'}) {
-	    gsprintf($outhandle, "BasPlug: {BasPlug.unsupported_encoding}\n",
-		     $filename, $best_encoding, $self->{'default_encoding'});
-	}
-	$best_encoding = $self->{'default_encoding'};
-    }
-
-    return ($best_language, $best_encoding);
-}
-
-# add any extra metadata that's been passed around from one
-# plugin to another.
-# extra_metadata uses add_utf8_metadata so it expects metadata values
-# to already be in utf8
-sub extra_metadata {
-    my $self = shift (@_);
-    my ($doc_obj, $cursection, $metadata) = @_;
-
-    my $associate_tail_re = $self->{'associate_tail_re'};
-
-    foreach my $field (keys(%$metadata)) {
-	# $metadata->{$field} may be an array reference
-	if ($field eq "gsdlassocfile_tobe") {
-	    # 'gsdlassocfile_tobe' is artificially introduced metadata
-	    # that is used to signal that certain additional files should
-	    # be tied to this document.  Useful in situations where a
-	    # metadata pass in the plugin pipeline works out some files
-	    # need to be associated with a document, but the document hasn't
-	    # been formed yet.
-	    
-	    my $equiv_form = "";
-	    foreach my $gaf (@{$metadata->{$field}}) {
-		my ($full_filename,$mimetype) = ($gaf =~ m/^(.*):(.*):$/);
-		my ($tail_filename) = ($full_filename =~ /^.*[\/\\](.+?)$/);
-		my $filename = $full_filename;
-			      
-		$doc_obj->associate_file($full_filename,$tail_filename,$mimetype);
-
-		# work out extended tail extension (i.e. matching tail re)
-
-		my ($file_prefix,$file_extended_ext) 
-		    = $self->root_ext_split($tail_filename,$associate_tail_re);
-		my ($pre_doc_ext) = ($file_extended_ext =~ m/^(.*)\..*$/);
-
-		my ($doc_ext) = ($tail_filename =~ m/^.*\.(.*)$/);
-		my $start_doclink = "<a href=\"_httpprefix_/collect/[collection]/index/assoc/{Or}{[parent(Top):archivedir],[archivedir]}/$tail_filename\">";
-		my $srcicon = "_icon".$doc_ext."_";
-		my $end_doclink = "</a>";
-
-		my $assoc_form = "$start_doclink\{If\}{$srcicon,$srcicon,$doc_ext\}$end_doclink";
-
-		if (defined $pre_doc_ext) {
-		    # for metadata such as [mp3._edited] [mp3._full] ...
-		    $doc_obj->add_utf8_metadata ($cursection, "$doc_ext.$pre_doc_ext", $assoc_form); 
-		}
-
-		# for multiple metadata such as [mp3.assoclink]
-		$doc_obj->add_utf8_metadata ($cursection, "$doc_ext.assoclink", $assoc_form); 
-		
-		$equiv_form .= " $assoc_form";	
-	    }
-	    $doc_obj->add_utf8_metadata ($cursection, "equivlink", $equiv_form); 
-	}
-	elsif (ref ($metadata->{$field}) eq "ARRAY") {
-	    map { 
-		$doc_obj->add_utf8_metadata ($cursection, $field, $_); 
-	    } @{$metadata->{$field}};
-	} else {
-	    $doc_obj->add_utf8_metadata ($cursection, $field, $metadata->{$field}); 
-	}
-    }
-}
-
-# initialise metadata extractors
-sub initialise_extractors {
-    my $self = shift (@_);
-
-    if ($self->{'extract_acronyms'} || $self->{'markup_acronyms'}) {
-	&acronym::initialise_acronyms();
-    }
-}
-
-# finalise metadata extractors
-sub finalise_extractors {
-    my $self = shift (@_);
-
-    if ($self->{'extract_acronyms'} || $self->{'markup_acronyms'}) {
-	&acronym::finalise_acronyms();
-    }
-}
-
-# FIRSTNNN: extract the first NNN characters as metadata
-sub extract_first_NNNN_characters {
-    my $self = shift (@_);
-    my ($textref, $doc_obj, $thissection) = @_;
-    
-    foreach my $size (split /,/, $self->{'first'}) {
-	my $tmptext =  $$textref;
-	$tmptext =~ s/^\s+//;
-	$tmptext =~ s/\s+$//;
-	$tmptext =~ s/\s+/ /gs;
-	$tmptext = substr ($tmptext, 0, $size);
-	$tmptext =~ s/\s\S*$/&#8230;/;
-	$doc_obj->add_utf8_metadata ($thissection, "First$size", $tmptext);
-    }
-}
-
-sub extract_email {
-    my $self = shift (@_);
-    my ($textref, $doc_obj, $thissection) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    gsprintf($outhandle, " {BasPlug.extracting_emails}...\n")
-	if ($self->{'verbosity'} > 2);
-    
-    my @email = ($$textref =~ m/([-a-z0-9\.@+_=]+@(?:[-a-z0-9]+\.)+(?:com|org|edu|mil|int|net|[a-z][a-z]))/g);
-    @email = sort @email;
-    
-#    if($self->{"new_extract_email"} == 0)
-#    {
-#    my @email2 = ();
-#    foreach my $address (@email) 
-#   {
-#	if (!(join(" ",@email2) =~ m/(^| )$address( |$)/ )) 
-#	    {
-#		push @email2, $address;
-#		$doc_obj->add_utf8_metadata ($thissection, "emailAddress", $address);
-#		# print $outhandle "  extracting $address\n" 
-#		&gsprintf($outhandle, "  {BasPlug.extracting} $address\n")
-#		    if ($self->{'verbosity'} > 3);
-#	    }
-#	}
-#    }
-#    else
-#    {
-    my $hashExistMail = {};
-    foreach my $address (@email) {
-	if (!(defined $hashExistMail->{$address}))
-	{
-	    $hashExistMail->{$address} = 1;
-	    $doc_obj->add_utf8_metadata ($thissection, "emailAddress", $address);
-	    gsprintf($outhandle, "  {BasPlug.extracting} $address\n")
-		if ($self->{'verbosity'} > 3);
-	}
-    }
-    gsprintf($outhandle, " {BasPlug.done_email_extract}\n")
-	if ($self->{'verbosity'} > 2);
-}
-
-# extract metadata
-sub auto_extract_metadata {
-
-    my $self = shift (@_);
-    my ($doc_obj) = @_;
-    
-    if ($self->{'extract_email'}) {
-	my $thissection = $doc_obj->get_top_section();
-	while (defined $thissection) {
-	    my $text = $doc_obj->get_text($thissection);
-	    $self->extract_email (\$text, $doc_obj, $thissection) if $text =~ /./;
-	    $thissection = $doc_obj->get_next_section ($thissection);
-	}
-    } 
-    if ($self->{'extract_placenames'}) {
-	my $thissection = $doc_obj->get_top_section();
-	while (defined $thissection) {
-	    my $text = $doc_obj->get_text($thissection);
-	    $self->extract_placenames (\$text, $doc_obj, $thissection) if $text =~ /./;
-	    $thissection = $doc_obj->get_next_section ($thissection);
-	}
-    } 
-
-    if ($self->{'extract_keyphrases'} || $self->{'extract_keyphrases_kea4'}) {
-	$self->extract_keyphrases($doc_obj);
-    }
-
-    if ($self->{'first'}) {
-	my $thissection = $doc_obj->get_top_section();
-	while (defined $thissection) {
-	    my $text = $doc_obj->get_text($thissection);
-	    $self->extract_first_NNNN_characters (\$text, $doc_obj, $thissection) if $text =~ /./;
-	    $thissection = $doc_obj->get_next_section ($thissection);
-	}
-    }   
-    
-    if ($self->{'extract_acronyms'}) {
-	my $thissection = $doc_obj->get_top_section();
-	while (defined $thissection) {
-	    my $text = $doc_obj->get_text($thissection);
-	    $self->extract_acronyms (\$text, $doc_obj, $thissection) if $text =~ /./;
-	    $thissection = $doc_obj->get_next_section ($thissection);
-	}
-    }
-    
-    if ($self->{'markup_acronyms'}) {
-	my $thissection = $doc_obj->get_top_section();
-	while (defined $thissection) {
-	    my $text = $doc_obj->get_text($thissection);
-	    $text = $self->markup_acronyms ($text, $doc_obj, $thissection);
-	    $doc_obj->delete_text($thissection);
-	    $doc_obj->add_text($thissection, $text);
-	    $thissection = $doc_obj->get_next_section ($thissection);
-	}
-    }
-
-    if($self->{'extract_historical_years'}) {
-	my $thissection = $doc_obj->get_top_section();
-	while (defined $thissection) {
-
-	    my $text = $doc_obj->get_text($thissection);
-	    &DateExtract::get_date_metadata($text, $doc_obj, 
-					    $thissection, 
-					    $self->{'no_bibliography'}, 
-					    $self->{'maximum_year'}, 
-					    $self->{'maximum_century'});
-	    $thissection = $doc_obj->get_next_section ($thissection);
-	}
-    }
-}
-
-
-#adding kea keyphrases
-sub extract_keyphrases
-{
-    my $self = shift(@_);
-    my $doc_obj = shift(@_);
-
-    # Use Kea 3.0 unless 4.0 has been specified
-    my $kea_version = "3.0";
-    if ($self->{'extract_keyphrases_kea4'}) {
-	$kea_version = "4.0";
-    }
-
-    # Check that Kea exists, and tell the user where to get it if not
-    my $keahome = &Kea::get_Kea_directory($kea_version);
-    if (!-e $keahome) {
-	gsprintf(STDERR, "{BasPlug.missing_kea}\n", $keahome, $kea_version);
-	return;
-    }
-
-    my $thissection = $doc_obj->get_top_section();
-    my $text = "";
-    my $list;
-
-    #loop through sections to gather whole doc
-    while (defined $thissection) { 
-	my $sectiontext = $doc_obj->get_text($thissection);   
-	$text = $text.$sectiontext;
-	$thissection = $doc_obj->get_next_section ($thissection);
-    } 
-   
-    if($self->{'extract_keyphrase_options'}) { #if kea options flag is set, call Kea with specified options 
-	$list = &Kea::extract_KeyPhrases ($kea_version, $text, $self->{'extract_keyphrase_options'});
-    } else { #otherwise call Kea with no options
-	$list = &Kea::extract_KeyPhrases ($kea_version, $text);
-    }
- 
-    if ($list){
-	# if a list of kea keyphrases was returned (ie not empty)
-	if ($self->{'verbosity'}) {
-	    gsprintf(STDERR, "{BasPlug.keyphrases}: $list\n");
-	}
-
-	#add metadata to top section
-	$thissection = $doc_obj->get_top_section(); 
-
-	# add all key phrases as one metadata
-	$doc_obj->add_metadata($thissection, "Keyphrases", $list);
-
-	# add individual key phrases as multiple metadata
-	foreach my $keyphrase (split(',', $list)) {
-	    $keyphrase =~ s/^\s+|\s+$//g;
-	    $doc_obj->add_metadata($thissection, "Keyphrase", $keyphrase);
-	}
-    }
-}
-
-
-# extract acronyms from a section in a document. progress is 
-# reported to outhandle based on the verbosity. both the Acronym
-# and the AcronymKWIC metadata items are created. 
-
-sub extract_acronyms {
-    my $self = shift (@_);
-    my ($textref, $doc_obj, $thissection) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    # print $outhandle " extracting acronyms ...\n" 
-    gsprintf($outhandle, " {BasPlug.extracting_acronyms}...\n")
-	if ($self->{'verbosity'} > 2);
-
-    my $acro_array =  &acronym::acronyms($textref);
-    
-    foreach my $acro (@$acro_array) {
-
-	#check that this is the first time ...
-	my $seen_before = "false";
-	my $previous_data = $doc_obj->get_metadata($thissection, "Acronym");
-	foreach my $thisAcro (@$previous_data) {
-	    if ($thisAcro eq $acro->to_string()) {
-		$seen_before = "true";
-		if ($self->{'verbosity'} >= 4) {
-		    gsprintf($outhandle, " {BasPlug.already_seen} " .
-			     $acro->to_string() . "\n");
-		}
-	    }
-	}
-
-	if ($seen_before eq "false") {
-	    #write it to the file ...
-	    $acro->write_to_file();
-
-	    #do the normal acronym
-	    $doc_obj->add_utf8_metadata($thissection, "Acronym",  $acro->to_string());
-	    gsprintf($outhandle, " {BasPlug.adding} ".$acro->to_string()."\n")
-		if ($self->{'verbosity'} > 3);
-	}
-    }
-
-    gsprintf($outhandle, " {BasPlug.done_acronym_extract}\n")
-	if ($self->{'verbosity'} > 2);
-}
-
-sub markup_acronyms {
-    my $self = shift (@_);
-    my ($text, $doc_obj, $thissection) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    gsprintf($outhandle, " {BasPlug.marking_up_acronyms}...\n")
-	if ($self->{'verbosity'} > 2);
-
-    #self is passed in to check for verbosity ...
-    $text = &acronym::markup_acronyms($text, $self);
-
-    gsprintf($outhandle, " {BasPlug.done_acronym_markup}\n")
-	if ($self->{'verbosity'} > 2);
-
-    return $text;
-}
-
-sub compile_stats {
-    my $self = shift(@_);
-    my ($stats) = @_;
-
-    $stats->{'num_processed'} += $self->{'num_processed'};
-    $stats->{'num_not_processed'} += $self->{'num_not_processed'};
-    $stats->{'num_archives'} += $self->{'num_archives'};
-
-}
-
-sub associate_cover_image {
-    my $self = shift;
-    my ($doc_obj, $filename) = @_;
-
-    $filename =~ s/\.[^\\\/\.]+$/\.jpg/;
-    if (exists $self->{'covers_missing_cache'}->{$filename}) {
-	# don't stat() for existence eg for multiple document input files
-	# (eg SplitPlug)
-	return;
-    }
-
-    my $top_section=$doc_obj->get_top_section();
-
-    if (-e $filename) {
-    	$doc_obj->associate_file($filename, "cover.jpg", "image/jpeg");
-	$doc_obj->add_utf8_metadata($top_section, "hascover",  1);
-    } else {
-	my $upper_filename = $filename;
-	$upper_filename =~ s/jpg$/JPG/;
-	if (-e $upper_filename) {
-	    $doc_obj->associate_file($upper_filename, "cover.jpg",
-				     "image/jpeg");
-	    $doc_obj->add_utf8_metadata($top_section, "hascover",  1);
-	} else {
-	    # file doesn't exist, so record the fact that it's missing so
-	    # we don't stat() again (stat is slow)
-	    $self->{'covers_missing_cache'}->{$filename} = 1;
-	}
-    }
-
-}
-
-
-# Overridden by exploding plugins (eg. ISISPlug)
-sub clean_up_after_exploding
-{
-    my $self = shift(@_);
-}
-
-
-1;
Index: /gsdl/trunk/perllib/plugins/BasePlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/BasePlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/BasePlugin.pm	(revision 15865)
@@ -0,0 +1,1720 @@
+###########################################################################
+#
+# BasPlug.pm -- base class for all the import plugins
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999-2005 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 BasPlug;
+
+BEGIN {
+    die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
+}
+
+eval {require bytes};
+
+# suppress the annoying "subroutine redefined" warning that various
+# plugins cause under perl 5.6
+$SIG{__WARN__} = sub {warn($_[0]) unless ($_[0] =~ /Subroutine\s+\S+\sredefined/)};
+
+use strict; 
+no strict 'subs';
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+use File::Basename;
+
+use Kea;
+use multiread;
+use encodings;
+use unicode;
+use cnseg;
+use acronym;
+use textcat;
+use doc;
+eval "require diagnostics"; # some perl distros (eg mac) don't have this
+use DateExtract;
+use ghtml;
+use gsprintf 'gsprintf';
+use printusage;
+use parse2;
+
+
+use GISBasPlug;
+
+@BasPlug::ISA = ( GISBasPlug );
+
+my $unicode_list =
+    [ { 'name' => "ascii",
+	'desc' => "{BasPlug.input_encoding.ascii}" },
+      { 'name' => "utf8",
+	'desc' => "{BasPlug.input_encoding.utf8}" },
+      { 'name' => "unicode",
+	'desc' => "{BasPlug.input_encoding.unicode}" } ];
+
+my $auto_unicode_list = 
+    [ { 'name' => "auto",
+	'desc' => "{BasPlug.input_encoding.auto}" } ];
+
+my $e = $encodings::encodings;
+foreach my $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) 
+{
+    my $hashEncode =
+    {'name' => $enc,
+     'desc' => $e->{$enc}->{'name'}};
+    
+    push(@{$unicode_list},$hashEncode);
+}
+
+push(@{$auto_unicode_list},@{$unicode_list});
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' => "",
+	'reqd' => "no" },
+      { 'name' => "block_exp",
+	'desc' => "{BasPlug.block_exp}",
+	'type' => "regexp",
+	'deft' => "",
+	'reqd' => "no" },
+      { 'name' => "smart_block",
+	'desc' => "{BasPlug.smart_block}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "associate_ext",
+	'desc' => "{BasPlug.associate_ext}",
+	'type' => "string",
+	'reqd' => "no" },
+      { 'name' => "associate_tail_re",
+	'desc' => "{BasPlug.associate_tail_re}",
+	'type' => "string",
+	'reqd' => "no" },
+      { 'name' => "use_as_doc_identifier",
+	'desc' => "{BasPlug.use_as_doc_identifier}",
+	'type' => "string",
+	'reqd' => "no" ,
+	'deft' => "" } ,
+      { 'name' => "input_encoding",
+	'desc' => "{BasPlug.input_encoding}",
+	'type' => "enum",
+	'list' => $auto_unicode_list,
+	'reqd' => "no" ,
+	'deft' => "auto" } ,
+      { 'name' => "default_encoding",
+	'desc' => "{BasPlug.default_encoding}",
+	'type' => "enum",
+	'list' => $unicode_list,
+	'reqd' => "no",
+        'deft' => "utf8" },
+      { 'name' => "extract_language",
+	'desc' => "{BasPlug.extract_language}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "default_language",
+	'desc' => "{BasPlug.default_language}",
+	'type' => "string",
+	'deft' => "en",
+	'reqd' => "no" },
+      { 'name' => "extract_acronyms",
+	'desc' => "{BasPlug.extract_acronyms}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "markup_acronyms",
+	'desc' => "{BasPlug.markup_acronyms}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "extract_keyphrases",
+	'desc' => "{BasPlug.extract_keyphrases}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "extract_keyphrases_kea4",
+	'desc' => "{BasPlug.extract_keyphrases_kea4}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "extract_keyphrase_options",
+	'desc' => "{BasPlug.extract_keyphrase_options}",
+	'type' => "string",
+	'deft' => "",
+	'reqd' => "no" },
+      { 'name' => "first",
+	'desc' => "{BasPlug.first}",
+	'type' => "string",
+	'reqd' => "no" },
+      { 'name' => "extract_email",
+	'desc' => "{BasPlug.extract_email}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "extract_historical_years",
+	'desc' => "{BasPlug.extract_historical_years}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "maximum_year",
+	'desc' => "{BasPlug.maximum_year}",
+	'type' => "int",
+	'deft' => (localtime)[5]+1900,
+	'char_length' => "4",
+	#'range' => "2,100",
+	'reqd' => "no"},
+      { 'name' => "maximum_century",
+	'desc' => "{BasPlug.maximum_century}",
+	'type' => "string",
+	'deft' => "-1",
+	'reqd' => "no" },
+      { 'name' => "no_bibliography",
+	'desc' => "{BasPlug.no_bibliography}",
+	'type' => "flag",
+	'reqd' => "no"},
+      { 'name' => "no_cover_image",
+	'desc' => "{BasPlug.no_cover_image}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "separate_cjk",
+	'desc' => "{BasPlug.separate_cjk}",
+	'type' => "flag",
+	'reqd' => "no",
+	'hiddengli' => "yes" },
+      { 'name' => "new_extract_email",
+	'desc' => "",
+	'type' => "flag",
+	'reqd' => "no",
+	'hiddengli' => "yes" } ];
+
+my $gis_arguments = 
+    [ { 'name' => "extract_placenames",
+	'desc' => "{GISBasPlug.extract_placenames}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "gazetteer",
+	'desc' => "{GISBasPlug.gazetteer}",
+	'type' => "string",
+	'reqd' => "no" },
+      { 'name' => "place_list",
+	'desc' => "{GISBasPlug.place_list}",
+	'type' => "flag",
+	'reqd' => "no" } ];
+
+
+my $options = { 'name'     => "BasPlug",
+		'desc'     => "{BasPlug.desc}",
+		'abstract' => "yes",
+		'inherits' => "no",
+		'args'     => $arguments };
+
+
+sub set_incremental {
+    my $self = shift(@_);
+    my ($incremental) = @_;
+
+    $self->{'incremental'} = $incremental;
+}
+
+sub get_arguments
+{
+    my $self = shift(@_);
+    my $optionlistref = $self->{'option_list'};
+    my @optionlist = @$optionlistref;
+    my $pluginoptions = pop(@$optionlistref);
+    my $pluginarguments = $pluginoptions->{'args'};
+    return $pluginarguments;
+}
+
+
+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("plugin");
+    }
+    $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 $pluginoptions = shift(@$optionlistref);
+    return if (!defined($pluginoptions));
+
+    # Find the process and block default expressions in the plugin arguments
+    my $process_exp = "";
+    my $block_exp = "";
+    if (defined($pluginoptions->{'args'})) {
+	foreach my $option (@{$pluginoptions->{'args'}}) {
+	    if ($option->{'name'} eq "process_exp") {
+		$process_exp = $option->{'deft'};
+	    }
+	    if ($option->{'name'} eq "block_exp") {
+		$block_exp = $option->{'deft'};
+	    }
+	}
+    }
+
+    gsprintf(STDERR, "<PlugInfo>\n");
+    gsprintf(STDERR, "  <Name>$pluginoptions->{'name'}</Name>\n");
+    my $desc = gsprintf::lookup_string($pluginoptions->{'desc'});
+    $desc =~ s/</&amp;lt;/g; # doubly escaped
+    $desc =~ s/>/&amp;gt;/g;
+    gsprintf(STDERR, "  <Desc>$desc</Desc>\n");
+    gsprintf(STDERR, "  <Abstract>$pluginoptions->{'abstract'}</Abstract>\n");
+    gsprintf(STDERR, "  <Inherits>$pluginoptions->{'inherits'}</Inherits>\n");
+    gsprintf(STDERR, "  <Processes>$process_exp</Processes>\n");
+    gsprintf(STDERR, "  <Blocks>$block_exp</Blocks>\n");
+    gsprintf(STDERR, "  <Explodes>" . ($pluginoptions->{'explodes'} || "no") . "</Explodes>\n");
+    # adding new option that works with replace_srcdoc_with_html.pl
+    gsprintf(STDERR, "  <SourceReplaceable>" . ($pluginoptions->{'srcreplaceable'} || "no") . "</SourceReplaceable>\n");
+    unless (defined($high_level_information_only)) {
+	gsprintf(STDERR, "  <Arguments>\n");
+	if (defined($pluginoptions->{'args'})) {
+	    &PrintUsage::print_options_xml($pluginoptions->{'args'});
+	}
+	gsprintf(STDERR, "  </Arguments>\n");
+
+	# Recurse up the plugin hierarchy
+	$self->print_xml();
+    }
+    gsprintf(STDERR, "</PlugInfo>\n");
+}
+
+
+sub print_txt_usage
+{
+    my $self = shift(@_);
+    # Print the usage message for a plugin (recursively)
+    my $descoffset = $self->determine_description_offset(0);
+    $self->print_plugin_usage($descoffset, 1);
+}
+
+
+sub determine_description_offset
+{
+    my $self = shift(@_);
+    my $maxoffset = shift(@_);
+
+    my $optionlistref = $self->{'option_list'};
+    my @optionlist = @$optionlistref;
+    my $pluginoptions = shift(@$optionlistref);
+    return $maxoffset if (!defined($pluginoptions));
+
+    # Find the length of the longest option string of this plugin
+    my $pluginargs = $pluginoptions->{'args'};
+    if (defined($pluginargs)) {
+	my $longest = &PrintUsage::find_longest_option_string($pluginargs);
+	if ($longest > $maxoffset) {
+	    $maxoffset = $longest;
+	}
+    }
+
+    # Recurse up the plugin hierarchy
+    $maxoffset = $self->determine_description_offset($maxoffset);
+    $self->{'option_list'} = \@optionlist;
+    return $maxoffset;
+}
+
+
+sub print_plugin_usage
+{
+    my $self = shift(@_);
+    my $descoffset = shift(@_);
+    my $isleafclass = shift(@_);
+
+    my $optionlistref = $self->{'option_list'};
+    my @optionlist = @$optionlistref;
+    my $pluginoptions = shift(@$optionlistref);
+    return if (!defined($pluginoptions));
+
+    my $pluginname = $pluginoptions->{'name'};
+    my $pluginargs = $pluginoptions->{'args'};
+    my $plugindesc = $pluginoptions->{'desc'};
+
+    # Produce the usage information using the data structure above
+    if ($isleafclass) {
+	if (defined($plugindesc)) {
+	    gsprintf(STDERR, "$plugindesc\n\n");
+	}
+	gsprintf(STDERR, " {common.usage}: plugin $pluginname [{common.options}]\n\n");
+    }
+
+    # Display the plugin options, if there are some
+    if (defined($pluginargs)) {
+	# 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", $pluginname);
+	}
+
+	# Display the plugin options
+	&PrintUsage::print_options_txt($pluginargs, $optiondescoffset);
+    }
+
+    # Recurse up the plugin hierarchy
+    $self->print_plugin_usage($descoffset, 0);
+    $self->{'option_list'} = \@optionlist;
+}
+
+
+sub new {
+    # Set Encodings to the list!!
+
+
+    # Start the BasPlug Constructor
+    my $class = shift (@_);
+    my ($pluginlist,$args,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+    my $plugin_name = (defined $pluginlist->[0]) ? $pluginlist->[0] : $class;
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    if (GISBasPlug::has_mapdata()) {
+	push(@$arguments,@$gis_arguments);
+    }
+    
+    my $self = {};
+    $self->{'outhandle'} = STDERR;
+    $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($strArg eq "-gsdlinfo")
+	{
+	    $self->{"info_only"} = 1;
+	    return bless $self, $class;
+	}
+    }
+
+    if(parse2::parse($args,$hashArgOptLists->{"ArgList"},$self) == -1)
+    {
+	my $classTempClass = bless $self, $class;
+	print STDERR "<BadPlugin p=$plugin_name>\n";
+	&gsprintf(STDERR, "\n{BasPlug.bad_general_option}\n", $plugin_name);
+	$classTempClass->print_txt_usage("");  # Use default resource bundle
+	die "\n";
+    }
+
+
+    delete $self->{"info_only"};
+    # else parsing was successful.
+
+    $self->{'plugin_type'} = $plugin_name;
+    #$self->{'outhandle'} = STDERR;
+    $self->{'num_processed'} = 0;
+    $self->{'num_not_processed'} = 0;
+    $self->{'num_blocked'} = 0;
+    $self->{'num_archives'} = 0;
+    $self->{'cover_image'} = 1; # cover image is on by default
+    $self->{'cover_image'} = 0 if ($self->{'no_cover_image'});
+    #$self->{'option_list'} = $hashArgOptLists->{"OptList"};
+    
+    my $associate_ext = $self->{'associate_ext'};
+    if ((defined $associate_ext) && ($associate_ext ne "")) {
+
+	my $associate_tail_re = $self->{'associate_tail_re'};
+	if ((defined $associate_tail_re) && ($associate_tail_re ne "")) {
+	    my $outhandle = $self->{'outhandle'};
+	    print $outhandle "Warning: can only specify 'associate_ext' or 'associate_tail_re'\n";
+	    print $outhandle "         defaulting to 'associate_tail_re'\n";
+	}
+	else {
+	    my @exts = split(/,/,$associate_ext);
+
+	    my @exts_bracketed = map { $_ = "(?:\\.$_)" } @exts;
+	    my $associate_tail_re = join("|",@exts_bracketed);
+	    $self->{'associate_tail_re'} = $associate_tail_re;
+	}
+
+	delete $self->{'associate_ext'};
+    }
+
+    $self->{'shared_fileroot'} = {};
+    $self->{'file_blocks'} = {};
+
+    if ($self->{'extract_placenames'}) {
+
+	my $outhandle = $self->{'outhandle'};
+	
+	my $places_ref 
+	    = GISBasPlug::loadGISDatabase($outhandle,$self->{'gazetteer'});
+	
+	if (!defined $places_ref) {
+	    print $outhandle "Warning: Error loading mapdata gazetteer \"$self->{'gazetteer'}\"\n";
+	    print $outhandle "         No placename extraction will take place.\n";
+	    $self->{'extract_placenames'} = undef;
+	}
+	else {
+	    $self->{'places'} = $places_ref;
+	}
+    }
+
+    return bless $self, $class;
+    
+}
+
+# initialize BasPlug options
+# if init() is overridden in a sub-class, remember to call BasPlug::init()
+sub init {
+    my $self = shift (@_);
+    my ($verbosity, $outhandle, $failhandle) = @_;
+
+    # verbosity is passed through from the processor
+    $self->{'verbosity'} = $verbosity;
+
+    # as are the outhandle and failhandle
+    $self->{'outhandle'} = $outhandle if defined $outhandle;
+    $self->{'failhandle'} = $failhandle;
+
+    # set process_exp and block_exp to defaults unless they were
+    # explicitly set
+
+    if ((!$self->is_recursive()) and 
+	(!defined $self->{'process_exp'}) || ($self->{'process_exp'} eq "")) {
+
+	$self->{'process_exp'} = $self->get_default_process_exp ();
+	if ($self->{'process_exp'} eq "") {
+	    warn ref($self) . " Warning: Non-recursive plugin has no process_exp\n";
+	}
+    }
+
+    if ((!defined $self->{'block_exp'}) || ($self->{'block_exp'} eq "")) {
+	$self->{'block_exp'} = $self->get_default_block_exp ();
+    }
+
+}
+
+sub begin {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $processor, $maxdocs) = @_;
+
+   #my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(0);
+   #print STDERR "Calling method; $cfilename:$cline $cpackage->$csubr\n";
+
+    $self->initialise_extractors();
+}
+
+sub end {
+    # potentially called at the end of each plugin pass 
+    # import.pl only has one plugin pass, but buildcol.pl has multiple ones
+
+    my ($self) = @_;
+    $self->finalise_extractors();
+}
+
+sub deinit {
+    # called only once, after all plugin passes have been done
+
+    my ($self) = @_;
+}
+
+# this function should be overridden to return 1
+# in recursive plugins
+sub is_recursive {
+    my $self = shift (@_);
+
+    return 0; 
+}
+
+sub get_default_block_exp {
+    my $self = shift (@_);
+
+    return "";
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return "";
+}
+
+# default implementation is to do nothing. 
+sub store_block_files
+{
+    my $self =shift (@_);
+    my ($filename) = @_;
+    return;
+}
+
+#default implementation is to block a file with same name as this, but extension jpg or JPG, if cover_images is on.
+sub block_cover_image
+{
+    my $self =shift;
+    my $filename = shift;
+
+    if ($self->{'cover_image'}) {
+	my $coverfile = $filename;
+	$coverfile =~ s/\.[^\\\/\.]+$/\.jpg/;
+	if (!-e $coverfile) {
+	    $coverfile =~ s/jpg$/JPG/;
+	} 	
+	if (-e $coverfile) {
+	    $self->{'file_blocks'}->{$coverfile} = 1;
+	} 
+    }
+
+    return;
+}
+
+sub root_ext_split
+{
+    my $self = shift (@_);
+    my ($filename,$tail_re) = @_;
+    
+    my ($file_prefix,$file_ext) = ($filename =~ m/^(.*?)($tail_re)$/);
+
+    if ((!defined $file_prefix) || (!defined $file_ext)) {
+	($file_prefix,$file_ext) = ($filename =~ m/^(.*)(\..*?)$/);
+    }
+
+    return ($file_prefix,$file_ext);
+}
+
+sub metadata_read {
+    my $self = shift (@_);  
+    my ($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli) = @_;
+    # Keep track of filenames with same root but different extensions
+    # Used to support -associate_ext and the more generalised
+    # -associate_tail_re
+
+    my $associate_tail_re = $self->{'associate_tail_re'};
+    if ((defined $associate_tail_re) && ($associate_tail_re ne "")) {
+
+	my ($file_prefix,$file_ext) 
+	    = $self->root_ext_split($file,$associate_tail_re);
+
+	if ((defined $file_prefix) && (defined $file_ext)) {
+
+	    my $shared_fileroot = $self->{'shared_fileroot'};
+	    if (!defined $shared_fileroot->{$file_prefix}) {
+		my $file_prefix_rec = { 'tie_to'  => undef, 
+				        'exts'    => {} };
+		$shared_fileroot->{$file_prefix} = $file_prefix_rec;
+	    }
+	    
+	    my $file_prefix_rec = $shared_fileroot->{$file_prefix};
+
+	    my $process_exp = $self->{'process_exp'};
+
+	    if ($file =~ m/$process_exp/) {
+		# This is the document the others should be tied to
+		$file_prefix_rec->{'tie_to'} = $file_ext;
+	    }
+	    else {
+		if ($file_ext =~ m/$associate_tail_re$/) {
+		    $file_prefix_rec->{'exts'}->{$file_ext} = 1;
+		}
+	    }
+
+	}
+    }
+
+    # now check whether we are actually processing this
+    my $filename = $file;
+    $filename = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
+    if ($self->{'process_exp'} eq "" || $filename !~ /$self->{'process_exp'}/ || !-f $filename) {
+	return undef; # can't recognise
+    }
+
+    # do smart blocking if appropriate
+    if ($self->{'smart_block'}) {
+	$self->store_block_files($filename);
+    }
+    # block the cover image if there is one
+    if ($self->{'cover_image'}) {
+	$self->block_cover_image($filename);
+    }
+       
+    return 1;
+}
+
+sub tie_to_filename
+{
+    my $self = shift (@_);  
+  
+    my ($file_ext,$file_prefix_rec) = @_;
+
+    if (defined $file_prefix_rec) {
+	my $tie_to = $file_prefix_rec->{'tie_to'};
+
+	if (defined $tie_to) {
+	    if ($tie_to eq $file_ext) {
+		return 1;
+	    }
+	}
+    }
+
+    return 0;
+}
+
+sub tie_to_assoc_file
+{
+    my $self = shift (@_);    
+    my ($file_ext,$file_prefix_rec) = @_;
+
+    if (defined $file_prefix_rec) {
+	my $tie_to = $file_prefix_rec->{'tie_to'};
+	if (defined $tie_to) {
+
+	    my $exts = $file_prefix_rec->{'exts'};
+
+	    my $has_file_ext = $exts->{$file_ext};
+
+	    if ($has_file_ext) {
+		return 1;
+	    }
+	}
+    }
+
+    return 0;
+}
+
+
+sub associate_with
+{
+    my $self = shift (@_);    
+    my ($file, $filename, $metadata) = @_;
+
+    my $associate_tail_re = $self->{'associate_tail_re'};
+    return 0 if (!$associate_tail_re);
+
+    # If file, see if matches with "tie_to" doc or is one of the
+    # associated filename extensions.
+
+    my ($file_prefix,$file_ext) = $self->root_ext_split($file,$associate_tail_re);
+
+    if ((defined $file_prefix) && (defined $file_ext)) {
+
+	my $file_prefix_rec = $self->{'shared_fileroot'}->{$file_prefix};
+	
+	if ($self->tie_to_filename($file_ext,$file_prefix_rec)) {
+
+	    # Set up gsdlassocfile_tobe
+
+	    my $exts = $file_prefix_rec->{'exts'};
+		
+	    if (!defined $metadata->{'gsdlassocfile_tobe'}) {
+		$metadata->{'gsdlassocfile_tobe'} = [];
+	    }
+
+	    my $assoc_tobe = $metadata->{'gsdlassocfile_tobe'};
+			
+	    my ($full_prefix) = ($filename =~ m/^(.*)\..*?$/);
+	    foreach my $e (keys %$exts) {		
+		my $assoc_file = "$full_prefix$e";
+		print STDERR "  $self->{'plugin_type'}: Associating $file_prefix$e with $file_prefix_rec->{'tie_to'} version\n";
+		my $mime_type = ""; # let system auto detect this
+		push(@$assoc_tobe,"$assoc_file:$mime_type:"); 
+	    }
+
+	}
+	elsif ($self->tie_to_assoc_file($file_ext,$file_prefix_rec)) {
+
+
+	    # a form of smart block	    
+	    return 1;
+	}
+    }
+
+    return 0;
+}
+
+
+sub read_block {
+    my $self = shift (@_);  
+  
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+
+    my $filename = $file;
+    $filename = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
+
+    if ($self->associate_with($file,$filename,$metadata)) {
+	# a form of smart block
+	$self->{'num_blocked'} ++;
+	return (0,undef); # blocked
+    }
+
+    my $smart_block = $self->{'smart_block'};
+    my $smart_block_BN = $self->{'smart_block_BN'};
+   
+    if ($smart_block || $smart_block_BN) {
+	if (defined $self->{'file_blocks'}->{$filename} && $self->{'file_blocks'}->{$filename} == 1){
+	    $self->{'num_blocked'} ++;
+	    return (0,undef); # blocked
+	}
+    } else {
+	if ($self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/) {
+	    $self->{'num_blocked'} ++;
+	    return (0,undef); # blocked
+	}
+	if ($self->{'cover_image'}) {
+	    if (defined $self->{'file_blocks'}->{$filename} && $self->{'file_blocks'}->{$filename} == 1){
+		$self->{'num_blocked'} ++;
+		return (0,undef); # blocked
+	    }
+	}
+    }
+
+    if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
+	return (undef,undef); # can't recognise
+    }
+    
+    return (1,$filename);
+}
+
+sub read_tidy_file {
+
+    my $self = shift (@_);  
+  
+    my ($file) = @_;
+
+    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
+
+    return $file;
+}
+
+
+sub filename_to_metadata
+{
+    my $self = shift (@_);  
+    my ($file, $encoding) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+
+    my $filesystem_encoding = undef;
+
+    eval {
+	use POSIX qw(locale_h);
+
+	# With only one parameter, setlocale retrieves the current value
+	my $current_locale = setlocale(LC_CTYPE);
+
+	if ($current_locale =~ m/^.*\.(.*?)$/) {
+	    my $char_encoding = lc($1);
+	    if ($char_encoding =~ m/^(iso)(8859)(\d{1,2})$/) {
+		$char_encoding = "$1\_$2\_$3";
+	    }
+
+	    $char_encoding =~ s/-/_/g;
+	    $char_encoding =~ s/^utf_8$/utf8/;
+
+	    if ($char_encoding =~ m/^\d+$/) {
+		if (defined $encodings::encodings->{"windows_$char_encoding"}) {
+		    $char_encoding = "windows_$char_encoding";
+		}
+		elsif (defined $encodings::encodings->{"dos_$char_encoding"}) {
+		    $char_encoding = "dos_$char_encoding";
+		}
+	    }
+
+	    if (($char_encoding =~ m/(?:ascii|utf8|unicode)/) 
+		|| (defined $encodings::encodings->{$char_encoding})) {
+		$filesystem_encoding = $char_encoding;
+	    }
+	    else {
+		print $outhandle "Warning: Unsupported character encoding '$char_encoding' from locale '$current_locale'\n";
+	    }
+	}
+
+
+    };
+    if ($@) {
+	print $outhandle "$@\n";
+	print $outhandle "Warning: Unable to establish locale.  Will assume filesytem is UTF-8\n";
+	
+    }
+    
+    my ($filemeta) = $file =~ /([^\\\/]+)$/; # getting the tail of the filepath (skips all string parts containing slashes upto the end)
+    
+    # how do we know what encoding the filename is in?
+    # => one answer is to check the locale
+
+    if (defined $filesystem_encoding) {
+	if ($filesystem_encoding !~ /(?:ascii|utf8|unicode)/) {
+	    $filemeta = unicode::unicode2utf8(
+		    unicode::convert2unicode($filesystem_encoding, \$filemeta)
+	          );
+	}
+    }
+    # assume it is in the same encoding as its contents
+    elsif ((defined $encoding) && ($encoding !~ /(?:ascii|utf8|unicode)/)) {
+	$filemeta = unicode::unicode2utf8(
+		unicode::convert2unicode($encoding, \$filemeta)
+	);
+    }
+    
+    my $dmsafe_filemeta = &ghtml::dmsafe($filemeta);
+
+    return $dmsafe_filemeta;
+}
+
+
+sub add_OID
+{
+    my $self = shift (@_);  
+    my ($doc_obj) = @_;
+
+    # See if a metadata field is specified as the field
+    if ((defined $self->{'use_as_doc_identifier'}) && ($self->{'use_as_doc_identifier'} ne "")) {
+	my $metadata_doc_id = $self->{'use_as_doc_identifier'};
+
+	# Consider "tidying" up metadata_doc_id to be something
+	# suitable in a URL
+	# Could even support a user specified plugin RE for this.
+
+	my $top_section = $doc_obj->get_top_section();
+	my $oid = $doc_obj->get_metadata_element($top_section,$metadata_doc_id);
+##	print STDERR "**** oid = $oid\n";
+    	$doc_obj->set_OID($oid);
+    }
+    # See if there is a plugin-specific set_OID function...
+    elsif (defined ($self->can('set_OID'))) {
+	# it will need $doc_obj to set the Identifier metadata...
+	$self->set_OID(@_); # pass through any extra arguments supplied
+    } else {
+	# use the default set_OID() in doc.pm
+	$doc_obj->set_OID();
+    }
+}
+
+# The BasPlug read_into_doc_obj() function. This function does all the
+# right things to make general options work for a given plugin.  It reads in
+# a file and sets up a slew of metadata all saved in doc_obj, which
+# it then returns as part of a tuple (process_status,doc_obj)
+#
+# Much of this functionality used to reside in read, but it was broken
+# down into a supporting routine to make the code more flexible.  
+#
+# recursive plugins (e.g. RecPlug) and specialized plugins like those
+# capable of processing many documents within a single file (e.g.
+# GMLPlug) will normally want to implement their own version of
+# read_into_doc_obj()
+#
+# Note that $base_dir might be "" and that $file might 
+# include directories
+sub read_into_doc_obj {
+    my $self = shift (@_);  
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    if ($self->is_recursive()) {
+	gsprintf(STDERR, "{BasPlug.read_must_be_implemented}") && die "\n";
+    }
+
+    my $outhandle   = $self->{'outhandle'};
+
+    my ($block_status,$filename) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+    $file = $self->read_tidy_file($file);
+
+    # Do encoding stuff
+    my ($language, $encoding) = $self->textcat_get_language_encoding ($filename);
+    if ($self->{'verbosity'} > 2) {
+	print $outhandle "BasPlug: reading $file as ($encoding,$language)\n";
+    }
+
+    # create a new document
+    my $doc_obj = new doc ($filename, "indexed_doc");
+    my $top_section = $doc_obj->get_top_section();
+
+    $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
+    $doc_obj->add_utf8_metadata($top_section, "Language", $language);
+    $doc_obj->add_utf8_metadata($top_section, "Encoding", $encoding);
+    $doc_obj->add_utf8_metadata($top_section, "Plugin", "$self->{'plugin_type'}");
+    $doc_obj->add_utf8_metadata($top_section, "FileSize", (-s $filename));
+
+    my $filemeta = $self->filename_to_metadata($file,$encoding);
+    $doc_obj->add_utf8_metadata($top_section, "Source", $filemeta);
+    if ($self->{'cover_image'}) {
+	$self->associate_cover_image($doc_obj, $filename);
+    }
+    
+    # read in file ($text will be in utf8)
+    my $text = "";
+    $self->read_file ($filename, $encoding, $language, \$text);
+
+    if (!length ($text)) {
+	my $plugin_name = ref ($self);
+	if ($gli) {
+	    print STDERR "<ProcessingError n='$file' r='File contains no text'>\n";
+	}
+	gsprintf($outhandle, "$plugin_name: {BasPlug.file_has_no_text}\n", $filename) if $self->{'verbosity'};
+
+	my $failhandle = $self->{'failhandle'};
+	gsprintf($failhandle, "$file: " . ref($self) . ": {BasPlug.empty_file}\n");
+	# print $failhandle "$file: " . ref($self) . ": file contains no text\n";
+	$self->{'num_not_processed'} ++;
+
+	return (0,undef); # what should we return here?? error but don't want to pass it on
+    }
+   
+    # include any metadata passed in from previous plugins 
+    # note that this metadata is associated with the top level section
+
+    my $associate_tail_re = $self->{'associate_tail_re'};
+
+    $self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
+
+    # do plugin specific processing of doc_obj
+    unless (defined ($self->process (\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli))) {
+	$text = '';
+	undef $text;
+	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
+	return (-1,undef);
+    }
+    $text='';
+    undef $text;
+   
+    # do any automatic metadata extraction
+    $self->auto_extract_metadata ($doc_obj);
+
+    $self->add_OID($doc_obj);
+    
+    return (1,$doc_obj);
+}
+
+
+# The BasPlug read() function. This function calls read_into_doc_obj()
+# to ensure all the right things to make general options work for a
+# given plugin are done. It then calls the process() function which
+# does all the work specific to a plugin (like the old read functions
+# used to do). Most plugins should define their own process() function
+# and let this read() function keep control.  
+#
+# recursive plugins (e.g. RecPlug) and specialized plugins like those
+# capable of processing many documents within a single file (e.g.
+# GMLPlug) might want to implement their own version of read(), but
+# more likely need to implement their own version of read_into_doc_obj()
+#
+# Return number of files processed, undef if can't recognise, -1 if can't
+# process
+
+sub read {
+    my $self = shift (@_);  
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    my ($process_status,$doc_obj) = $self->read_into_doc_obj(@_);
+    
+    if ((defined $process_status) && ($process_status == 1)) {
+	# process the document
+	$processor->process($doc_obj);
+	
+	if(defined($self->{'places_filename'})){
+	    &util::rm($self->{'places_filename'});
+	    $self->{'places_filename'} = undef;
+	}
+	
+	$self->{'num_processed'} ++;
+	undef $doc_obj; 
+    }
+
+    # if process_status == 1, then the file has been processed.
+    return $process_status;
+
+}
+
+# returns undef if file is rejected by the plugin
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+
+    gsprintf(STDERR, "BasPlug::process {common.must_be_implemented}\n") && die "\n";
+    # die "Basplug::process function must be implemented in sub-class\n";
+
+    return undef; # never gets here
+}
+
+# uses the multiread package to read in the entire file pointed to
+# by filename and loads the resulting text into $$textref. Input text
+# may be in any of the encodings handled by multiread, output text
+# will be in utf8
+sub read_file {
+    my $self = shift (@_);
+    my ($filename, $encoding, $language, $textref) = @_;
+
+    if (!-r $filename)
+    {
+	my $outhandle = $self->{'outhandle'};
+	gsprintf($outhandle, "{BasPlug.read_denied}\n", $filename) if $self->{'verbosity'};
+	# print $outhandle "Read permission denied for $filename\n" if $self->{'verbosity'};
+	return;
+    }
+    $$textref = "";
+    if (!open (FILE, $filename)) {
+	gsprintf(STDERR, "BasPlug::read_file {BasPlug.could_not_open_for_reading} ($!)\n", $filename);
+	die "\n";
+    }
+     
+    if ($encoding eq "ascii") {
+	undef $/;
+	$$textref = <FILE>;
+	$/ = "\n";
+    } else {
+	my $reader = new multiread();
+	$reader->set_handle ('BasPlug::FILE');
+	$reader->set_encoding ($encoding);
+	$reader->read_file ($textref);
+        #Now segments chinese if the separate_cjk option is set
+	if ($self->{'separate_cjk'}) {
+	    # segment the Chinese words
+	    $$textref = &cnseg::segment($$textref);
+	}
+    }
+    close FILE;
+}
+
+# write_file -- used by ConvertToPlug, for example in post processing
+#
+sub utf8_write_file {
+    my $self = shift (@_);
+    my ($textref, $filename) = @_;
+    
+    if (!open (FILE, ">$filename")) {
+	gsprintf(STDERR, "ConvertToPlug::write_file {ConvertToPlug.could_not_open_for_writing} ($!)\n", $filename);
+	 die "\n";
+     }
+    print FILE $$textref;
+    
+    close FILE;
+}
+
+
+sub filename_based_title
+{
+    my $self = shift (@_);
+    my ($file) = @_;
+
+    my $file_derived_title = $file;
+    $file_derived_title =~ s/_/ /g;
+    $file_derived_title =~ s/\..*?$//;
+
+    return $file_derived_title;
+}
+
+
+sub title_fallback
+{
+    my $self = shift (@_);
+    my ($doc_obj,$section,$file) = @_;
+
+    if (!defined $doc_obj->get_metadata_element ($section, "Title")) {
+
+	my $file_derived_title = $self->filename_based_title($file);
+	
+	$doc_obj->add_utf8_metadata ($section, "Title", $self->filename_to_metadata($file_derived_title));
+    }
+}
+
+sub textcat_get_language_encoding {
+    my $self = shift (@_);
+    my ($filename) = @_;
+
+    
+    my ($language, $encoding, $extracted_encoding);
+    if ($self->{'input_encoding'} eq "auto") {
+        # use textcat to automatically work out the input encoding and language
+        ($language, $encoding) = $self->get_language_encoding ($filename);
+    } elsif ($self->{'extract_language'}) {
+        # use textcat to get language metadata
+        ($language, $extracted_encoding) = $self->get_language_encoding ($filename);
+        $encoding = $self->{'input_encoding'};
+	# don't print this message for english... english in utf8 is identical
+	# to english in iso-8859-1 (except for some punctuation). We don't have
+	# a language model for en_utf8, so textcat always says iso-8859-1!
+        if ($extracted_encoding ne $encoding && $language ne "en"
+	    && $self->{'verbosity'}) {
+	    my $plugin_name = ref ($self);
+	    my $outhandle = $self->{'outhandle'};
+	    gsprintf($outhandle, "$plugin_name: {BasPlug.wrong_encoding}\n", $filename, $encoding, $extracted_encoding);
+        }
+    } else {
+        $language = $self->{'default_language'};
+        $encoding = $self->{'input_encoding'};
+    }
+
+    return ($language, $encoding);
+}
+
+# Uses textcat to work out the encoding and language of the text in 
+# $filename. All html tags are removed before processing.
+# returns an array containing "language" and "encoding"
+sub get_language_encoding {
+    my $self = shift (@_);
+    my ($filename) = @_;
+    my $outhandle = $self->{'outhandle'};
+    my $unicode_format = "";
+    my $best_language = "";
+    my $best_encoding = "";
+    
+    # read in file
+    if (!open (FILE, $filename)) {
+	gsprintf(STDERR, "BasPlug::get_language_encoding {BasPlug.could_not_open_for_reading} ($!)\n", $filename);
+	# this is a pretty bad error, but try to continue anyway
+	return ($self->{'default_language'}, $self->{'input_encoding'});
+    }
+    undef $/;
+    my $text = <FILE>;
+    $/ = "\n";
+    close FILE;
+
+    # check if first few bytes have a Byte Order Marker
+    my $bom=substr($text,0,2); # check 16bit unicode
+    if ($bom eq "\xff\xfe") { # little endian 16bit unicode
+	$unicode_format="unicode";
+    } elsif ($bom eq "\xfe\xff") { # big endian 16bit unicode
+	$unicode_format="unicode";
+    } else {
+	$bom=substr($text,0,3); # check utf-8
+	if ($bom eq "\xef\xbb\xbf") { # utf-8 coded FEFF bom
+	    $unicode_format="utf8";
+#	} elsif ($bom eq "\xef\xbf\xbe") { # utf-8 coded FFFE bom. Error!?
+#	    $unicode_format="utf8";
+	}
+    }
+    
+
+    # handle html files specially
+    # XXX this doesn't match plugins derived from HTMLPlug (except ConvertTo)
+    if (ref($self) eq 'HTMLPlug' ||
+	(exists $self->{'converted_to'} && $self->{'converted_to'} eq 'HTML')){
+
+	# remove <title>stuff</title> -- as titles tend often to be in English
+	# for foreign language documents
+	$text =~ s!<title>.*?</title>!!si;
+
+	# see if this html file specifies its encoding
+	if ($text =~ /^<\?xml.*encoding="(.+?)"/) {
+	    $best_encoding = $1;
+	} elsif ($text =~ /<meta http-equiv.*content-type.*charset=(.+?)"/i) {#"
+	    $best_encoding = $1;
+	}
+	if ($best_encoding) { # we extracted an encoding
+	    $best_encoding =~ s/-+/_/g;
+	    $best_encoding = lc($best_encoding); # lowercase
+	    if ($best_encoding eq "utf_8") { $best_encoding = "utf8" }
+	    $self->{'input_encoding'} = $best_encoding;
+	}
+        
+	# remove all HTML tags
+	$text =~ s/<[^>]*>//sg;
+    }
+
+    # get the language/encoding
+    $self->{'textcat'} = new textcat() if (!defined($self->{'textcat'}));
+    my $results = $self->{'textcat'}->classify(\$text);
+
+    # if textcat returns 3 or less possibilities we'll use the 
+    # first one in the list - otherwise use the defaults
+    if (scalar @$results > 3) {
+	if ($unicode_format) { # in case the first had a BOM
+	    $best_encoding=$unicode_format;
+	} else {
+	    my %guessed_encodings = ();
+	    foreach my $result (@$results) {
+		$result =~ /([^\-]+)$/;
+		my $enc=$1;
+		if (!defined($guessed_encodings{$enc})) {
+		    $guessed_encodings{$enc}=0;
+		}
+		$guessed_encodings{$enc}++;
+	    }
+
+	    $guessed_encodings{""}=-1; # for default best_encoding of ""
+	    foreach my $enc (keys %guessed_encodings) {
+		if ($guessed_encodings{$enc} >
+		    $guessed_encodings{$best_encoding}){
+		    $best_encoding=$enc;
+		}
+	    }
+	}
+
+	if ($self->{'input_encoding'} ne 'auto') {
+	    if ($self->{'extract_language'} && ($self->{'verbosity'}>2)) {
+		gsprintf($outhandle,
+			 "BasPlug: {BasPlug.could_not_extract_language}\n",
+			 $filename, $self->{'default_language'});
+	    }		
+	    $best_language = $self->{'default_language'};
+	    $best_encoding = $self->{'input_encoding'};
+
+	} else {
+	    if ($self->{'verbosity'}>2) {
+		gsprintf($outhandle,
+			 "BasPlug: {BasPlug.could_not_extract_language}\n",
+			 $filename, $self->{'default_language'});
+	    }
+	    $best_language = $self->{'default_language'};
+	}
+    } else { # <= 3 suggestions
+	my ($language, $encoding) = $results->[0] =~ /^([^-]*)(?:-(.*))?$/;
+	if (!defined $language) {
+	    if ($self->{'verbosity'}>2) {
+		gsprintf($outhandle,
+		    "BasPlug: {BasPlug.could_not_extract_language}\n",
+		    $filename, $self->{'default_language'});
+	    }
+	    $language = $self->{'default_language'};
+	}
+	if (!defined $encoding) {
+	    if ($self->{'verbosity'}>2) {
+		gsprintf($outhandle,
+		    "BasPlug: {BasPlug.could_not_extract_encoding}\n",
+		    $filename, $self->{'default_encoding'});
+	    }
+	    $encoding = $self->{'default_encoding'};
+	}
+	$best_language = $language;
+	if (! $best_encoding ) { # may already be set... eg from html meta tag
+	    $best_encoding = $encoding;
+	}
+    }
+
+    my $text_copy = $text;
+    if ($best_encoding =~ /^iso_8859/ && unicode::ensure_utf8(\$text_copy)==0) {
+	# the text is valid utf8, so assume that's the real encoding
+	# (since textcat is based on probabilities)
+	$best_encoding = 'utf8';
+    }
+
+    # check for equivalents where textcat doesn't have some encodings...
+    # eg MS versions of standard encodings
+    if ($best_encoding =~ /^iso_8859_(\d+)/) {
+	my $iso = $1; # which variant of the iso standard?
+	# iso-8859 sets don't use chars 0x80-0x9f, windows codepages do
+	if ($text =~ /[\x80-\x9f]/) {
+	    # Western Europe
+	    if ($iso == 1 or $iso == 15) { $best_encoding = 'windows_1252' }
+	    elsif ($iso == 2) {$best_encoding = 'windows_1250'} # Central Europe
+	    elsif ($iso == 5) {$best_encoding = 'windows_1251'} # Cyrillic
+	    elsif ($iso == 6) {$best_encoding = 'windows_1256'} # Arabic
+	    elsif ($iso == 7) {$best_encoding = 'windows_1253'} # Greek
+	    elsif ($iso == 8) {$best_encoding = 'windows_1255'} # Hebrew
+	    elsif ($iso == 9) {$best_encoding = 'windows_1254'} # Turkish
+	}
+    }
+
+    if ($best_encoding !~ /^(ascii|utf8|unicode)$/ &&
+	!defined $encodings::encodings->{$best_encoding}) {
+	if ($self->{'verbosity'}) {
+	    gsprintf($outhandle, "BasPlug: {BasPlug.unsupported_encoding}\n",
+		     $filename, $best_encoding, $self->{'default_encoding'});
+	}
+	$best_encoding = $self->{'default_encoding'};
+    }
+
+    return ($best_language, $best_encoding);
+}
+
+# add any extra metadata that's been passed around from one
+# plugin to another.
+# extra_metadata uses add_utf8_metadata so it expects metadata values
+# to already be in utf8
+sub extra_metadata {
+    my $self = shift (@_);
+    my ($doc_obj, $cursection, $metadata) = @_;
+
+    my $associate_tail_re = $self->{'associate_tail_re'};
+
+    foreach my $field (keys(%$metadata)) {
+	# $metadata->{$field} may be an array reference
+	if ($field eq "gsdlassocfile_tobe") {
+	    # 'gsdlassocfile_tobe' is artificially introduced metadata
+	    # that is used to signal that certain additional files should
+	    # be tied to this document.  Useful in situations where a
+	    # metadata pass in the plugin pipeline works out some files
+	    # need to be associated with a document, but the document hasn't
+	    # been formed yet.
+	    
+	    my $equiv_form = "";
+	    foreach my $gaf (@{$metadata->{$field}}) {
+		my ($full_filename,$mimetype) = ($gaf =~ m/^(.*):(.*):$/);
+		my ($tail_filename) = ($full_filename =~ /^.*[\/\\](.+?)$/);
+		my $filename = $full_filename;
+			      
+		$doc_obj->associate_file($full_filename,$tail_filename,$mimetype);
+
+		# work out extended tail extension (i.e. matching tail re)
+
+		my ($file_prefix,$file_extended_ext) 
+		    = $self->root_ext_split($tail_filename,$associate_tail_re);
+		my ($pre_doc_ext) = ($file_extended_ext =~ m/^(.*)\..*$/);
+
+		my ($doc_ext) = ($tail_filename =~ m/^.*\.(.*)$/);
+		my $start_doclink = "<a href=\"_httpprefix_/collect/[collection]/index/assoc/{Or}{[parent(Top):archivedir],[archivedir]}/$tail_filename\">";
+		my $srcicon = "_icon".$doc_ext."_";
+		my $end_doclink = "</a>";
+
+		my $assoc_form = "$start_doclink\{If\}{$srcicon,$srcicon,$doc_ext\}$end_doclink";
+
+		if (defined $pre_doc_ext) {
+		    # for metadata such as [mp3._edited] [mp3._full] ...
+		    $doc_obj->add_utf8_metadata ($cursection, "$doc_ext.$pre_doc_ext", $assoc_form); 
+		}
+
+		# for multiple metadata such as [mp3.assoclink]
+		$doc_obj->add_utf8_metadata ($cursection, "$doc_ext.assoclink", $assoc_form); 
+		
+		$equiv_form .= " $assoc_form";	
+	    }
+	    $doc_obj->add_utf8_metadata ($cursection, "equivlink", $equiv_form); 
+	}
+	elsif (ref ($metadata->{$field}) eq "ARRAY") {
+	    map { 
+		$doc_obj->add_utf8_metadata ($cursection, $field, $_); 
+	    } @{$metadata->{$field}};
+	} else {
+	    $doc_obj->add_utf8_metadata ($cursection, $field, $metadata->{$field}); 
+	}
+    }
+}
+
+# initialise metadata extractors
+sub initialise_extractors {
+    my $self = shift (@_);
+
+    if ($self->{'extract_acronyms'} || $self->{'markup_acronyms'}) {
+	&acronym::initialise_acronyms();
+    }
+}
+
+# finalise metadata extractors
+sub finalise_extractors {
+    my $self = shift (@_);
+
+    if ($self->{'extract_acronyms'} || $self->{'markup_acronyms'}) {
+	&acronym::finalise_acronyms();
+    }
+}
+
+# FIRSTNNN: extract the first NNN characters as metadata
+sub extract_first_NNNN_characters {
+    my $self = shift (@_);
+    my ($textref, $doc_obj, $thissection) = @_;
+    
+    foreach my $size (split /,/, $self->{'first'}) {
+	my $tmptext =  $$textref;
+	$tmptext =~ s/^\s+//;
+	$tmptext =~ s/\s+$//;
+	$tmptext =~ s/\s+/ /gs;
+	$tmptext = substr ($tmptext, 0, $size);
+	$tmptext =~ s/\s\S*$/&#8230;/;
+	$doc_obj->add_utf8_metadata ($thissection, "First$size", $tmptext);
+    }
+}
+
+sub extract_email {
+    my $self = shift (@_);
+    my ($textref, $doc_obj, $thissection) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    gsprintf($outhandle, " {BasPlug.extracting_emails}...\n")
+	if ($self->{'verbosity'} > 2);
+    
+    my @email = ($$textref =~ m/([-a-z0-9\.@+_=]+@(?:[-a-z0-9]+\.)+(?:com|org|edu|mil|int|net|[a-z][a-z]))/g);
+    @email = sort @email;
+    
+#    if($self->{"new_extract_email"} == 0)
+#    {
+#    my @email2 = ();
+#    foreach my $address (@email) 
+#   {
+#	if (!(join(" ",@email2) =~ m/(^| )$address( |$)/ )) 
+#	    {
+#		push @email2, $address;
+#		$doc_obj->add_utf8_metadata ($thissection, "emailAddress", $address);
+#		# print $outhandle "  extracting $address\n" 
+#		&gsprintf($outhandle, "  {BasPlug.extracting} $address\n")
+#		    if ($self->{'verbosity'} > 3);
+#	    }
+#	}
+#    }
+#    else
+#    {
+    my $hashExistMail = {};
+    foreach my $address (@email) {
+	if (!(defined $hashExistMail->{$address}))
+	{
+	    $hashExistMail->{$address} = 1;
+	    $doc_obj->add_utf8_metadata ($thissection, "emailAddress", $address);
+	    gsprintf($outhandle, "  {BasPlug.extracting} $address\n")
+		if ($self->{'verbosity'} > 3);
+	}
+    }
+    gsprintf($outhandle, " {BasPlug.done_email_extract}\n")
+	if ($self->{'verbosity'} > 2);
+}
+
+# extract metadata
+sub auto_extract_metadata {
+
+    my $self = shift (@_);
+    my ($doc_obj) = @_;
+    
+    if ($self->{'extract_email'}) {
+	my $thissection = $doc_obj->get_top_section();
+	while (defined $thissection) {
+	    my $text = $doc_obj->get_text($thissection);
+	    $self->extract_email (\$text, $doc_obj, $thissection) if $text =~ /./;
+	    $thissection = $doc_obj->get_next_section ($thissection);
+	}
+    } 
+    if ($self->{'extract_placenames'}) {
+	my $thissection = $doc_obj->get_top_section();
+	while (defined $thissection) {
+	    my $text = $doc_obj->get_text($thissection);
+	    $self->extract_placenames (\$text, $doc_obj, $thissection) if $text =~ /./;
+	    $thissection = $doc_obj->get_next_section ($thissection);
+	}
+    } 
+
+    if ($self->{'extract_keyphrases'} || $self->{'extract_keyphrases_kea4'}) {
+	$self->extract_keyphrases($doc_obj);
+    }
+
+    if ($self->{'first'}) {
+	my $thissection = $doc_obj->get_top_section();
+	while (defined $thissection) {
+	    my $text = $doc_obj->get_text($thissection);
+	    $self->extract_first_NNNN_characters (\$text, $doc_obj, $thissection) if $text =~ /./;
+	    $thissection = $doc_obj->get_next_section ($thissection);
+	}
+    }   
+    
+    if ($self->{'extract_acronyms'}) {
+	my $thissection = $doc_obj->get_top_section();
+	while (defined $thissection) {
+	    my $text = $doc_obj->get_text($thissection);
+	    $self->extract_acronyms (\$text, $doc_obj, $thissection) if $text =~ /./;
+	    $thissection = $doc_obj->get_next_section ($thissection);
+	}
+    }
+    
+    if ($self->{'markup_acronyms'}) {
+	my $thissection = $doc_obj->get_top_section();
+	while (defined $thissection) {
+	    my $text = $doc_obj->get_text($thissection);
+	    $text = $self->markup_acronyms ($text, $doc_obj, $thissection);
+	    $doc_obj->delete_text($thissection);
+	    $doc_obj->add_text($thissection, $text);
+	    $thissection = $doc_obj->get_next_section ($thissection);
+	}
+    }
+
+    if($self->{'extract_historical_years'}) {
+	my $thissection = $doc_obj->get_top_section();
+	while (defined $thissection) {
+
+	    my $text = $doc_obj->get_text($thissection);
+	    &DateExtract::get_date_metadata($text, $doc_obj, 
+					    $thissection, 
+					    $self->{'no_bibliography'}, 
+					    $self->{'maximum_year'}, 
+					    $self->{'maximum_century'});
+	    $thissection = $doc_obj->get_next_section ($thissection);
+	}
+    }
+}
+
+
+#adding kea keyphrases
+sub extract_keyphrases
+{
+    my $self = shift(@_);
+    my $doc_obj = shift(@_);
+
+    # Use Kea 3.0 unless 4.0 has been specified
+    my $kea_version = "3.0";
+    if ($self->{'extract_keyphrases_kea4'}) {
+	$kea_version = "4.0";
+    }
+
+    # Check that Kea exists, and tell the user where to get it if not
+    my $keahome = &Kea::get_Kea_directory($kea_version);
+    if (!-e $keahome) {
+	gsprintf(STDERR, "{BasPlug.missing_kea}\n", $keahome, $kea_version);
+	return;
+    }
+
+    my $thissection = $doc_obj->get_top_section();
+    my $text = "";
+    my $list;
+
+    #loop through sections to gather whole doc
+    while (defined $thissection) { 
+	my $sectiontext = $doc_obj->get_text($thissection);   
+	$text = $text.$sectiontext;
+	$thissection = $doc_obj->get_next_section ($thissection);
+    } 
+   
+    if($self->{'extract_keyphrase_options'}) { #if kea options flag is set, call Kea with specified options 
+	$list = &Kea::extract_KeyPhrases ($kea_version, $text, $self->{'extract_keyphrase_options'});
+    } else { #otherwise call Kea with no options
+	$list = &Kea::extract_KeyPhrases ($kea_version, $text);
+    }
+ 
+    if ($list){
+	# if a list of kea keyphrases was returned (ie not empty)
+	if ($self->{'verbosity'}) {
+	    gsprintf(STDERR, "{BasPlug.keyphrases}: $list\n");
+	}
+
+	#add metadata to top section
+	$thissection = $doc_obj->get_top_section(); 
+
+	# add all key phrases as one metadata
+	$doc_obj->add_metadata($thissection, "Keyphrases", $list);
+
+	# add individual key phrases as multiple metadata
+	foreach my $keyphrase (split(',', $list)) {
+	    $keyphrase =~ s/^\s+|\s+$//g;
+	    $doc_obj->add_metadata($thissection, "Keyphrase", $keyphrase);
+	}
+    }
+}
+
+
+# extract acronyms from a section in a document. progress is 
+# reported to outhandle based on the verbosity. both the Acronym
+# and the AcronymKWIC metadata items are created. 
+
+sub extract_acronyms {
+    my $self = shift (@_);
+    my ($textref, $doc_obj, $thissection) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    # print $outhandle " extracting acronyms ...\n" 
+    gsprintf($outhandle, " {BasPlug.extracting_acronyms}...\n")
+	if ($self->{'verbosity'} > 2);
+
+    my $acro_array =  &acronym::acronyms($textref);
+    
+    foreach my $acro (@$acro_array) {
+
+	#check that this is the first time ...
+	my $seen_before = "false";
+	my $previous_data = $doc_obj->get_metadata($thissection, "Acronym");
+	foreach my $thisAcro (@$previous_data) {
+	    if ($thisAcro eq $acro->to_string()) {
+		$seen_before = "true";
+		if ($self->{'verbosity'} >= 4) {
+		    gsprintf($outhandle, " {BasPlug.already_seen} " .
+			     $acro->to_string() . "\n");
+		}
+	    }
+	}
+
+	if ($seen_before eq "false") {
+	    #write it to the file ...
+	    $acro->write_to_file();
+
+	    #do the normal acronym
+	    $doc_obj->add_utf8_metadata($thissection, "Acronym",  $acro->to_string());
+	    gsprintf($outhandle, " {BasPlug.adding} ".$acro->to_string()."\n")
+		if ($self->{'verbosity'} > 3);
+	}
+    }
+
+    gsprintf($outhandle, " {BasPlug.done_acronym_extract}\n")
+	if ($self->{'verbosity'} > 2);
+}
+
+sub markup_acronyms {
+    my $self = shift (@_);
+    my ($text, $doc_obj, $thissection) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    gsprintf($outhandle, " {BasPlug.marking_up_acronyms}...\n")
+	if ($self->{'verbosity'} > 2);
+
+    #self is passed in to check for verbosity ...
+    $text = &acronym::markup_acronyms($text, $self);
+
+    gsprintf($outhandle, " {BasPlug.done_acronym_markup}\n")
+	if ($self->{'verbosity'} > 2);
+
+    return $text;
+}
+
+sub compile_stats {
+    my $self = shift(@_);
+    my ($stats) = @_;
+
+    $stats->{'num_processed'} += $self->{'num_processed'};
+    $stats->{'num_not_processed'} += $self->{'num_not_processed'};
+    $stats->{'num_archives'} += $self->{'num_archives'};
+
+}
+
+sub associate_cover_image {
+    my $self = shift;
+    my ($doc_obj, $filename) = @_;
+
+    $filename =~ s/\.[^\\\/\.]+$/\.jpg/;
+    if (exists $self->{'covers_missing_cache'}->{$filename}) {
+	# don't stat() for existence eg for multiple document input files
+	# (eg SplitPlug)
+	return;
+    }
+
+    my $top_section=$doc_obj->get_top_section();
+
+    if (-e $filename) {
+    	$doc_obj->associate_file($filename, "cover.jpg", "image/jpeg");
+	$doc_obj->add_utf8_metadata($top_section, "hascover",  1);
+    } else {
+	my $upper_filename = $filename;
+	$upper_filename =~ s/jpg$/JPG/;
+	if (-e $upper_filename) {
+	    $doc_obj->associate_file($upper_filename, "cover.jpg",
+				     "image/jpeg");
+	    $doc_obj->add_utf8_metadata($top_section, "hascover",  1);
+	} else {
+	    # file doesn't exist, so record the fact that it's missing so
+	    # we don't stat() again (stat is slow)
+	    $self->{'covers_missing_cache'}->{$filename} = 1;
+	}
+    }
+
+}
+
+
+# Overridden by exploding plugins (eg. ISISPlug)
+sub clean_up_after_exploding
+{
+    my $self = shift(@_);
+}
+
+
+1;
Index: dl/trunk/perllib/plugins/BookPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/BookPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,248 +1,0 @@
-###########################################################################
-#
-# BookPlug.pm (formally called HBSPlug) -- plugin for processing simple
-# html (or text) books
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999 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.
-#
-###########################################################################
-
-# creates multi-level document from document containing 
-# <<TOC>> level tags. Metadata for each section is taken from any
-# other tags on the same line as the <<TOC>>. e.g. <<Title>>xxxx<</Title>>
-# sets Title metadata.
-
-# Everything else between TOC tags is treated as simple html (i.e. no 
-# processing of html links or any other HTMLPlug type stuff is done).
-
-# expects input files to have a .hb file extension by default (this can be 
-# changed by adding a -process_exp option
-
-# a file with the same name as the hb file but a .jpg extension is
-# taken as the cover image (jpg files are blocked by this plugin)
-
-# BookPlug is a simplification (and extension) of the HBPlug used
-# by the Humanity Library collections. BookPlug is faster as it expects
-# the input files to be cleaner (The input to the HDL collections
-# contains lots of excess html tags around <<TOC>> tags, uses <<I>>
-# tags to specify images, and simply takes all text between <<TOC>>
-# tags and start of text to be Title metadata). If you're marking up
-# documents to be displayed in the same way as the HDL collections,
-# use this plugin instead of HBPlug.
-
-# 12/05/02 Added usage datastructure - John Thompson
-
-package BookPlug;
-
-use BasPlug;
-use util;
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @BookPlug::ISA = ('BasPlug');
-}
-
-my $arguments = 
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_process_exp() },
-      { 'name' => "block_exp",
-	'desc' => "{BasPlug.block_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_block_exp() } ];
-
-my $options = { 'name'     => "BookPlug",
-		'desc'     => "{BookPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-sub get_default_block_exp {
-    my $self = shift (@_);
-
-    return q^\.jpg$^;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)\.hb$^;
-}
-
-# do plugin specific processing of doc_obj
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    print STDERR "<Processing n='$file' p='BookPlug'>\n" if ($gli);
-    print $outhandle "BookPlug: processing $file\n" 
-	if $self->{'verbosity'} > 1;
-    
-    my $cursection = $doc_obj->get_top_section();
-
-    # Add FileFormat as the metadata
-    $doc_obj->add_metadata($doc_obj->get_top_section(),"FileFormat", "Book");
-
-    my $filename = &util::filename_cat($base_dir, $file);
-    my $absdir = $filename;
-    $absdir =~ s/[^\/\\]*$//;
-
-    # add the cover image
-    my $coverimage = $filename;
-    $coverimage =~ s/\.[^\.]*$/\.jpg/i;
-    $doc_obj->associate_file($coverimage, "cover.jpg", "image/jpeg");
-
-    my $title = "";
-
-    # remove any leading rubbish
-    $$textref =~ s/^.*?(<<TOC)/$1/ios;
-    
-    my $curtoclevel = 1;
-    my $firstsection = 1;
-    my $toccount = 0;
-    while ($$textref =~ /\w/) {
-	$$textref =~ s/^<<TOC(\d+)>>([^\n]*)\n(.*?)(<<TOC|\Z)/$4/ios;
-	my $toclevel = $1;
-	my $metadata = $2;
-	my $sectiontext = $3;
-
-	if ($toclevel == 2) {
-	    $toccount ++;
-	}
-	
-	# close any sections below the current level and
-	# create a new section (special case for the firstsection)
-	while (($curtoclevel > $toclevel) ||
-	       (!$firstsection && $curtoclevel == $toclevel)) {
-	    $cursection = $doc_obj->get_parent_section ($cursection);
-	    $curtoclevel--;
-	}
-	if ($curtoclevel+1 < $toclevel) {
-	    print $outhandle "WARNING - jump in toc levels in $filename " . 
-		"from $curtoclevel to $toclevel\n";
-	}
-	while ($curtoclevel < $toclevel) {
-	    $curtoclevel++;
-	    $cursection = 
-		$doc_obj->insert_section($doc_obj->get_end_child($cursection));
-	}
-
-	# sort out metadata
-	while ($metadata =~ s/^.*?<<([^>]*)>>(.*?)<<[^>]*>>//) {
-	    my $metakey = $1;
-	    my $metavalue = $2;
-
-	    if ($metavalue ne "" && $metakey ne "") {
-		# make sure key fits in with gsdl naming scheme 
-		$metakey =~ tr/[A-Z]/[a-z]/;
-		$metakey = ucfirst ($metakey);
-		$doc_obj->add_utf8_metadata ($cursection, $metakey, $metavalue);
-	    }
-	}
-
-	# remove header rubbish
-	$sectiontext =~ s/^.*?<body[^>]*>//ios;
-
-	# and any other unwanted tags
-	$sectiontext =~ s/<(\/p|\/html|\/body)>//isg;
-
-	# fix up the image links
-	$sectiontext =~ s/(<img[^>]*?src\s*=\s*\"?)([^\">]+)(\"?[^>]*>)/
-	    &replace_image_links($absdir, $doc_obj, $1, $2, $3)/isge;
-
-	# add the text
-	$doc_obj->add_utf8_text($cursection, $sectiontext);
-
-	$firstsection = 0;
-
-	$$textref =~ s/^\s+//s;
-    }
-
-    return 1;
-}
-
-sub replace_image_links {
-    my $self = shift (@_);
-    my ($dir, $doc_obj, $front, $link, $back) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    my ($filename, $error);
-    my $foundimage = 0;
-    
-    $link =~ s/\/\///;
-    my ($imagetype) = $link =~ /([^\.]*)$/;
-    $imagetype =~ tr/[A-Z]/[a-z]/;
-    if ($imagetype eq "jpg") {$imagetype = "jpeg";}
-    if ($imagetype !~ /^(jpeg|gif|png)$/) {
-	print $outhandle "BookPlug: Warning - unknown image type ($imagetype)\n";
-    }
-    my ($imagefile) = $link =~ /([^\/]*)$/;
-    my ($imagepath) = $link =~ /^[^\/]*(.*)$/;
-
-    if (defined $imagepath && $imagepath =~ /\w/) {
-	# relative link
-	$filename = &util::filename_cat ($dir, $imagepath);
-	if (-e $filename) {
-	    $doc_obj->associate_file ($filename, $imagefile, "image/$imagetype");
-	    $foundimage = 1;
-	} else {
-	    $error = "BookPlug: Warning - couldn't find image file $imagefile in either $filename or";
-	}
-    }
-
-    if (!$foundimage) {
-	$filename = &util::filename_cat ($dir, $imagefile);
-	if (-e $filename) {
-	    $doc_obj->associate_file ($filename, $imagefile, "image/$imagetype");    
-	    $foundimage = 1;
-	} elsif (defined $error) {
-	    print $outhandle "$error $filename\n";
-	} else {
-	    print $outhandle "BookPlug: Warning - couldn't find image file $imagefile in $filename\n";
-	}
-    }
-
-    if ($foundimage) {
-	return "${front}_httpdocimg_/${imagefile}${back}";
-    } else {
-	return "";
-    }
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/BookPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/BookPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/BookPlugin.pm	(revision 15865)
@@ -0,0 +1,248 @@
+###########################################################################
+#
+# BookPlug.pm (formally called HBSPlug) -- plugin for processing simple
+# html (or text) books
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999 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.
+#
+###########################################################################
+
+# creates multi-level document from document containing 
+# <<TOC>> level tags. Metadata for each section is taken from any
+# other tags on the same line as the <<TOC>>. e.g. <<Title>>xxxx<</Title>>
+# sets Title metadata.
+
+# Everything else between TOC tags is treated as simple html (i.e. no 
+# processing of html links or any other HTMLPlug type stuff is done).
+
+# expects input files to have a .hb file extension by default (this can be 
+# changed by adding a -process_exp option
+
+# a file with the same name as the hb file but a .jpg extension is
+# taken as the cover image (jpg files are blocked by this plugin)
+
+# BookPlug is a simplification (and extension) of the HBPlug used
+# by the Humanity Library collections. BookPlug is faster as it expects
+# the input files to be cleaner (The input to the HDL collections
+# contains lots of excess html tags around <<TOC>> tags, uses <<I>>
+# tags to specify images, and simply takes all text between <<TOC>>
+# tags and start of text to be Title metadata). If you're marking up
+# documents to be displayed in the same way as the HDL collections,
+# use this plugin instead of HBPlug.
+
+# 12/05/02 Added usage datastructure - John Thompson
+
+package BookPlug;
+
+use BasPlug;
+use util;
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @BookPlug::ISA = ('BasPlug');
+}
+
+my $arguments = 
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_process_exp() },
+      { 'name' => "block_exp",
+	'desc' => "{BasPlug.block_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_block_exp() } ];
+
+my $options = { 'name'     => "BookPlug",
+		'desc'     => "{BookPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+sub get_default_block_exp {
+    my $self = shift (@_);
+
+    return q^\.jpg$^;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)\.hb$^;
+}
+
+# do plugin specific processing of doc_obj
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    print STDERR "<Processing n='$file' p='BookPlug'>\n" if ($gli);
+    print $outhandle "BookPlug: processing $file\n" 
+	if $self->{'verbosity'} > 1;
+    
+    my $cursection = $doc_obj->get_top_section();
+
+    # Add FileFormat as the metadata
+    $doc_obj->add_metadata($doc_obj->get_top_section(),"FileFormat", "Book");
+
+    my $filename = &util::filename_cat($base_dir, $file);
+    my $absdir = $filename;
+    $absdir =~ s/[^\/\\]*$//;
+
+    # add the cover image
+    my $coverimage = $filename;
+    $coverimage =~ s/\.[^\.]*$/\.jpg/i;
+    $doc_obj->associate_file($coverimage, "cover.jpg", "image/jpeg");
+
+    my $title = "";
+
+    # remove any leading rubbish
+    $$textref =~ s/^.*?(<<TOC)/$1/ios;
+    
+    my $curtoclevel = 1;
+    my $firstsection = 1;
+    my $toccount = 0;
+    while ($$textref =~ /\w/) {
+	$$textref =~ s/^<<TOC(\d+)>>([^\n]*)\n(.*?)(<<TOC|\Z)/$4/ios;
+	my $toclevel = $1;
+	my $metadata = $2;
+	my $sectiontext = $3;
+
+	if ($toclevel == 2) {
+	    $toccount ++;
+	}
+	
+	# close any sections below the current level and
+	# create a new section (special case for the firstsection)
+	while (($curtoclevel > $toclevel) ||
+	       (!$firstsection && $curtoclevel == $toclevel)) {
+	    $cursection = $doc_obj->get_parent_section ($cursection);
+	    $curtoclevel--;
+	}
+	if ($curtoclevel+1 < $toclevel) {
+	    print $outhandle "WARNING - jump in toc levels in $filename " . 
+		"from $curtoclevel to $toclevel\n";
+	}
+	while ($curtoclevel < $toclevel) {
+	    $curtoclevel++;
+	    $cursection = 
+		$doc_obj->insert_section($doc_obj->get_end_child($cursection));
+	}
+
+	# sort out metadata
+	while ($metadata =~ s/^.*?<<([^>]*)>>(.*?)<<[^>]*>>//) {
+	    my $metakey = $1;
+	    my $metavalue = $2;
+
+	    if ($metavalue ne "" && $metakey ne "") {
+		# make sure key fits in with gsdl naming scheme 
+		$metakey =~ tr/[A-Z]/[a-z]/;
+		$metakey = ucfirst ($metakey);
+		$doc_obj->add_utf8_metadata ($cursection, $metakey, $metavalue);
+	    }
+	}
+
+	# remove header rubbish
+	$sectiontext =~ s/^.*?<body[^>]*>//ios;
+
+	# and any other unwanted tags
+	$sectiontext =~ s/<(\/p|\/html|\/body)>//isg;
+
+	# fix up the image links
+	$sectiontext =~ s/(<img[^>]*?src\s*=\s*\"?)([^\">]+)(\"?[^>]*>)/
+	    &replace_image_links($absdir, $doc_obj, $1, $2, $3)/isge;
+
+	# add the text
+	$doc_obj->add_utf8_text($cursection, $sectiontext);
+
+	$firstsection = 0;
+
+	$$textref =~ s/^\s+//s;
+    }
+
+    return 1;
+}
+
+sub replace_image_links {
+    my $self = shift (@_);
+    my ($dir, $doc_obj, $front, $link, $back) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    my ($filename, $error);
+    my $foundimage = 0;
+    
+    $link =~ s/\/\///;
+    my ($imagetype) = $link =~ /([^\.]*)$/;
+    $imagetype =~ tr/[A-Z]/[a-z]/;
+    if ($imagetype eq "jpg") {$imagetype = "jpeg";}
+    if ($imagetype !~ /^(jpeg|gif|png)$/) {
+	print $outhandle "BookPlug: Warning - unknown image type ($imagetype)\n";
+    }
+    my ($imagefile) = $link =~ /([^\/]*)$/;
+    my ($imagepath) = $link =~ /^[^\/]*(.*)$/;
+
+    if (defined $imagepath && $imagepath =~ /\w/) {
+	# relative link
+	$filename = &util::filename_cat ($dir, $imagepath);
+	if (-e $filename) {
+	    $doc_obj->associate_file ($filename, $imagefile, "image/$imagetype");
+	    $foundimage = 1;
+	} else {
+	    $error = "BookPlug: Warning - couldn't find image file $imagefile in either $filename or";
+	}
+    }
+
+    if (!$foundimage) {
+	$filename = &util::filename_cat ($dir, $imagefile);
+	if (-e $filename) {
+	    $doc_obj->associate_file ($filename, $imagefile, "image/$imagetype");    
+	    $foundimage = 1;
+	} elsif (defined $error) {
+	    print $outhandle "$error $filename\n";
+	} else {
+	    print $outhandle "BookPlug: Warning - couldn't find image file $imagefile in $filename\n";
+	}
+    }
+
+    if ($foundimage) {
+	return "${front}_httpdocimg_/${imagefile}${back}";
+    } else {
+	return "";
+    }
+}
+
+1;
Index: dl/trunk/perllib/plugins/CONTENTdmPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/CONTENTdmPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,896 +1,0 @@
-###########################################################################
-#
-# CONTENTdmPlug.pm -- reasonably with-it pdf plugin
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999-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.
-#
-###########################################################################
-package CONTENTdmPlug;
-
-use ConvertToPlug;
-use unicode;
-use ghtml;
-
-use strict;
-no strict 'refs'; # so we can use a var for filehandles (eg STDERR)
-
-
-use XMLParser;
-
-sub BEGIN {
-    @CONTENTdmPlug::ISA = ('ConvertToPlug');
-}
-
-
-my $convert_to_list =
-    [ {	'name' => "auto",
-	'desc' => "{ConvertToPlug.convert_to.auto}" },
-      {	'name' => "html",
-	'desc' => "{ConvertToPlug.convert_to.html}" },
-      {	'name' => "text",
-	'desc' => "{ConvertToPlug.convert_to.text}" },
-      { 'name' => "pagedimg",
-	'desc' => "{ConvertToPlug.convert_to.pagedimg}"},
-      ];
-
-
-
-my $arguments = 
-      [
-       { 'name' => "convert_to",
-	'desc' => "{ConvertToPlug.convert_to}",
-	'type' => "enum",
-	'reqd' => "yes",
-	'list' => $convert_to_list, 
-	'deft' => "html" },	 
-      { 'name' => "xslt",
-	'desc' => "{XMLPlug.xslt}",
-	'type' => "string",
-	'deft' => "",
-	'reqd' => "no" },
-       { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" },
-      { 'name' => "block_exp",
-	'desc' => "{BasPlug.block_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_block_exp() }
-];
-
-my $options = { 'name'     => "CONTENTdmPlug",
-		'desc'     => "{CONTENTdmPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		# CONTENTdmPlug is one of the few ConvertToPlug subclasses whose source doc can't be replaced by a GS-generated html
-		'srcreplaceable' => "no",
-		'args'     => $arguments };
-
-our ($self);
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    push(@$inputargs,"-title_sub");
-    push(@$inputargs,'^(Page\s+\d+)?(\s*1\s+)?');
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my @arg_array = @$inputargs;
-    $self = (defined $hashArgOptLists)? new ConvertToPlug($pluginlist,$inputargs,$hashArgOptLists): new ConvertToPlug($pluginlist,$inputargs);
-    
-    if ($self->{'info_only'}) {
-	# don't worry about any options etc
-	return bless $self, $class;
-    }
-
-    my $parser = new XML::Parser('Style' => 'Stream',
-				 'Handlers' => {'Char' => \&Char,
-						'XMLDecl' => \&XMLDecl,
-						'Entity' => \&Entity,
-						'Doctype' => \&Doctype,
-						'Default' => \&Default
-						});  
-    $self->{'parser'} = $parser;
-    $self->{'rdf_desc'} = undef;
-    $self->{'about_key'} = undef;
-    $self->{'metadata_name'} = undef;
-    $self->{'metadata_value'} = undef;
-
-    $self->{'convert_to'} = "PagedImg";
-    my $secondary_plugin_options = $self->{'secondary_plugin_options'};
-
-    if (!defined $secondary_plugin_options->{'PagedImgPlug'}){
-	$secondary_plugin_options->{'PagedImgPlug'} = [];
-	my $pagedimg_options = $secondary_plugin_options->{'PagedImgPlug'}; 
-	push(@$pagedimg_options, "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
-	push(@$pagedimg_options, "-thumbnail", "-screenview");
-    }
-
-    $self = bless $self, $class;
-    $self->load_secondary_plugins($class,$secondary_plugin_options,$hashArgOptLists);
-    return $self;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)\.rdf$^;
-}
-
-# so we don't inherit HTMLPlug's block exp...
-sub get_default_block_exp {
-    return q^(?i)\.(jpg|jpeg|gif)$^;
-}
-
-
-
-
-# A smarter (?) option would be to add XMLPlug into inheritence above
-# thereby avoiding a fair amount of code duplication
-
-sub apply_xslt
-{
-    my $self = shift @_;
-    my ($xslt,$filename) = @_;
-    
-    my $outhandle = $self->{'outhandle'};
-
-    my $xslt_filename = $xslt;
-
-    if (! -e $xslt_filename) {
-	# Look in main site directory
-	my $gsdlhome = $ENV{'GSDLHOME'};
-	$xslt_filename = &util::filename_cat($gsdlhome,$xslt);
-    }
-
-    if (! -e $xslt_filename) {
-	# Look in collection directory
-	my $coldir = $ENV{'GSDLCOLLECTDIR'};
-	$xslt_filename = &util::filename_cat($coldir,$xslt);
-    }
-
-    if (! -e $xslt_filename) {
-	print $outhandle "Warning: Unable to find XSLT $xslt\n";
-	if (open(XMLIN,"<$filename")) {
-
-	    my $untransformed_xml = "";
-	    while (defined (my $line = <XMLIN>)) {
-
-		$untransformed_xml .= $line;
-	    }
-	    close(XMLIN);
-	    
-	    return $untransformed_xml;
-	}
-	else {
-	    print $outhandle "Error: Unable to open file $filename\n";
-	    print $outhandle "       $!\n";
-	    return "";
-	}
-	
-    }
-
-    my $bin_java = &util::filename_cat($ENV{'GSDLHOME'},"bin","java");
-    my $jar_filename = &util::filename_cat($bin_java,"xalan.jar");
-    my $xslt_base_cmd = "java -jar $jar_filename";
-    my $xslt_cmd = "$xslt_base_cmd -IN \"$filename\" -XSL \"$xslt_filename\"";
-
-    my $transformed_xml = "";
-
-    if (open(XSLT_IN,"$xslt_cmd |")) {
-	while (defined (my $line = <XSLT_IN>)) {
-
-	    $transformed_xml .= $line;
-	}
-	close(XSLT_IN);
-    }
-    else {
-	print $outhandle "Error: Unable to run command $xslt_cmd\n";
-	print $outhandle "       $!\n";
-    }
-
-    return $transformed_xml;
-
-}
-
-
-
-sub rdf_desc_to_id
-{
-    my $self = shift (@_);
-    my ($rdf_desc) = @_;
-
-    my $rdf_id = {};
-
-    # initialise any .cpd (=complex multi page) structures 
-
-    foreach my $about_key (keys %{$rdf_desc}) {
-	if ($about_key =~ m/\.cpd$/) {
-	    my $about = $rdf_desc->{$about_key};
-	    my $id    = $about->{'dc:identifier'};
-
-	    if ($id =~ m/^\s*$/) {
-		# missing id, make one up based on about attribute
-
-		my ($tailname, $dirname, $suffix)
-		    = &File::Basename::fileparse($about_key, "\\.[^\\.]+\$");
-
-		$id = "about:$tailname";
-	    }
-
-	    $rdf_id->{$id} = $about;
-	    $rdf_id->{$id}->{'ex:filename'} = $about_key;
-	    $rdf_id->{$id}->{'ex:type'} = "complex";
-	    $rdf_id->{$id}->{'pages'} = [];
-	}
-
-    }
-
-    # now add in *non* .cpd items
-
-    foreach my $about_key (keys %{$rdf_desc}) {
-	if ($about_key !~ m/\.cpd$/) {
-	    my $about = $rdf_desc->{$about_key};	    
-	    my $id    = $about->{'dc:identifier'};
-
-
-	    if ($id =~ m/^\s*$/) {
-		# missing id, make one up based on about attribute
-
-		my ($tailname, $dirname, $suffix)
-		    = &File::Basename::fileparse($about_key, "\\.[^\\.]+\$");
-
-		$id = "about:$tailname";
-	    }
-
-	    if (defined $rdf_id->{$id}) {
-		$about->{'ex:filename'} = $about_key;
-
-		# dealing with complex multi-page situation
-		# Add to existing structure
-
-		my $pages = $rdf_id->{$id}->{'pages'};
-		push(@$pages,$about)
-	    }
-	    else {
-		# New entry
-
-		$rdf_id->{$id} = $about;
-		$rdf_id->{$id}->{'ex:type'} = "simple";	    
-		$rdf_id->{$id}->{'ex:filename'} = $about_key;
-	    }
-	}
-	
-    }
-
-    return $rdf_id;
-}
-
-
-sub metadata_table_txt_file
-{
-    my $self = shift (@_);
-    my ($output_root,$page_num) = @_;
-
-    my $txt_filename = $output_root."_page_$page_num.txt";
-
-    my ($tailname, $dirname, $suffix)
-	= &File::Basename::fileparse($txt_filename, "\\.[^\\.]+\$");
-
-    my $txt_file = "$tailname.$suffix";
-
-    return $txt_file;
-}
-
-
-sub output_metadata_table 
-{
-    my $self = shift (@_);
-    my ($page,$page_num,$tmp_dirname,$txt_file) = @_;
-    
-    my $txt_filename = &util::filename_cat($tmp_dirname,$txt_file);
-
-    open(TOUT,">$txt_filename") 
-	|| die "Error: unable to write metadata data out as txt file $txt_filename: $!\n";
-    
-    print TOUT $page->{'MetadataTable'};
-    delete $page->{'MetadataTable'};
-
-    close (TOUT);
-}
-
-
-sub rdf_id_to_item_file
-{
-    my $self = shift (@_);
-    my ($rdf_id,$tmp_dirname,$output_root) = @_;
-
-    my $item_file_list = [];
-    
-    foreach my $id (keys %{$rdf_id}) {
-
-	my $id_safe = $id;
-	$id_safe =~ s/ /-/g;
-
-	my $output_filename = $output_root."_$id_safe.item";
-	open(FOUT,">$output_filename") 
-	    || die "Unable to open $output_filename: $!\n";
-	
-
-	print FOUT "<PagedDocument>\n";
-
-	my $rdf_doc = $rdf_id->{$id};
-	foreach my $metadata_name (keys %$rdf_doc) {
-
-
-	    next if ($metadata_name eq "pages");
-
-	    my $metadata_value = $rdf_doc->{$metadata_name};
-
-	    # convert ns:name to ns.Name
-	    $metadata_name =~ s/^(.*?):(.*)/$1\.\u$2/; 
-
-	    print FOUT "  <Metadata name=\"$metadata_name\">$metadata_value</Metadata>\n";
-	}
-
-	if ($rdf_doc->{'ex:type'} eq "complex") {
-	    my $pages = $rdf_doc->{'pages'};
-	    my $page_num = 1;
-
-	    foreach my $page (@$pages) {
-
-		my $imgfile = $page->{'ex:filename'};
-		if ($imgfile =~ m/(http|ftp):/) {
-		    $imgfile = "empty.jpg";
-		}
-		else {
-		    $imgfile = &util::filename_cat("..","import",$imgfile);
-		}
-		
-		my $txt_file 
-		    = $self->metadata_table_txt_file($output_root,$page_num);
-
-		$self->output_metadata_table($page,$page_num,
-					     $tmp_dirname,$txt_file);
-
-
-		print FOUT "  <Page pagenum=\"$page_num\" imgfile=\"$imgfile\" txtfile=\"$txt_file\">\n";
-
-		foreach my $metadata_name (keys %$page) {
-		
-		    my $metadata_value = $rdf_doc->{$metadata_name};
-		    # convert ns:name to ns.Name
-		    $metadata_name =~ s/^(.*?):(.*)/$1\.\u$2/; 
-
-		    print FOUT "  <Metadata name=\"$metadata_name\">$metadata_value</Metadata>\n";
-		}
-		
-
-		$page_num++;
-
-
-		print FOUT "  </Page>\n";
-	    }
-	}
-	else {
-	    # simple
-	    # duplicate top-level metadata for now plus image to bind to
-
-	    my $imgfile = $rdf_doc->{'ex:filename'};
-	    if ($imgfile =~ m/(http|ftp):/) {
-		$imgfile = "empty.jpg";
-	    }
-	    else {
-		$imgfile = &util::filename_cat("..","import",$imgfile);
-		$imgfile = "../import/".$imgfile;
-	    }
-
-
-	    my $txt_file = $self->metadata_table_txt_file($output_root,1);
-	    $self->output_metadata_table($rdf_doc,1,$tmp_dirname,$txt_file);
-
-	    print FOUT "  <Page pagenum=\"1\" imgfile=\"$imgfile\" txtfile=\"$txt_file\">\n";	    
-	    foreach my $metadata_name (keys %$rdf_doc) {
-
-		my $metadata_value = $rdf_doc->{$metadata_name};
-		
-		# convert ns:name to ns.Name
-		$metadata_name =~ s/^(.*?):(.*)/$1\.\u$2/; 
-
-		print FOUT "  <Metadata name=\"$metadata_name\">$metadata_value</Metadata>\n";
-	    }
-	    print FOUT "  </Page>\n";
-
-	}
-
-	print FOUT "</PagedDocument>\n";
-	close(FOUT);
-
-	push(@$item_file_list,$output_filename);
-
-    }
-    
-
-    return $item_file_list;
-}
-
-
-
-sub xml_area_convert_file
-{
-    my $self = shift (@_);
-    my ($input_filename, $tmp_dirname, $output_root) = @_;
-
-    eval {
-	# Build up hash table/tree of all records
-
-	my $xslt = $self->{'xslt'};
-	if (defined $xslt && ($xslt ne "")) {
-	    # perform xslt
-	    my $transformed_xml = $self->apply_xslt($xslt,$input_filename);
-
-	    # feed transformed file (now in memory as string) into XML parser
-	    $self->{'parser'}->parse($transformed_xml);
-	}
-	else {
-	    $self->{'parser'}->parsefile($input_filename);
-	}
-    };
-  
-    if ($@) {
-
-	# parsefile may either croak somewhere in XML::Parser (e.g. because
-	# the document is not well formed) or die somewhere in XMLPlug or a
-	# derived plugin (e.g. because we're attempting to process a
-	# document whose DOCTYPE is not meant for this plugin). For the
-	# first case we'll print a warning and continue, for the second
-	# we'll just continue quietly
-
-	print STDERR "**** Error is: $@\n";
-
-	my $file = $self->{'file'};
-
-	my ($msg) = $@ =~ /Carp::croak\(\'(.*?)\'\)/;
-	if (defined $msg) {	
-	    my $outhandle = $self->{'outhandle'};
-	    my $plugin_name = ref ($self);
-	    print $outhandle "$plugin_name failed to process $file ($msg)\n";
-	}
-
-	my $gli = $self->{'gli'};
-
-	# reset ourself for the next document
-	$self->{'section_level'}=0;
-	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
-	return ("fail",undef); # error during processing
-    }
-
-    my $rdf_desc = $self->{'rdf_desc'};    
-
-#    foreach my $about_key (keys %{$rdf_desc}) {
-#	my $about = $rdf_desc->{$about_key};
-#	foreach my $metadata_name (keys %{$about}) {
-#
-#	    my $metadata_value = $about->{$metadata_name};
-##	    print STDERR " $metadata_name: $metadata_value\n";
-#	}
-#    }
-
-
-    # Merge entries with same name
-
-
-    my $merged_rdf_id = $self->rdf_desc_to_id($rdf_desc);
-
-#    foreach my $about_key (keys %{$merged_rdf_id}) {
-#	my $about = $merged_rdf_id->{$about_key};
-#	foreach my $metadata_name (keys %{$about}) {
-#
-#	    my $metadata_value = $about->{$metadata_name};
-##	    print STDERR " $metadata_name: $metadata_value\n";
-#	}
-#    }
-
-
-
-    my $item_files = $self->rdf_id_to_item_file($merged_rdf_id,$tmp_dirname, 
-						$output_root);
-
-    return ("item",$item_files);
-}
-
-
-# Override ConvertToPlug tmp_area_convert_file() to provide solution specific 
-# to CONTENTdm
-#
-# A better (i.e. in the future) solution would be to see if this can be
-# shifted into gsConvert.pl so there is no need to override the
-# default tmp_area_convert_file()
-
-
-sub tmp_area_convert_file {
-    my $self = shift (@_);
-    my ($output_ext, $input_filename, $textref) = @_;
-
-    # is textref ever used?!?
-
-    my $outhandle = $self->{'outhandle'};
-    my $convert_to = $self->{'convert_to'};
-    my $failhandle = $self->{'failhandle'};
-    my $convert_to_ext = $self->{'convert_to_ext'};
-    
-    # softlink to collection tmp dir
-    my $tmp_dirname 
-	= &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, "tmp");
-    &util::mk_dir($tmp_dirname) if (!-e $tmp_dirname);
-
-    # derive tmp filename from input filename
-    my ($tailname, $dirname, $suffix)
-	= &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
-
-    # Remove any white space from filename -- no risk of name collision, and
-    # makes later conversion by utils simpler. Leave spaces in path...
-    # tidy up the filename with space, dot, hyphen between
-    $tailname =~ s/\s+//g; 
-    $tailname =~ s/\.+//g;
-    $tailname =~ s/\-+//g;
-    $suffix = lc($suffix);
-    my $tmp_filename = &util::filename_cat($tmp_dirname, "$tailname$suffix");
-
-    &util::soft_link($input_filename, $tmp_filename);
-    my $verbosity = $self->{'verbosity'};
-    if ($verbosity > 0) {
-	print $outhandle "Converting $tailname$suffix to $convert_to format\n";
-    }
-
-    my $errlog = &util::filename_cat($tmp_dirname, "err.log");
-    
-    # call xml_area_convert_file rather than gsConvert.pl
-
-    my $output_root = &util::filename_cat($tmp_dirname, "$tailname");
-
-    my ($output_type,$item_files) 
-	= $self->xml_area_convert_file($tmp_filename,$tmp_dirname,$output_root);
-
-
-    my $fakeimg_filename = &util::filename_cat($dirname, "empty.jpg");
-    my $fakeimg_tmp_filename = &util::filename_cat($tmp_dirname, "empty.jpg");
-
-    print STDERR "***** Setting up fake filename $fakeimg_filename -> $fakeimg_tmp_filename\n";
-
-    &util::soft_link($fakeimg_filename, $fakeimg_tmp_filename);
-   
-    # continue as before ...
-
-    # remove symbolic link to original file
-    &util::rm($tmp_filename);
-
-    # Check STDERR here
-    chomp $output_type;
-    if ($output_type eq "fail") {
-	print $outhandle "Could not convert $tailname$suffix to $convert_to format\n";
-	print $failhandle "$tailname$suffix: " . ref($self) . " failed to convert to $convert_to\n";
-	$self->{'num_not_processed'} ++;
-	if (-s "$errlog") {
-	    open(ERRLOG, "$errlog");
-	    while (<ERRLOG>) {
-		print $outhandle "$_";
-	    }
-	    print $outhandle "\n";
-	    close ERRLOG;
-	}
-	&util::rm("$errlog") if (-e "$errlog");
-	return [];
-    }
-
-    # store the *actual* output type and return the output filename
-    # it's possible we requested conversion to html, but only to text succeeded
-    #$self->{'convert_to_ext'} = $output_type;
-    if ($output_type =~ /html/i) {
-	$self->{'converted_to'} = "HTML";
-    } elsif ($output_type =~ /te?xt/i) {
-	$self->{'converted_to'} = "TEXT";
-    } elsif ($output_type =~ /item/i){
-	$self->{'converted_to'} = "PagedImg";
-    }
-
-    
-    return $item_files;
-}
-
-
-
-
-# Override ConvertToPlug read
-# Needed so multiple .item files generate are sent down secondary plugin
-
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    $self->{'gli'} = $gli;
-    $self->{'file'} = $file;
-
-    my $successful_rv = -1;
-
-    my $outhandle = $self->{'outhandle'};
-    
-    my ($block_status,$filename) = $self->read_block(@_);
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-    $file = $self->read_tidy_file($file);
-    
-    # read() deviates at this point from ConvertToPlug
-    # Need to work with list of filename returned
-
-    my $output_ext = $self->{'convert_to_ext'};
-    my $conv_filename_list = [];
-
-    $conv_filename_list = $self->tmp_area_convert_file($output_ext, $filename);
-    
-    if (scalar(@$conv_filename_list)==0) {
-	return -1;
-    } # had an error, will be passed down pipeline 
-
-    foreach my $conv_filename ( @$conv_filename_list ) {
-	if (! -e "$conv_filename") {return -1;} 
-	$self->{'conv_filename'} = $conv_filename; # is this used anywhere?
-	$self->convert_post_process($conv_filename);
-    
-	my $secondary_plugins =  $self->{'secondary_plugins'};
-	my $num_secondary_plugins = scalar(keys %$secondary_plugins);
-
-	if ($num_secondary_plugins == 0) {
-	    print $outhandle "Warning: No secondary plugin to use in conversion.  Skipping $file\n";
-	    return 0; # effectively block it
-	}
-
-	my @plugin_names = keys %$secondary_plugins;
-	my $plugin_name = shift @plugin_names;
-	
-	if ($num_secondary_plugins > 1) {
-	    print $outhandle "Warning: Multiple secondary plugins not supported yet!  Choosing $plugin_name\n.";
-	}
-	
-	my $secondary_plugin = $secondary_plugins->{$plugin_name};
-	
-	# note: metadata is not carried on to the next level
-	my ($rv,$doc_obj) 
-	    = $secondary_plugin->read_into_doc_obj ($pluginfo,"", $conv_filename, 
-						    $metadata, $processor, $maxdocs, $total_count,
-						    $gli);
-
-	if ((defined $rv) && ($rv>=0)) {
-	    $successful_rv = 1;
-	}
-
-	# Override previous gsdlsourcefilename set by secondary plugin
-	my $collect_file = &util::filename_within_collection($filename);
-	my $collect_conv_file = &util::filename_within_collection($conv_filename);
-	$doc_obj->set_source_filename ($collect_file); 
-	$doc_obj->set_converted_filename($collect_conv_file);
-	
-	my ($filemeta) = $file =~ /([^\\\/]+)$/;
-	$doc_obj->set_utf8_metadata_element($doc_obj->get_top_section(), "Source", &ghtml::dmsafe($filemeta));
-	$doc_obj->set_utf8_metadata_element($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
-	$doc_obj->set_utf8_metadata_element($doc_obj->get_top_section(), "FileSize", (-s $filename));
-	
-	if ($self->{'cover_image'}) {
-	    $self->associate_cover_image($doc_obj, $filename);
-	}
-	
-	# do plugin specific processing of doc_obj
-	unless (defined ($self->process(undef, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli))) {
-	    print STDERR "<ProcessingError n='$file'>\n" if ($gli);
-	    return -1;
-	}
-	# do any automatic metadata extraction
-	$self->auto_extract_metadata ($doc_obj);
-
-	# have we found a Title??
-	$self->title_fallback($doc_obj,$doc_obj->get_top_section(),$filemeta);
-
-	# add an OID
-	$doc_obj->set_OID();
-	# process the document
-	$processor->process($doc_obj);
-
-	$self->{'num_processed'} ++;
-    }
-
-    return $successful_rv;
-}
-
-
-
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-
-    
-    my $secondary_plugins =  $self->{'secondary_plugins'};
-    my @plugin_names = keys %$secondary_plugins;
-    my $plugin_name = shift @plugin_names; # already checked there is only one
-	
-    my $secondary_plugin = $secondary_plugins->{$plugin_name};
-	
-    my $result = $secondary_plugin->process(@_);
-
-    return $result;
-}
-
-
-
-
-sub StartDocument {$self->xml_start_document(@_);}
-sub XMLDecl {$self->xml_xmldecl(@_);}
-sub Entity {$self->xml_entity(@_);}
-sub Doctype {$self->xml_doctype(@_);}
-sub StartTag {$self->xml_start_tag(@_);}
-sub EndTag {$self->xml_end_tag(@_);}
-sub Text {$self->xml_text(@_);}
-sub PI {$self->xml_pi(@_);}
-sub EndDocument {$self->xml_end_document(@_);}
-sub Default {$self->xml_default(@_);}
-
-# This Char function overrides the one in XML::Parser::Stream to overcome a
-# problem where $expat->{Text} is treated as the return value, slowing
-# things down significantly in some cases.
-sub Char {
-    use bytes;  # Necessary to prevent encoding issues with XML::Parser 2.31+
-    $_[0]->{'Text'} .= $_[1];
-    return undef;
-}
-
-# Called at the beginning of the XML document.
-sub xml_start_document {
-    my $self = shift(@_);
-    my ($expat) = @_;
-
-    $self->{'rdf_desc'} = {};
-}
-
-# Called for XML declarations
-sub xml_xmldecl {
-    my $self = shift(@_);
-    my ($expat, $version, $encoding, $standalone) = @_;
-}
-
-# Called for XML entities
-sub xml_entity {
-  my $self = shift(@_);
-  my ($expat, $name, $val, $sysid, $pubid, $ndata) = @_;
-}
-
-# Called for DOCTYPE declarations - use die to bail out if this doctype
-# is not meant for this plugin
-sub xml_doctype {
-    my $self = shift(@_);
-    my ($expat, $name, $sysid, $pubid, $internal) = @_;
-
-    die "" if ($name !~ /^rdf:RDF$/);
-
-    my $outhandle = $self->{'outhandle'};
-    print $outhandle "CONTENTdmPlug: processing $self->{'file'}\n" if $self->{'verbosity'} > 1;
-
-}
-
-# Called for every start tag. The $_ variable will contain a copy of the
-# tag and the %_ variable will contain the element's attributes.
-sub xml_start_tag {
-    my $self = shift(@_);
-    my ($expat, $element) = @_;
-
-    if ($element eq "rdf:Description") {
-
-	my $about_key = $_{'about'};
-
-	my $rdf_desc = $self->{'rdf_desc'};
-	$rdf_desc->{$about_key} = {};
-
-	$self->{'about_key'}  = $about_key;
-	$self->{'index_text'} = "";
-	$self->{'pp_text'}    = "<table width=\"100%\">\n";
-
-
-    }
-    elsif (defined $self->{'about_key'}) {	
-	$self->{'metadata_name'} = $element;
-	$self->{'metadata_value'} = "";
-    }
-
-}
-
-# Called for every end tag. The $_ variable will contain a copy of the tag.
-sub xml_end_tag {
-    my $self = shift(@_);
-    my ($expat, $element) = @_;
-
-    if ($element eq "rdf:Description") {
-	$self->{'pp_text'} .= "</table>\n";
-	## ghtml::htmlsafe($self->{'pp_text'});
-
-
-	my $about_key = $self->{'about_key'};
-	my $about = $self->{'rdf_desc'}->{$about_key};
-	$about->{'IndexText'}     = $self->{'index_text'};
-	$about->{'MetadataTable'} = $self->{'pp_text'};
-
-
-	$self->{'about_key'}   = undef;
-	$self->{'index_text'}  = undef;
-	$self->{'pp_text'}     = undef;
-
-    }
-    elsif (defined $self->{'metadata_name'}) {
-	my $metadata_name = $self->{'metadata_name'};
-	if ($element eq $metadata_name) {
-	    my $metadata_value = $self->{'metadata_value'};
-
-	    my $about_key = $self->{'about_key'};
-	    my $about = $self->{'rdf_desc'}->{$about_key};
-	    $about->{$metadata_name} = $metadata_value;
-
-	    $self->{'index_text'} .= "$metadata_value\n";
-	    $self->{'pp_text'} .= "  <tr><td>$metadata_name</td><td>$metadata_value</td></tr>\n";
-
-	    $self->{'metadata_name'}  = undef;
-	    $self->{'metadata_value'} = undef;
-	}
-    }
-}
-
-# Called just before start or end tags with accumulated non-markup text in
-# the $_ variable.
-sub xml_text {
-    my $self = shift(@_);
-    my ($expat) = @_;
-
-    if (defined $self->{'metadata_name'}) {
-	$self->{'metadata_value'} .= $_;
-    }
-}
-
-# Called for processing instructions. The $_ variable will contain a copy
-# of the pi.
-sub xml_pi {
-    my $self = shift(@_);
-    my ($expat, $target, $data) = @_;
-}
-
-# Called at the end of the XML document.
-sub xml_end_document {
-    my $self = shift(@_);
-    my ($expat) = @_;
-
-}
-
-# Called for any characters not handled by the above functions.
-sub xml_default {
-    my $self = shift(@_);
-    my ($expat, $text) = @_;
-}
-
-
-1;
Index: /gsdl/trunk/perllib/plugins/CONTENTdmPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/CONTENTdmPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/CONTENTdmPlugin.pm	(revision 15865)
@@ -0,0 +1,896 @@
+###########################################################################
+#
+# CONTENTdmPlug.pm -- reasonably with-it pdf plugin
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999-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.
+#
+###########################################################################
+package CONTENTdmPlug;
+
+use ConvertToPlug;
+use unicode;
+use ghtml;
+
+use strict;
+no strict 'refs'; # so we can use a var for filehandles (eg STDERR)
+
+
+use XMLParser;
+
+sub BEGIN {
+    @CONTENTdmPlug::ISA = ('ConvertToPlug');
+}
+
+
+my $convert_to_list =
+    [ {	'name' => "auto",
+	'desc' => "{ConvertToPlug.convert_to.auto}" },
+      {	'name' => "html",
+	'desc' => "{ConvertToPlug.convert_to.html}" },
+      {	'name' => "text",
+	'desc' => "{ConvertToPlug.convert_to.text}" },
+      { 'name' => "pagedimg",
+	'desc' => "{ConvertToPlug.convert_to.pagedimg}"},
+      ];
+
+
+
+my $arguments = 
+      [
+       { 'name' => "convert_to",
+	'desc' => "{ConvertToPlug.convert_to}",
+	'type' => "enum",
+	'reqd' => "yes",
+	'list' => $convert_to_list, 
+	'deft' => "html" },	 
+      { 'name' => "xslt",
+	'desc' => "{XMLPlug.xslt}",
+	'type' => "string",
+	'deft' => "",
+	'reqd' => "no" },
+       { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" },
+      { 'name' => "block_exp",
+	'desc' => "{BasPlug.block_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_block_exp() }
+];
+
+my $options = { 'name'     => "CONTENTdmPlug",
+		'desc'     => "{CONTENTdmPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		# CONTENTdmPlug is one of the few ConvertToPlug subclasses whose source doc can't be replaced by a GS-generated html
+		'srcreplaceable' => "no",
+		'args'     => $arguments };
+
+our ($self);
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    push(@$inputargs,"-title_sub");
+    push(@$inputargs,'^(Page\s+\d+)?(\s*1\s+)?');
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my @arg_array = @$inputargs;
+    $self = (defined $hashArgOptLists)? new ConvertToPlug($pluginlist,$inputargs,$hashArgOptLists): new ConvertToPlug($pluginlist,$inputargs);
+    
+    if ($self->{'info_only'}) {
+	# don't worry about any options etc
+	return bless $self, $class;
+    }
+
+    my $parser = new XML::Parser('Style' => 'Stream',
+				 'Handlers' => {'Char' => \&Char,
+						'XMLDecl' => \&XMLDecl,
+						'Entity' => \&Entity,
+						'Doctype' => \&Doctype,
+						'Default' => \&Default
+						});  
+    $self->{'parser'} = $parser;
+    $self->{'rdf_desc'} = undef;
+    $self->{'about_key'} = undef;
+    $self->{'metadata_name'} = undef;
+    $self->{'metadata_value'} = undef;
+
+    $self->{'convert_to'} = "PagedImg";
+    my $secondary_plugin_options = $self->{'secondary_plugin_options'};
+
+    if (!defined $secondary_plugin_options->{'PagedImgPlug'}){
+	$secondary_plugin_options->{'PagedImgPlug'} = [];
+	my $pagedimg_options = $secondary_plugin_options->{'PagedImgPlug'}; 
+	push(@$pagedimg_options, "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
+	push(@$pagedimg_options, "-thumbnail", "-screenview");
+    }
+
+    $self = bless $self, $class;
+    $self->load_secondary_plugins($class,$secondary_plugin_options,$hashArgOptLists);
+    return $self;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)\.rdf$^;
+}
+
+# so we don't inherit HTMLPlug's block exp...
+sub get_default_block_exp {
+    return q^(?i)\.(jpg|jpeg|gif)$^;
+}
+
+
+
+
+# A smarter (?) option would be to add XMLPlug into inheritence above
+# thereby avoiding a fair amount of code duplication
+
+sub apply_xslt
+{
+    my $self = shift @_;
+    my ($xslt,$filename) = @_;
+    
+    my $outhandle = $self->{'outhandle'};
+
+    my $xslt_filename = $xslt;
+
+    if (! -e $xslt_filename) {
+	# Look in main site directory
+	my $gsdlhome = $ENV{'GSDLHOME'};
+	$xslt_filename = &util::filename_cat($gsdlhome,$xslt);
+    }
+
+    if (! -e $xslt_filename) {
+	# Look in collection directory
+	my $coldir = $ENV{'GSDLCOLLECTDIR'};
+	$xslt_filename = &util::filename_cat($coldir,$xslt);
+    }
+
+    if (! -e $xslt_filename) {
+	print $outhandle "Warning: Unable to find XSLT $xslt\n";
+	if (open(XMLIN,"<$filename")) {
+
+	    my $untransformed_xml = "";
+	    while (defined (my $line = <XMLIN>)) {
+
+		$untransformed_xml .= $line;
+	    }
+	    close(XMLIN);
+	    
+	    return $untransformed_xml;
+	}
+	else {
+	    print $outhandle "Error: Unable to open file $filename\n";
+	    print $outhandle "       $!\n";
+	    return "";
+	}
+	
+    }
+
+    my $bin_java = &util::filename_cat($ENV{'GSDLHOME'},"bin","java");
+    my $jar_filename = &util::filename_cat($bin_java,"xalan.jar");
+    my $xslt_base_cmd = "java -jar $jar_filename";
+    my $xslt_cmd = "$xslt_base_cmd -IN \"$filename\" -XSL \"$xslt_filename\"";
+
+    my $transformed_xml = "";
+
+    if (open(XSLT_IN,"$xslt_cmd |")) {
+	while (defined (my $line = <XSLT_IN>)) {
+
+	    $transformed_xml .= $line;
+	}
+	close(XSLT_IN);
+    }
+    else {
+	print $outhandle "Error: Unable to run command $xslt_cmd\n";
+	print $outhandle "       $!\n";
+    }
+
+    return $transformed_xml;
+
+}
+
+
+
+sub rdf_desc_to_id
+{
+    my $self = shift (@_);
+    my ($rdf_desc) = @_;
+
+    my $rdf_id = {};
+
+    # initialise any .cpd (=complex multi page) structures 
+
+    foreach my $about_key (keys %{$rdf_desc}) {
+	if ($about_key =~ m/\.cpd$/) {
+	    my $about = $rdf_desc->{$about_key};
+	    my $id    = $about->{'dc:identifier'};
+
+	    if ($id =~ m/^\s*$/) {
+		# missing id, make one up based on about attribute
+
+		my ($tailname, $dirname, $suffix)
+		    = &File::Basename::fileparse($about_key, "\\.[^\\.]+\$");
+
+		$id = "about:$tailname";
+	    }
+
+	    $rdf_id->{$id} = $about;
+	    $rdf_id->{$id}->{'ex:filename'} = $about_key;
+	    $rdf_id->{$id}->{'ex:type'} = "complex";
+	    $rdf_id->{$id}->{'pages'} = [];
+	}
+
+    }
+
+    # now add in *non* .cpd items
+
+    foreach my $about_key (keys %{$rdf_desc}) {
+	if ($about_key !~ m/\.cpd$/) {
+	    my $about = $rdf_desc->{$about_key};	    
+	    my $id    = $about->{'dc:identifier'};
+
+
+	    if ($id =~ m/^\s*$/) {
+		# missing id, make one up based on about attribute
+
+		my ($tailname, $dirname, $suffix)
+		    = &File::Basename::fileparse($about_key, "\\.[^\\.]+\$");
+
+		$id = "about:$tailname";
+	    }
+
+	    if (defined $rdf_id->{$id}) {
+		$about->{'ex:filename'} = $about_key;
+
+		# dealing with complex multi-page situation
+		# Add to existing structure
+
+		my $pages = $rdf_id->{$id}->{'pages'};
+		push(@$pages,$about)
+	    }
+	    else {
+		# New entry
+
+		$rdf_id->{$id} = $about;
+		$rdf_id->{$id}->{'ex:type'} = "simple";	    
+		$rdf_id->{$id}->{'ex:filename'} = $about_key;
+	    }
+	}
+	
+    }
+
+    return $rdf_id;
+}
+
+
+sub metadata_table_txt_file
+{
+    my $self = shift (@_);
+    my ($output_root,$page_num) = @_;
+
+    my $txt_filename = $output_root."_page_$page_num.txt";
+
+    my ($tailname, $dirname, $suffix)
+	= &File::Basename::fileparse($txt_filename, "\\.[^\\.]+\$");
+
+    my $txt_file = "$tailname.$suffix";
+
+    return $txt_file;
+}
+
+
+sub output_metadata_table 
+{
+    my $self = shift (@_);
+    my ($page,$page_num,$tmp_dirname,$txt_file) = @_;
+    
+    my $txt_filename = &util::filename_cat($tmp_dirname,$txt_file);
+
+    open(TOUT,">$txt_filename") 
+	|| die "Error: unable to write metadata data out as txt file $txt_filename: $!\n";
+    
+    print TOUT $page->{'MetadataTable'};
+    delete $page->{'MetadataTable'};
+
+    close (TOUT);
+}
+
+
+sub rdf_id_to_item_file
+{
+    my $self = shift (@_);
+    my ($rdf_id,$tmp_dirname,$output_root) = @_;
+
+    my $item_file_list = [];
+    
+    foreach my $id (keys %{$rdf_id}) {
+
+	my $id_safe = $id;
+	$id_safe =~ s/ /-/g;
+
+	my $output_filename = $output_root."_$id_safe.item";
+	open(FOUT,">$output_filename") 
+	    || die "Unable to open $output_filename: $!\n";
+	
+
+	print FOUT "<PagedDocument>\n";
+
+	my $rdf_doc = $rdf_id->{$id};
+	foreach my $metadata_name (keys %$rdf_doc) {
+
+
+	    next if ($metadata_name eq "pages");
+
+	    my $metadata_value = $rdf_doc->{$metadata_name};
+
+	    # convert ns:name to ns.Name
+	    $metadata_name =~ s/^(.*?):(.*)/$1\.\u$2/; 
+
+	    print FOUT "  <Metadata name=\"$metadata_name\">$metadata_value</Metadata>\n";
+	}
+
+	if ($rdf_doc->{'ex:type'} eq "complex") {
+	    my $pages = $rdf_doc->{'pages'};
+	    my $page_num = 1;
+
+	    foreach my $page (@$pages) {
+
+		my $imgfile = $page->{'ex:filename'};
+		if ($imgfile =~ m/(http|ftp):/) {
+		    $imgfile = "empty.jpg";
+		}
+		else {
+		    $imgfile = &util::filename_cat("..","import",$imgfile);
+		}
+		
+		my $txt_file 
+		    = $self->metadata_table_txt_file($output_root,$page_num);
+
+		$self->output_metadata_table($page,$page_num,
+					     $tmp_dirname,$txt_file);
+
+
+		print FOUT "  <Page pagenum=\"$page_num\" imgfile=\"$imgfile\" txtfile=\"$txt_file\">\n";
+
+		foreach my $metadata_name (keys %$page) {
+		
+		    my $metadata_value = $rdf_doc->{$metadata_name};
+		    # convert ns:name to ns.Name
+		    $metadata_name =~ s/^(.*?):(.*)/$1\.\u$2/; 
+
+		    print FOUT "  <Metadata name=\"$metadata_name\">$metadata_value</Metadata>\n";
+		}
+		
+
+		$page_num++;
+
+
+		print FOUT "  </Page>\n";
+	    }
+	}
+	else {
+	    # simple
+	    # duplicate top-level metadata for now plus image to bind to
+
+	    my $imgfile = $rdf_doc->{'ex:filename'};
+	    if ($imgfile =~ m/(http|ftp):/) {
+		$imgfile = "empty.jpg";
+	    }
+	    else {
+		$imgfile = &util::filename_cat("..","import",$imgfile);
+		$imgfile = "../import/".$imgfile;
+	    }
+
+
+	    my $txt_file = $self->metadata_table_txt_file($output_root,1);
+	    $self->output_metadata_table($rdf_doc,1,$tmp_dirname,$txt_file);
+
+	    print FOUT "  <Page pagenum=\"1\" imgfile=\"$imgfile\" txtfile=\"$txt_file\">\n";	    
+	    foreach my $metadata_name (keys %$rdf_doc) {
+
+		my $metadata_value = $rdf_doc->{$metadata_name};
+		
+		# convert ns:name to ns.Name
+		$metadata_name =~ s/^(.*?):(.*)/$1\.\u$2/; 
+
+		print FOUT "  <Metadata name=\"$metadata_name\">$metadata_value</Metadata>\n";
+	    }
+	    print FOUT "  </Page>\n";
+
+	}
+
+	print FOUT "</PagedDocument>\n";
+	close(FOUT);
+
+	push(@$item_file_list,$output_filename);
+
+    }
+    
+
+    return $item_file_list;
+}
+
+
+
+sub xml_area_convert_file
+{
+    my $self = shift (@_);
+    my ($input_filename, $tmp_dirname, $output_root) = @_;
+
+    eval {
+	# Build up hash table/tree of all records
+
+	my $xslt = $self->{'xslt'};
+	if (defined $xslt && ($xslt ne "")) {
+	    # perform xslt
+	    my $transformed_xml = $self->apply_xslt($xslt,$input_filename);
+
+	    # feed transformed file (now in memory as string) into XML parser
+	    $self->{'parser'}->parse($transformed_xml);
+	}
+	else {
+	    $self->{'parser'}->parsefile($input_filename);
+	}
+    };
+  
+    if ($@) {
+
+	# parsefile may either croak somewhere in XML::Parser (e.g. because
+	# the document is not well formed) or die somewhere in XMLPlug or a
+	# derived plugin (e.g. because we're attempting to process a
+	# document whose DOCTYPE is not meant for this plugin). For the
+	# first case we'll print a warning and continue, for the second
+	# we'll just continue quietly
+
+	print STDERR "**** Error is: $@\n";
+
+	my $file = $self->{'file'};
+
+	my ($msg) = $@ =~ /Carp::croak\(\'(.*?)\'\)/;
+	if (defined $msg) {	
+	    my $outhandle = $self->{'outhandle'};
+	    my $plugin_name = ref ($self);
+	    print $outhandle "$plugin_name failed to process $file ($msg)\n";
+	}
+
+	my $gli = $self->{'gli'};
+
+	# reset ourself for the next document
+	$self->{'section_level'}=0;
+	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
+	return ("fail",undef); # error during processing
+    }
+
+    my $rdf_desc = $self->{'rdf_desc'};    
+
+#    foreach my $about_key (keys %{$rdf_desc}) {
+#	my $about = $rdf_desc->{$about_key};
+#	foreach my $metadata_name (keys %{$about}) {
+#
+#	    my $metadata_value = $about->{$metadata_name};
+##	    print STDERR " $metadata_name: $metadata_value\n";
+#	}
+#    }
+
+
+    # Merge entries with same name
+
+
+    my $merged_rdf_id = $self->rdf_desc_to_id($rdf_desc);
+
+#    foreach my $about_key (keys %{$merged_rdf_id}) {
+#	my $about = $merged_rdf_id->{$about_key};
+#	foreach my $metadata_name (keys %{$about}) {
+#
+#	    my $metadata_value = $about->{$metadata_name};
+##	    print STDERR " $metadata_name: $metadata_value\n";
+#	}
+#    }
+
+
+
+    my $item_files = $self->rdf_id_to_item_file($merged_rdf_id,$tmp_dirname, 
+						$output_root);
+
+    return ("item",$item_files);
+}
+
+
+# Override ConvertToPlug tmp_area_convert_file() to provide solution specific 
+# to CONTENTdm
+#
+# A better (i.e. in the future) solution would be to see if this can be
+# shifted into gsConvert.pl so there is no need to override the
+# default tmp_area_convert_file()
+
+
+sub tmp_area_convert_file {
+    my $self = shift (@_);
+    my ($output_ext, $input_filename, $textref) = @_;
+
+    # is textref ever used?!?
+
+    my $outhandle = $self->{'outhandle'};
+    my $convert_to = $self->{'convert_to'};
+    my $failhandle = $self->{'failhandle'};
+    my $convert_to_ext = $self->{'convert_to_ext'};
+    
+    # softlink to collection tmp dir
+    my $tmp_dirname 
+	= &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, "tmp");
+    &util::mk_dir($tmp_dirname) if (!-e $tmp_dirname);
+
+    # derive tmp filename from input filename
+    my ($tailname, $dirname, $suffix)
+	= &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
+
+    # Remove any white space from filename -- no risk of name collision, and
+    # makes later conversion by utils simpler. Leave spaces in path...
+    # tidy up the filename with space, dot, hyphen between
+    $tailname =~ s/\s+//g; 
+    $tailname =~ s/\.+//g;
+    $tailname =~ s/\-+//g;
+    $suffix = lc($suffix);
+    my $tmp_filename = &util::filename_cat($tmp_dirname, "$tailname$suffix");
+
+    &util::soft_link($input_filename, $tmp_filename);
+    my $verbosity = $self->{'verbosity'};
+    if ($verbosity > 0) {
+	print $outhandle "Converting $tailname$suffix to $convert_to format\n";
+    }
+
+    my $errlog = &util::filename_cat($tmp_dirname, "err.log");
+    
+    # call xml_area_convert_file rather than gsConvert.pl
+
+    my $output_root = &util::filename_cat($tmp_dirname, "$tailname");
+
+    my ($output_type,$item_files) 
+	= $self->xml_area_convert_file($tmp_filename,$tmp_dirname,$output_root);
+
+
+    my $fakeimg_filename = &util::filename_cat($dirname, "empty.jpg");
+    my $fakeimg_tmp_filename = &util::filename_cat($tmp_dirname, "empty.jpg");
+
+    print STDERR "***** Setting up fake filename $fakeimg_filename -> $fakeimg_tmp_filename\n";
+
+    &util::soft_link($fakeimg_filename, $fakeimg_tmp_filename);
+   
+    # continue as before ...
+
+    # remove symbolic link to original file
+    &util::rm($tmp_filename);
+
+    # Check STDERR here
+    chomp $output_type;
+    if ($output_type eq "fail") {
+	print $outhandle "Could not convert $tailname$suffix to $convert_to format\n";
+	print $failhandle "$tailname$suffix: " . ref($self) . " failed to convert to $convert_to\n";
+	$self->{'num_not_processed'} ++;
+	if (-s "$errlog") {
+	    open(ERRLOG, "$errlog");
+	    while (<ERRLOG>) {
+		print $outhandle "$_";
+	    }
+	    print $outhandle "\n";
+	    close ERRLOG;
+	}
+	&util::rm("$errlog") if (-e "$errlog");
+	return [];
+    }
+
+    # store the *actual* output type and return the output filename
+    # it's possible we requested conversion to html, but only to text succeeded
+    #$self->{'convert_to_ext'} = $output_type;
+    if ($output_type =~ /html/i) {
+	$self->{'converted_to'} = "HTML";
+    } elsif ($output_type =~ /te?xt/i) {
+	$self->{'converted_to'} = "TEXT";
+    } elsif ($output_type =~ /item/i){
+	$self->{'converted_to'} = "PagedImg";
+    }
+
+    
+    return $item_files;
+}
+
+
+
+
+# Override ConvertToPlug read
+# Needed so multiple .item files generate are sent down secondary plugin
+
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    $self->{'gli'} = $gli;
+    $self->{'file'} = $file;
+
+    my $successful_rv = -1;
+
+    my $outhandle = $self->{'outhandle'};
+    
+    my ($block_status,$filename) = $self->read_block(@_);
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+    $file = $self->read_tidy_file($file);
+    
+    # read() deviates at this point from ConvertToPlug
+    # Need to work with list of filename returned
+
+    my $output_ext = $self->{'convert_to_ext'};
+    my $conv_filename_list = [];
+
+    $conv_filename_list = $self->tmp_area_convert_file($output_ext, $filename);
+    
+    if (scalar(@$conv_filename_list)==0) {
+	return -1;
+    } # had an error, will be passed down pipeline 
+
+    foreach my $conv_filename ( @$conv_filename_list ) {
+	if (! -e "$conv_filename") {return -1;} 
+	$self->{'conv_filename'} = $conv_filename; # is this used anywhere?
+	$self->convert_post_process($conv_filename);
+    
+	my $secondary_plugins =  $self->{'secondary_plugins'};
+	my $num_secondary_plugins = scalar(keys %$secondary_plugins);
+
+	if ($num_secondary_plugins == 0) {
+	    print $outhandle "Warning: No secondary plugin to use in conversion.  Skipping $file\n";
+	    return 0; # effectively block it
+	}
+
+	my @plugin_names = keys %$secondary_plugins;
+	my $plugin_name = shift @plugin_names;
+	
+	if ($num_secondary_plugins > 1) {
+	    print $outhandle "Warning: Multiple secondary plugins not supported yet!  Choosing $plugin_name\n.";
+	}
+	
+	my $secondary_plugin = $secondary_plugins->{$plugin_name};
+	
+	# note: metadata is not carried on to the next level
+	my ($rv,$doc_obj) 
+	    = $secondary_plugin->read_into_doc_obj ($pluginfo,"", $conv_filename, 
+						    $metadata, $processor, $maxdocs, $total_count,
+						    $gli);
+
+	if ((defined $rv) && ($rv>=0)) {
+	    $successful_rv = 1;
+	}
+
+	# Override previous gsdlsourcefilename set by secondary plugin
+	my $collect_file = &util::filename_within_collection($filename);
+	my $collect_conv_file = &util::filename_within_collection($conv_filename);
+	$doc_obj->set_source_filename ($collect_file); 
+	$doc_obj->set_converted_filename($collect_conv_file);
+	
+	my ($filemeta) = $file =~ /([^\\\/]+)$/;
+	$doc_obj->set_utf8_metadata_element($doc_obj->get_top_section(), "Source", &ghtml::dmsafe($filemeta));
+	$doc_obj->set_utf8_metadata_element($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
+	$doc_obj->set_utf8_metadata_element($doc_obj->get_top_section(), "FileSize", (-s $filename));
+	
+	if ($self->{'cover_image'}) {
+	    $self->associate_cover_image($doc_obj, $filename);
+	}
+	
+	# do plugin specific processing of doc_obj
+	unless (defined ($self->process(undef, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli))) {
+	    print STDERR "<ProcessingError n='$file'>\n" if ($gli);
+	    return -1;
+	}
+	# do any automatic metadata extraction
+	$self->auto_extract_metadata ($doc_obj);
+
+	# have we found a Title??
+	$self->title_fallback($doc_obj,$doc_obj->get_top_section(),$filemeta);
+
+	# add an OID
+	$doc_obj->set_OID();
+	# process the document
+	$processor->process($doc_obj);
+
+	$self->{'num_processed'} ++;
+    }
+
+    return $successful_rv;
+}
+
+
+
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+
+    
+    my $secondary_plugins =  $self->{'secondary_plugins'};
+    my @plugin_names = keys %$secondary_plugins;
+    my $plugin_name = shift @plugin_names; # already checked there is only one
+	
+    my $secondary_plugin = $secondary_plugins->{$plugin_name};
+	
+    my $result = $secondary_plugin->process(@_);
+
+    return $result;
+}
+
+
+
+
+sub StartDocument {$self->xml_start_document(@_);}
+sub XMLDecl {$self->xml_xmldecl(@_);}
+sub Entity {$self->xml_entity(@_);}
+sub Doctype {$self->xml_doctype(@_);}
+sub StartTag {$self->xml_start_tag(@_);}
+sub EndTag {$self->xml_end_tag(@_);}
+sub Text {$self->xml_text(@_);}
+sub PI {$self->xml_pi(@_);}
+sub EndDocument {$self->xml_end_document(@_);}
+sub Default {$self->xml_default(@_);}
+
+# This Char function overrides the one in XML::Parser::Stream to overcome a
+# problem where $expat->{Text} is treated as the return value, slowing
+# things down significantly in some cases.
+sub Char {
+    use bytes;  # Necessary to prevent encoding issues with XML::Parser 2.31+
+    $_[0]->{'Text'} .= $_[1];
+    return undef;
+}
+
+# Called at the beginning of the XML document.
+sub xml_start_document {
+    my $self = shift(@_);
+    my ($expat) = @_;
+
+    $self->{'rdf_desc'} = {};
+}
+
+# Called for XML declarations
+sub xml_xmldecl {
+    my $self = shift(@_);
+    my ($expat, $version, $encoding, $standalone) = @_;
+}
+
+# Called for XML entities
+sub xml_entity {
+  my $self = shift(@_);
+  my ($expat, $name, $val, $sysid, $pubid, $ndata) = @_;
+}
+
+# Called for DOCTYPE declarations - use die to bail out if this doctype
+# is not meant for this plugin
+sub xml_doctype {
+    my $self = shift(@_);
+    my ($expat, $name, $sysid, $pubid, $internal) = @_;
+
+    die "" if ($name !~ /^rdf:RDF$/);
+
+    my $outhandle = $self->{'outhandle'};
+    print $outhandle "CONTENTdmPlug: processing $self->{'file'}\n" if $self->{'verbosity'} > 1;
+
+}
+
+# Called for every start tag. The $_ variable will contain a copy of the
+# tag and the %_ variable will contain the element's attributes.
+sub xml_start_tag {
+    my $self = shift(@_);
+    my ($expat, $element) = @_;
+
+    if ($element eq "rdf:Description") {
+
+	my $about_key = $_{'about'};
+
+	my $rdf_desc = $self->{'rdf_desc'};
+	$rdf_desc->{$about_key} = {};
+
+	$self->{'about_key'}  = $about_key;
+	$self->{'index_text'} = "";
+	$self->{'pp_text'}    = "<table width=\"100%\">\n";
+
+
+    }
+    elsif (defined $self->{'about_key'}) {	
+	$self->{'metadata_name'} = $element;
+	$self->{'metadata_value'} = "";
+    }
+
+}
+
+# Called for every end tag. The $_ variable will contain a copy of the tag.
+sub xml_end_tag {
+    my $self = shift(@_);
+    my ($expat, $element) = @_;
+
+    if ($element eq "rdf:Description") {
+	$self->{'pp_text'} .= "</table>\n";
+	## ghtml::htmlsafe($self->{'pp_text'});
+
+
+	my $about_key = $self->{'about_key'};
+	my $about = $self->{'rdf_desc'}->{$about_key};
+	$about->{'IndexText'}     = $self->{'index_text'};
+	$about->{'MetadataTable'} = $self->{'pp_text'};
+
+
+	$self->{'about_key'}   = undef;
+	$self->{'index_text'}  = undef;
+	$self->{'pp_text'}     = undef;
+
+    }
+    elsif (defined $self->{'metadata_name'}) {
+	my $metadata_name = $self->{'metadata_name'};
+	if ($element eq $metadata_name) {
+	    my $metadata_value = $self->{'metadata_value'};
+
+	    my $about_key = $self->{'about_key'};
+	    my $about = $self->{'rdf_desc'}->{$about_key};
+	    $about->{$metadata_name} = $metadata_value;
+
+	    $self->{'index_text'} .= "$metadata_value\n";
+	    $self->{'pp_text'} .= "  <tr><td>$metadata_name</td><td>$metadata_value</td></tr>\n";
+
+	    $self->{'metadata_name'}  = undef;
+	    $self->{'metadata_value'} = undef;
+	}
+    }
+}
+
+# Called just before start or end tags with accumulated non-markup text in
+# the $_ variable.
+sub xml_text {
+    my $self = shift(@_);
+    my ($expat) = @_;
+
+    if (defined $self->{'metadata_name'}) {
+	$self->{'metadata_value'} .= $_;
+    }
+}
+
+# Called for processing instructions. The $_ variable will contain a copy
+# of the pi.
+sub xml_pi {
+    my $self = shift(@_);
+    my ($expat, $target, $data) = @_;
+}
+
+# Called at the end of the XML document.
+sub xml_end_document {
+    my $self = shift(@_);
+    my ($expat) = @_;
+
+}
+
+# Called for any characters not handled by the above functions.
+sub xml_default {
+    my $self = shift(@_);
+    my ($expat, $text) = @_;
+}
+
+
+1;
Index: dl/trunk/perllib/plugins/CSVPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/CSVPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,184 +1,0 @@
-###########################################################################
-#
-# CSVPlug.pm -- A plugin for files in comma-separated value format
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright 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 CSVPlug;
-
-
-use SplitPlug;
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-
-# CSVPlug is a sub-class of SplitPlug.
-sub BEGIN {
-    @CSVPlug::ISA = ('SplitPlug');
-}
-
-
-my $arguments = 
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_process_exp() },
-      { 'name' => "split_exp",
-	'desc' => "{SplitPlug.split_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_split_exp(),
-        'hiddengli' => "yes" }
-      ];
-
-
-my $options = { 'name'     => "CSVPlug",
-		'desc'     => "{CSVPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'explodes' => "yes",
-		'args'     => $arguments };
-
-
-# This plugin processes files with the suffix ".csv"
-sub get_default_process_exp {
-    return q^(?i)(\.csv)$^;
-}
-
-    
-# This plugin splits the input text by line
-sub get_default_split_exp {
-    return q^\r?\n^;
-}
-
-
-sub new
-{
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if (defined $arguments) { push(@{$hashArgOptLists->{"ArgList"}}, @{$arguments});}
-    if (defined $options) { push(@{$hashArgOptLists->{"OptList"}}, $options)};
-
-    my $self = new SplitPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-
-sub read_file
-{
-    my $self = shift (@_);
-    my ($filename, $encoding, $language, $textref) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    # Read the CSV file content
-    open(FILE, $filename);
-    my $reader = new multiread();
-    $reader->set_handle('CSVPlug::FILE');
-    $reader->set_encoding($encoding);
-    $reader->read_file($textref);
-    close(FILE);
-
-    # Remove any blank lines so the data is split and processed properly
-    $$textref =~ s/\n(\s*)\n/\n/g;
-
-    # The first line contains the metadata element names
-    $$textref =~ s/^(.*?)\r?\n//;
-    my @csv_file_fields = ();
-    my $csv_file_field_line = $1 . ",";  # To make the regular expressions simpler
-    while ($csv_file_field_line ne "") {
-	# Handle quoted values
-	if ($csv_file_field_line =~ s/^\"(.*?)\"\,//) {
-	    my $csv_file_field = $1;
-	    $csv_file_field =~ s/ //g;  # Remove any spaces from the field names
-	    push(@csv_file_fields, $csv_file_field);
-	}
-	# Normal comma-separated case
-	elsif ($csv_file_field_line =~ s/^(.*?)\,//) {
-	    my $csv_file_field = $1;
-	    $csv_file_field =~ s/ //g;  # Remove any spaces from the field names
-	    push(@csv_file_fields, $csv_file_field);
-	}
-	# The line must be formatted incorrectly
-	else {
-	    print STDERR "Error: Badly formatted CSV field line: $csv_file_field_line.\n";
-	    last;
-	}
-    }
-    $self->{'csv_file_fields'} = \@csv_file_fields;
-}
-
-
-sub process
-{
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    my $section = $doc_obj->get_top_section();
-    my $csv_line = $$textref;
-    my @csv_file_fields = @{$self->{'csv_file_fields'}};
-
-    # Report that we're processing the file
-    print STDERR "\n<Processing n='$file' p='CSVPlug'>\n" if ($gli);
-    print $outhandle "CSVPlug: processing $file\n" if ($self->{'verbosity'}) > 1;
-
-    # Add the raw line as the document text
-    $doc_obj->add_utf8_text($section, $csv_line);
-
-    # Build a hash of metadata name to metadata value for this line
-    my $i = 0;
-    $csv_line .= ",";  # To make the regular expressions simpler
-    while ($csv_line ne "") {
-	# Metadata values containing commas are quoted
-	if ($csv_line =~ s/^\"(.*?)\"\,//) {
-	    # Only bother with non-empty values
-	    if ($1 ne "" && defined($csv_file_fields[$i])) {
-		$doc_obj->add_utf8_metadata($section, $csv_file_fields[$i], $1);
-	    }
-	}
-	# Normal comma-separated case
-	elsif ($csv_line =~ s/^(.*?)\,//) {
-	    # Only bother with non-empty values
-	    if ($1 ne "" && defined($csv_file_fields[$i])) {
-		$doc_obj->add_utf8_metadata($section, $csv_file_fields[$i], $1);
-	    }
-	}
-	# The line must be formatted incorrectly
-	else {
-	    print STDERR "Error: Badly formatted CSV line: $csv_line.\n";
-	    last;
-	}
-
-	$i++;
-    }
-
-    # Record was processed successfully
-    return 1;
-}
-
-
-1;
Index: /gsdl/trunk/perllib/plugins/CSVPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/CSVPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/CSVPlugin.pm	(revision 15865)
@@ -0,0 +1,184 @@
+###########################################################################
+#
+# CSVPlug.pm -- A plugin for files in comma-separated value format
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright 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 CSVPlug;
+
+
+use SplitPlug;
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+
+# CSVPlug is a sub-class of SplitPlug.
+sub BEGIN {
+    @CSVPlug::ISA = ('SplitPlug');
+}
+
+
+my $arguments = 
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_process_exp() },
+      { 'name' => "split_exp",
+	'desc' => "{SplitPlug.split_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_split_exp(),
+        'hiddengli' => "yes" }
+      ];
+
+
+my $options = { 'name'     => "CSVPlug",
+		'desc'     => "{CSVPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'explodes' => "yes",
+		'args'     => $arguments };
+
+
+# This plugin processes files with the suffix ".csv"
+sub get_default_process_exp {
+    return q^(?i)(\.csv)$^;
+}
+
+    
+# This plugin splits the input text by line
+sub get_default_split_exp {
+    return q^\r?\n^;
+}
+
+
+sub new
+{
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if (defined $arguments) { push(@{$hashArgOptLists->{"ArgList"}}, @{$arguments});}
+    if (defined $options) { push(@{$hashArgOptLists->{"OptList"}}, $options)};
+
+    my $self = new SplitPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+
+sub read_file
+{
+    my $self = shift (@_);
+    my ($filename, $encoding, $language, $textref) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    # Read the CSV file content
+    open(FILE, $filename);
+    my $reader = new multiread();
+    $reader->set_handle('CSVPlug::FILE');
+    $reader->set_encoding($encoding);
+    $reader->read_file($textref);
+    close(FILE);
+
+    # Remove any blank lines so the data is split and processed properly
+    $$textref =~ s/\n(\s*)\n/\n/g;
+
+    # The first line contains the metadata element names
+    $$textref =~ s/^(.*?)\r?\n//;
+    my @csv_file_fields = ();
+    my $csv_file_field_line = $1 . ",";  # To make the regular expressions simpler
+    while ($csv_file_field_line ne "") {
+	# Handle quoted values
+	if ($csv_file_field_line =~ s/^\"(.*?)\"\,//) {
+	    my $csv_file_field = $1;
+	    $csv_file_field =~ s/ //g;  # Remove any spaces from the field names
+	    push(@csv_file_fields, $csv_file_field);
+	}
+	# Normal comma-separated case
+	elsif ($csv_file_field_line =~ s/^(.*?)\,//) {
+	    my $csv_file_field = $1;
+	    $csv_file_field =~ s/ //g;  # Remove any spaces from the field names
+	    push(@csv_file_fields, $csv_file_field);
+	}
+	# The line must be formatted incorrectly
+	else {
+	    print STDERR "Error: Badly formatted CSV field line: $csv_file_field_line.\n";
+	    last;
+	}
+    }
+    $self->{'csv_file_fields'} = \@csv_file_fields;
+}
+
+
+sub process
+{
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    my $section = $doc_obj->get_top_section();
+    my $csv_line = $$textref;
+    my @csv_file_fields = @{$self->{'csv_file_fields'}};
+
+    # Report that we're processing the file
+    print STDERR "\n<Processing n='$file' p='CSVPlug'>\n" if ($gli);
+    print $outhandle "CSVPlug: processing $file\n" if ($self->{'verbosity'}) > 1;
+
+    # Add the raw line as the document text
+    $doc_obj->add_utf8_text($section, $csv_line);
+
+    # Build a hash of metadata name to metadata value for this line
+    my $i = 0;
+    $csv_line .= ",";  # To make the regular expressions simpler
+    while ($csv_line ne "") {
+	# Metadata values containing commas are quoted
+	if ($csv_line =~ s/^\"(.*?)\"\,//) {
+	    # Only bother with non-empty values
+	    if ($1 ne "" && defined($csv_file_fields[$i])) {
+		$doc_obj->add_utf8_metadata($section, $csv_file_fields[$i], $1);
+	    }
+	}
+	# Normal comma-separated case
+	elsif ($csv_line =~ s/^(.*?)\,//) {
+	    # Only bother with non-empty values
+	    if ($1 ne "" && defined($csv_file_fields[$i])) {
+		$doc_obj->add_utf8_metadata($section, $csv_file_fields[$i], $1);
+	    }
+	}
+	# The line must be formatted incorrectly
+	else {
+	    print STDERR "Error: Badly formatted CSV line: $csv_line.\n";
+	    last;
+	}
+
+	$i++;
+    }
+
+    # Record was processed successfully
+    return 1;
+}
+
+
+1;
Index: /gsdl/trunk/perllib/plugins/ConvertBinaryFile.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ConvertBinaryFile.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/ConvertBinaryFile.pm	(revision 15865)
@@ -0,0 +1,536 @@
+###########################################################################
+#
+# ConvertToPlug.pm -- plugin that inherits from BasPlug
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999 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.
+#
+###########################################################################
+
+# This plugin is inherited by such plugins as WordPlug, PPTPlug, PSPlug, 
+# RTFPlug and PDFPlug. It facilitates the conversion of these document types 
+# to either HTML, TEXT or a series of images. It works by dynamically loading 
+# an appropriate secondary plugin (HTMLPlug, StructuredHTMLPlug, 
+# PagedImgPlug or TEXTPlug) based on the plugin argument 'convert_to'. 
+
+package ConvertToPlug;
+
+use BasPlug;
+use ghtml;
+use HTMLPlug;
+use TEXTPlug;
+use PagedImgPlug;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+no strict 'subs';
+sub BEGIN {
+    @ConvertToPlug::ISA = ('BasPlug');
+}
+
+my $convert_to_list =
+    [ {	'name' => "auto",
+	'desc' => "{ConvertToPlug.convert_to.auto}" },
+      {	'name' => "html",
+	'desc' => "{ConvertToPlug.convert_to.html}" },
+      {	'name' => "text",
+	'desc' => "{ConvertToPlug.convert_to.text}" }
+      ];
+
+my $arguments =
+    [ { 'name' => "convert_to",
+	'desc' => "{ConvertToPlug.convert_to}",
+	'type' => "enum",
+	'reqd' => "yes",
+	'list' => $convert_to_list, 
+	'deft' => "auto" },
+      { 'name' => "keep_original_filename",
+	'desc' => "{ConvertToPlug.keep_original_filename}",
+	'type' => "flag" },
+      { 'name' => "title_sub",
+	'desc' => "{HTMLPlug.title_sub}",
+	'type' => "string", 
+	#'type' => "regexp",
+	'deft' => "" },
+      { 'name' => "apply_fribidi",
+	'desc' => "{ConvertToPlug.apply_fribidi}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "use_strings",
+	'desc' => "{ConvertToPlug.use_strings}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "extract_keyphrases",
+	'desc' => "{BasPlug.extract_keyphrases}",
+	'type' => "flag",
+	'reqd' => "no",
+	'hiddengli' => "yes" },
+      { 'name' => "extract_keyphrase_options",
+	'desc' => "{BasPlug.extract_keyphrase_options}",
+	'type' => "string",
+	'reqd' => "no",
+	'hiddengli' => "yes" } ];
+
+my $options = { 'name'     => "ConvertToPlug",
+		'desc'     => "{ConvertToPlug.desc}",
+		'abstract' => "yes",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+
+sub load_secondary_plugins
+{
+    my $self = shift (@_);
+    my ($class,$input_args,$hashArgOptLists) = @_;
+
+    my @convert_to_list = split(",",$self->{'convert_to'});
+    my $secondary_plugins = {};
+    # find the plugin
+
+    foreach my $convert_to (@convert_to_list) {
+	# load in "convert_to" plugin package
+	my $plugin_class = $convert_to."Plug";
+	my $plugin_package = $plugin_class.".pm";
+
+	my $colplugname = undef;
+	if (defined $ENV{'GSDLCOLLECTDIR'}) {
+	    $colplugname = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},
+					       "perllib","plugins", 
+					       $plugin_package);
+	}
+
+	my $mainplugname = &util::filename_cat($ENV{'GSDLHOME'},
+					       "perllib","plugins", 
+					       $plugin_package);
+
+	if ((defined $colplugname) && (-e $colplugname)) { require $colplugname;}
+	elsif (-e $mainplugname) { require $mainplugname; }
+	else {
+	    &gsprintf(STDERR, "{plugin.could_not_find_plugin}\n",
+		      $plugin_class);
+	    die "\n";
+	}
+
+	# call its constructor with extra options that we've worked out!
+	my $arglist = $input_args->{$plugin_class};
+
+	my ($secondary_plugin);
+	eval("\$secondary_plugin = new $plugin_class([],\$arglist)");
+	die "$@" if $@;
+	$secondary_plugins->{$plugin_class} = $secondary_plugin;
+    }
+    $self->{'secondary_plugins'} = $secondary_plugins;
+}
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+    my $classPluginName = (defined $pluginlist->[0]) ? $pluginlist->[0] : $class;
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+    
+    if ($self->{'info_only'}) {
+	# don't worry about any options etc
+	return bless $self, $class;
+    }
+
+    my $convert_to_type = $self->{'convert_to'};
+    if (!defined $convert_to_type || $convert_to_type eq "") {
+	$convert_to_type = "auto";
+    }
+    my $windows_scripting = $self->{'windows_scripting'};
+    $windows_scripting = 0 unless defined $windows_scripting;
+    if ($classPluginName eq "PDFPlug") {
+	if ($convert_to_type eq "text" && 
+	    $ENV{'GSDLOS'} =~ /^windows$/i) {
+	    print STDERR "Windows does not support pdf to text. PDFs will be converted to HTML instead\n";
+	    $convert_to_type = "html";
+	}
+    } elsif ($classPluginName eq "WordPlug") {
+	if ($windows_scripting && $ENV{'GSDLOS'} =~ /^windows$/i && $convert_to_type =~ /^(html|auto)$/) {
+	    # we use structured HTML, not normal html
+	    $convert_to_type = "structuredhtml";
+	} 
+    } elsif ($classPluginName eq "PPTPlug") {
+	if ($windows_scripting && $ENV{'GSDLOS'} =~ /^windows$/i && $convert_to_type eq "auto") {
+	    # we use paged img
+	    $convert_to_type = "pagedimg_jpg";
+	} 
+    } elsif ($classPluginName eq "PSPlug") {
+	if ($convert_to_type eq "auto") {
+	    # we use text
+	    $convert_to_type = "text";
+	}
+    }
+    
+    if ($convert_to_type eq "auto") {
+	# choose html for now - should choose a format based on doc type
+	$convert_to_type = "html";
+    }
+    
+    if ($convert_to_type eq "html") {
+	$self->{'convert_to'} = "HTML";
+	$self->{'convert_to_ext'} = "html";
+    } elsif ($convert_to_type eq "text") {
+	$self->{'convert_to'} = "TEXT";
+	$self->{'convert_to_ext'} = "txt";
+    } elsif ($convert_to_type eq "structuredhtml") {
+	$self->{'convert_to'} = "StructuredHTML";
+	$self->{'convert_to_ext'} = "html";
+    } elsif ($convert_to_type =~ /^pagedimg/) {
+	$self->{'convert_to'} = "PagedImg";
+	my ($convert_to_ext) = $convert_to_type =~ /pagedimg\_(jpg|gif|png)/i;
+	$convert_to_ext = 'jpg' unless defined $convert_to_ext;
+	$self->{'convert_to_ext'} = $convert_to_ext;
+    }
+
+    return bless $self, $class;
+}
+
+
+sub init {
+    my $self = shift (@_);
+    my ($verbosity, $outhandle, $failhandle) = @_;
+
+    $self->SUPER::init($verbosity,$outhandle,$failhandle);
+
+    my $secondary_plugins =  $self->{'secondary_plugins'};
+
+    foreach my $plug_name (keys %$secondary_plugins) {
+	my $plugin = $secondary_plugins->{$plug_name};
+	$plugin->init($verbosity,$outhandle,$failhandle);
+    }
+}
+
+sub deinit {
+    # called only once, after all plugin passes have been done
+
+    my ($self) = @_;
+
+    my $secondary_plugins =  $self->{'secondary_plugins'};
+
+    foreach my $plug_name (keys %$secondary_plugins) {
+	my $plugin = $secondary_plugins->{$plug_name};
+	$plugin->deinit();
+    }
+}
+
+sub convert_post_process
+{
+    # by default do no post processing
+    return;
+}
+
+
+# Run conversion utility on the input file.  
+#
+# The conversion takes place in a collection specific 'tmp' directory so 
+# that we don't accidentally damage the input.
+#
+# The desired output type is indicated by $output_ext.  This is usually
+# something like "html" or "word", but can be "best" (or the empty string)
+# to indicate that the conversion utility should do the best it can.
+sub tmp_area_convert_file {
+    my $self = shift (@_);
+    my ($output_ext, $input_filename, $textref) = @_;
+    
+    my $outhandle = $self->{'outhandle'};
+    my $convert_to = $self->{'convert_to'};
+    my $failhandle = $self->{'failhandle'};
+    my $convert_to_ext = $self->{'convert_to_ext'};
+    
+    # derive tmp filename from input filename
+    my ($tailname, $dirname, $suffix)
+	= &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
+
+    # softlink to collection tmp dir
+    my $tmp_dirname = $dirname;
+    if(defined $ENV{'GSDLCOLLECTDIR'}) {
+	$tmp_dirname = $ENV{'GSDLCOLLECTDIR'};
+    } elsif(defined $ENV{'GSDLHOME'}) {
+	$tmp_dirname = $ENV{'GSDLHOME'};
+    }
+    $tmp_dirname = &util::filename_cat($tmp_dirname, "tmp");
+    &util::mk_dir($tmp_dirname) if (!-e $tmp_dirname);
+   
+    # The following is not necessary and will cause problems with
+    # replacing_srcdoc_with_html in the GSDLremote case:
+    # Remove any white space from filename -- no risk of name collision, and
+    # makes later conversion by utils simpler. Leave spaces in path...
+    # tidy up the filename with space, dot, hyphen between
+    #$tailname =~ s/\s+//g; 
+    #$tailname =~ s/\.+//g;
+    #$tailname =~ s/\-+//g;
+
+    # convert to utf-8 otherwise we have problems with the doc.xml file
+    # later on
+    &unicode::ensure_utf8(\$tailname);
+
+    $suffix = lc($suffix);
+    my $tmp_filename = &util::filename_cat($tmp_dirname, "$tailname$suffix");
+    
+    # If gsdl is remote, we're given relative path to input file, of the form import/tailname.suffix
+    # But we can't softlink to relative paths. Therefore, we need to ensure that
+    # the input_filename is the absolute path, see http://perldoc.perl.org/File/Spec.html
+    my $ensure_path_absolute = 1; # true
+    &util::soft_link($input_filename, $tmp_filename, $ensure_path_absolute);
+    my $verbosity = $self->{'verbosity'};
+    if ($verbosity > 0) {
+	print $outhandle "Converting $tailname$suffix to $convert_to format\n";
+    }
+
+    my $errlog = &util::filename_cat($tmp_dirname, "err.log");
+    
+    # Execute the conversion command and get the type of the result,
+    # making sure the converter gives us the appropriate output type
+    my $output_type="";
+    if ($convert_to =~ m/PagedImg/i) {
+	$output_type = lc($convert_to)."_".lc($convert_to_ext);
+    } else {
+	$output_type = lc($convert_to);
+    }
+
+    my $cmd = "perl -S gsConvert.pl -verbose $verbosity ";
+    if (defined $self->{'convert_options'}) {
+	$cmd .= $self->{'convert_options'} . " ";
+    }
+    if ($self->{'use_strings'}) {
+      $cmd .= "-use_strings ";
+    }
+    $cmd .= "-errlog \"$errlog\" -output $output_type \"$tmp_filename\"";
+    $output_type = `$cmd`;
+
+    # remove symbolic link to original file
+    &util::rm($tmp_filename);
+    
+    # Check STDERR here
+    chomp $output_type;
+    if ($output_type eq "fail") {
+	print $outhandle "Could not convert $tailname$suffix to $convert_to format\n";
+	print $failhandle "$tailname$suffix: " . ref($self) . " failed to convert to $convert_to\n";
+	# The following  meant that if a conversion failed, the document would be counted twice - do we need it for anything?
+	#$self->{'num_not_processed'} ++;
+	if (-s "$errlog") {
+	    open(ERRLOG, "$errlog");
+	    while (<ERRLOG>) {
+		print $outhandle "$_";
+	    }
+	    print $outhandle "\n";
+	    close ERRLOG;
+	}
+	&util::rm("$errlog") if (-e "$errlog");
+	return "";
+    }
+
+    # store the *actual* output type and return the output filename
+    # it's possible we requested conversion to html, but only to text succeeded
+    #$self->{'convert_to_ext'} = $output_type;
+    if ($output_type =~ /html/i) {
+	$self->{'converted_to'} = "HTML";
+    } elsif ($output_type =~ /te?xt/i) {
+	$self->{'converted_to'} = "TEXT";
+    } elsif ($output_type =~ /item/i){
+	$self->{'converted_to'} = "PagedImg";
+    }
+    
+    my $output_filename = $tmp_filename;
+    if ($output_type =~ /item/i) {
+	# running under windows
+	if ($ENV{'GSDLOS'} =~ /^windows$/i) {
+	    $output_filename = $tmp_dirname . "\\$tailname\\" . $tailname . ".$output_type";
+	} else {
+	    $output_filename = $tmp_dirname . "\/$tailname\/" . $tailname . ".$output_type";
+	}
+    } else {
+	$output_filename =~ s/$suffix$/.$output_type/;
+    }
+    
+    return $output_filename;
+}
+
+
+# Override BasPlug read
+# We don't want to get language encoding stuff until after we've converted
+# our file to either TEXT or HTML or PagedImage.
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+    
+    my ($block_status,$filename) = $self->read_block(@_);
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+    $file = $self->read_tidy_file($file);
+    
+    my $output_ext = $self->{'convert_to_ext'};
+    my $conv_filename = "";
+    $conv_filename = $self->tmp_area_convert_file($output_ext, $filename);
+    
+    if ("$conv_filename" eq "") {return -1;} # had an error, will be passed down pipeline 
+    if (! -e "$conv_filename") {return -1;} 
+    $self->{'conv_filename'} = $conv_filename;
+    $self->convert_post_process($conv_filename);
+
+    # Run the "fribidi" (http://fribidi.org) Unicode Bidirectional Algorithm program over the converted file
+    # Added for fixing up Persian PDFs after being processed by pdftohtml, but may be useful in other cases too
+    if ($self->{'apply_fribidi'} && $self->{'converted_to'} =~ /(HTML|TEXT)/) {
+	my $fribidi_command = "fribidi \"$conv_filename\" >\"${conv_filename}.tmp\"";
+	if (system($fribidi_command) != 0) {
+	    print STDERR "ERROR: Cannot run fribidi on \"$conv_filename\".\n";
+	}
+	else {
+	    &util::mv("${conv_filename}.tmp", $conv_filename);
+	}	
+    }
+
+    my $secondary_plugins =  $self->{'secondary_plugins'};
+    my $num_secondary_plugins = scalar(keys %$secondary_plugins);
+
+    if ($num_secondary_plugins == 0) {
+	print $outhandle "Warning: No secondary plugin to use in conversion.  Skipping $file\n";
+	return 0; # effectively block it
+    }
+
+    my @plugin_names = keys %$secondary_plugins;
+    my $plugin_name = shift @plugin_names;
+	
+    if ($num_secondary_plugins > 1) {
+	print $outhandle "Warning: Multiple secondary plugins not supported yet!  Choosing $plugin_name\n.";
+    }
+   
+    my $secondary_plugin = $secondary_plugins->{$plugin_name};
+
+    # note: metadata is not carried on to the next level
+    my ($rv,$doc_obj) 
+	= $secondary_plugin->read_into_doc_obj ($pluginfo,"", $conv_filename, 
+						$metadata, $processor, $maxdocs, $total_count,
+						$gli);
+
+    if ((!defined $rv) || ($rv<1)) {
+	# wasn't processed
+	return $rv;
+    }
+    
+    # Override previous gsdlsourcefilename set by secondary plugin
+    my $collect_file = &util::filename_within_collection($filename);
+    my $collect_conv_file = &util::filename_within_collection($conv_filename);
+    $doc_obj->set_source_filename ($collect_file); 
+    $doc_obj->set_converted_filename($collect_conv_file);
+
+    my ($filemeta) = $file =~ /([^\\\/]+)$/;
+    $doc_obj->set_utf8_metadata_element($doc_obj->get_top_section(), "Source", &ghtml::dmsafe($filemeta));
+    $doc_obj->set_utf8_metadata_element($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
+    $doc_obj->set_utf8_metadata_element($doc_obj->get_top_section(), "FileSize", (-s $filename));
+
+    if ($self->{'cover_image'}) {
+	$self->associate_cover_image($doc_obj, $filename);
+    }
+
+    # do plugin specific processing of doc_obj
+    unless (defined ($self->process(undef, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli))) {
+	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
+	return -1;
+    }
+    # do any automatic metadata extraction
+    $self->auto_extract_metadata ($doc_obj);
+
+    # have we found a Title??
+    $self->title_fallback($doc_obj,$doc_obj->get_top_section(),$filemeta);
+
+#    # add an OID
+#    $doc_obj->set_OID();
+
+    # add an OID
+    # see if there is a plugin-specific set_OID function...
+    if (defined ($self->can('set_OID'))) {
+	# it will need $doc_obj to set the Identifier metadata...
+	$self->set_OID($doc_obj);
+    } else {
+	# use the default set_OID() in doc.pm
+	$doc_obj->set_OID();
+    }
+
+
+    # process the document
+    $processor->process($doc_obj);
+
+    $self->{'num_processed'} ++;
+
+    return 1;
+}
+
+
+# do plugin specific processing of doc_obj for doc_ext type
+sub process_type {
+    my $self = shift (@_);
+    my ($doc_ext, $base_dir, $file, $doc_obj) = @_;
+    
+    # associate original file with doc object
+    my $cursection = $doc_obj->get_top_section();
+    my $filename = &util::filename_cat($base_dir, $file);
+    my $assocfilename = "doc.$doc_ext";
+    if ($self->{'keep_original_filename'} == 1) {
+	# this should be the same filename that was used for the Source metadata, as we will use [Source] in the srclink
+	($assocfilename) = $file =~ /([^\\\/]+)$/;
+    }
+    $doc_obj->associate_file($filename, $assocfilename, undef, $cursection);
+
+    my $file_type;
+
+    if ($doc_ext eq "doc") {
+    	$file_type = "Word";
+    } elsif ($doc_ext eq "xls") {
+	$file_type = "Excel";
+    } elsif ($doc_ext eq "ppt") {
+	$file_type = "PPT"; 
+    } elsif ($doc_ext eq "pdf") {
+	$file_type = "PDF"; 
+    } elsif ($doc_ext eq "rtf") {
+	$file_type = "RTF";
+    } elsif ($doc_ext eq "ps") {
+	$file_type = "PS";
+    }
+
+    my $file_format = $file_type || "unknown";
+
+    # We use set instead of add here because we only want one value
+    $doc_obj->set_utf8_metadata_element($cursection, "FileFormat", $file_format);
+    my $doclink = "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[archivedir]/doc.$doc_ext\">";
+    if ($self->{'keep_original_filename'} == 1) {
+	$doclink = "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[archivedir]/[Source]\">";
+    }
+    $doc_obj->add_utf8_metadata ($cursection, "srclink",  $doclink); 
+    $doc_obj->add_utf8_metadata ($cursection, "srcicon",  "_icon".$doc_ext."_"); 
+    $doc_obj->add_utf8_metadata ($cursection, "/srclink", "</a>"); 
+
+    return 1;
+}
+
+1;
+
+
+
+
+
+
+
Index: dl/trunk/perllib/plugins/ConvertToPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ConvertToPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,536 +1,0 @@
-###########################################################################
-#
-# ConvertToPlug.pm -- plugin that inherits from BasPlug
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999 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.
-#
-###########################################################################
-
-# This plugin is inherited by such plugins as WordPlug, PPTPlug, PSPlug, 
-# RTFPlug and PDFPlug. It facilitates the conversion of these document types 
-# to either HTML, TEXT or a series of images. It works by dynamically loading 
-# an appropriate secondary plugin (HTMLPlug, StructuredHTMLPlug, 
-# PagedImgPlug or TEXTPlug) based on the plugin argument 'convert_to'. 
-
-package ConvertToPlug;
-
-use BasPlug;
-use ghtml;
-use HTMLPlug;
-use TEXTPlug;
-use PagedImgPlug;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-no strict 'subs';
-sub BEGIN {
-    @ConvertToPlug::ISA = ('BasPlug');
-}
-
-my $convert_to_list =
-    [ {	'name' => "auto",
-	'desc' => "{ConvertToPlug.convert_to.auto}" },
-      {	'name' => "html",
-	'desc' => "{ConvertToPlug.convert_to.html}" },
-      {	'name' => "text",
-	'desc' => "{ConvertToPlug.convert_to.text}" }
-      ];
-
-my $arguments =
-    [ { 'name' => "convert_to",
-	'desc' => "{ConvertToPlug.convert_to}",
-	'type' => "enum",
-	'reqd' => "yes",
-	'list' => $convert_to_list, 
-	'deft' => "auto" },
-      { 'name' => "keep_original_filename",
-	'desc' => "{ConvertToPlug.keep_original_filename}",
-	'type' => "flag" },
-      { 'name' => "title_sub",
-	'desc' => "{HTMLPlug.title_sub}",
-	'type' => "string", 
-	#'type' => "regexp",
-	'deft' => "" },
-      { 'name' => "apply_fribidi",
-	'desc' => "{ConvertToPlug.apply_fribidi}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "use_strings",
-	'desc' => "{ConvertToPlug.use_strings}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "extract_keyphrases",
-	'desc' => "{BasPlug.extract_keyphrases}",
-	'type' => "flag",
-	'reqd' => "no",
-	'hiddengli' => "yes" },
-      { 'name' => "extract_keyphrase_options",
-	'desc' => "{BasPlug.extract_keyphrase_options}",
-	'type' => "string",
-	'reqd' => "no",
-	'hiddengli' => "yes" } ];
-
-my $options = { 'name'     => "ConvertToPlug",
-		'desc'     => "{ConvertToPlug.desc}",
-		'abstract' => "yes",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-
-sub load_secondary_plugins
-{
-    my $self = shift (@_);
-    my ($class,$input_args,$hashArgOptLists) = @_;
-
-    my @convert_to_list = split(",",$self->{'convert_to'});
-    my $secondary_plugins = {};
-    # find the plugin
-
-    foreach my $convert_to (@convert_to_list) {
-	# load in "convert_to" plugin package
-	my $plugin_class = $convert_to."Plug";
-	my $plugin_package = $plugin_class.".pm";
-
-	my $colplugname = undef;
-	if (defined $ENV{'GSDLCOLLECTDIR'}) {
-	    $colplugname = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},
-					       "perllib","plugins", 
-					       $plugin_package);
-	}
-
-	my $mainplugname = &util::filename_cat($ENV{'GSDLHOME'},
-					       "perllib","plugins", 
-					       $plugin_package);
-
-	if ((defined $colplugname) && (-e $colplugname)) { require $colplugname;}
-	elsif (-e $mainplugname) { require $mainplugname; }
-	else {
-	    &gsprintf(STDERR, "{plugin.could_not_find_plugin}\n",
-		      $plugin_class);
-	    die "\n";
-	}
-
-	# call its constructor with extra options that we've worked out!
-	my $arglist = $input_args->{$plugin_class};
-
-	my ($secondary_plugin);
-	eval("\$secondary_plugin = new $plugin_class([],\$arglist)");
-	die "$@" if $@;
-	$secondary_plugins->{$plugin_class} = $secondary_plugin;
-    }
-    $self->{'secondary_plugins'} = $secondary_plugins;
-}
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-    my $classPluginName = (defined $pluginlist->[0]) ? $pluginlist->[0] : $class;
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-    
-    if ($self->{'info_only'}) {
-	# don't worry about any options etc
-	return bless $self, $class;
-    }
-
-    my $convert_to_type = $self->{'convert_to'};
-    if (!defined $convert_to_type || $convert_to_type eq "") {
-	$convert_to_type = "auto";
-    }
-    my $windows_scripting = $self->{'windows_scripting'};
-    $windows_scripting = 0 unless defined $windows_scripting;
-    if ($classPluginName eq "PDFPlug") {
-	if ($convert_to_type eq "text" && 
-	    $ENV{'GSDLOS'} =~ /^windows$/i) {
-	    print STDERR "Windows does not support pdf to text. PDFs will be converted to HTML instead\n";
-	    $convert_to_type = "html";
-	}
-    } elsif ($classPluginName eq "WordPlug") {
-	if ($windows_scripting && $ENV{'GSDLOS'} =~ /^windows$/i && $convert_to_type =~ /^(html|auto)$/) {
-	    # we use structured HTML, not normal html
-	    $convert_to_type = "structuredhtml";
-	} 
-    } elsif ($classPluginName eq "PPTPlug") {
-	if ($windows_scripting && $ENV{'GSDLOS'} =~ /^windows$/i && $convert_to_type eq "auto") {
-	    # we use paged img
-	    $convert_to_type = "pagedimg_jpg";
-	} 
-    } elsif ($classPluginName eq "PSPlug") {
-	if ($convert_to_type eq "auto") {
-	    # we use text
-	    $convert_to_type = "text";
-	}
-    }
-    
-    if ($convert_to_type eq "auto") {
-	# choose html for now - should choose a format based on doc type
-	$convert_to_type = "html";
-    }
-    
-    if ($convert_to_type eq "html") {
-	$self->{'convert_to'} = "HTML";
-	$self->{'convert_to_ext'} = "html";
-    } elsif ($convert_to_type eq "text") {
-	$self->{'convert_to'} = "TEXT";
-	$self->{'convert_to_ext'} = "txt";
-    } elsif ($convert_to_type eq "structuredhtml") {
-	$self->{'convert_to'} = "StructuredHTML";
-	$self->{'convert_to_ext'} = "html";
-    } elsif ($convert_to_type =~ /^pagedimg/) {
-	$self->{'convert_to'} = "PagedImg";
-	my ($convert_to_ext) = $convert_to_type =~ /pagedimg\_(jpg|gif|png)/i;
-	$convert_to_ext = 'jpg' unless defined $convert_to_ext;
-	$self->{'convert_to_ext'} = $convert_to_ext;
-    }
-
-    return bless $self, $class;
-}
-
-
-sub init {
-    my $self = shift (@_);
-    my ($verbosity, $outhandle, $failhandle) = @_;
-
-    $self->SUPER::init($verbosity,$outhandle,$failhandle);
-
-    my $secondary_plugins =  $self->{'secondary_plugins'};
-
-    foreach my $plug_name (keys %$secondary_plugins) {
-	my $plugin = $secondary_plugins->{$plug_name};
-	$plugin->init($verbosity,$outhandle,$failhandle);
-    }
-}
-
-sub deinit {
-    # called only once, after all plugin passes have been done
-
-    my ($self) = @_;
-
-    my $secondary_plugins =  $self->{'secondary_plugins'};
-
-    foreach my $plug_name (keys %$secondary_plugins) {
-	my $plugin = $secondary_plugins->{$plug_name};
-	$plugin->deinit();
-    }
-}
-
-sub convert_post_process
-{
-    # by default do no post processing
-    return;
-}
-
-
-# Run conversion utility on the input file.  
-#
-# The conversion takes place in a collection specific 'tmp' directory so 
-# that we don't accidentally damage the input.
-#
-# The desired output type is indicated by $output_ext.  This is usually
-# something like "html" or "word", but can be "best" (or the empty string)
-# to indicate that the conversion utility should do the best it can.
-sub tmp_area_convert_file {
-    my $self = shift (@_);
-    my ($output_ext, $input_filename, $textref) = @_;
-    
-    my $outhandle = $self->{'outhandle'};
-    my $convert_to = $self->{'convert_to'};
-    my $failhandle = $self->{'failhandle'};
-    my $convert_to_ext = $self->{'convert_to_ext'};
-    
-    # derive tmp filename from input filename
-    my ($tailname, $dirname, $suffix)
-	= &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
-
-    # softlink to collection tmp dir
-    my $tmp_dirname = $dirname;
-    if(defined $ENV{'GSDLCOLLECTDIR'}) {
-	$tmp_dirname = $ENV{'GSDLCOLLECTDIR'};
-    } elsif(defined $ENV{'GSDLHOME'}) {
-	$tmp_dirname = $ENV{'GSDLHOME'};
-    }
-    $tmp_dirname = &util::filename_cat($tmp_dirname, "tmp");
-    &util::mk_dir($tmp_dirname) if (!-e $tmp_dirname);
-   
-    # The following is not necessary and will cause problems with
-    # replacing_srcdoc_with_html in the GSDLremote case:
-    # Remove any white space from filename -- no risk of name collision, and
-    # makes later conversion by utils simpler. Leave spaces in path...
-    # tidy up the filename with space, dot, hyphen between
-    #$tailname =~ s/\s+//g; 
-    #$tailname =~ s/\.+//g;
-    #$tailname =~ s/\-+//g;
-
-    # convert to utf-8 otherwise we have problems with the doc.xml file
-    # later on
-    &unicode::ensure_utf8(\$tailname);
-
-    $suffix = lc($suffix);
-    my $tmp_filename = &util::filename_cat($tmp_dirname, "$tailname$suffix");
-    
-    # If gsdl is remote, we're given relative path to input file, of the form import/tailname.suffix
-    # But we can't softlink to relative paths. Therefore, we need to ensure that
-    # the input_filename is the absolute path, see http://perldoc.perl.org/File/Spec.html
-    my $ensure_path_absolute = 1; # true
-    &util::soft_link($input_filename, $tmp_filename, $ensure_path_absolute);
-    my $verbosity = $self->{'verbosity'};
-    if ($verbosity > 0) {
-	print $outhandle "Converting $tailname$suffix to $convert_to format\n";
-    }
-
-    my $errlog = &util::filename_cat($tmp_dirname, "err.log");
-    
-    # Execute the conversion command and get the type of the result,
-    # making sure the converter gives us the appropriate output type
-    my $output_type="";
-    if ($convert_to =~ m/PagedImg/i) {
-	$output_type = lc($convert_to)."_".lc($convert_to_ext);
-    } else {
-	$output_type = lc($convert_to);
-    }
-
-    my $cmd = "perl -S gsConvert.pl -verbose $verbosity ";
-    if (defined $self->{'convert_options'}) {
-	$cmd .= $self->{'convert_options'} . " ";
-    }
-    if ($self->{'use_strings'}) {
-      $cmd .= "-use_strings ";
-    }
-    $cmd .= "-errlog \"$errlog\" -output $output_type \"$tmp_filename\"";
-    $output_type = `$cmd`;
-
-    # remove symbolic link to original file
-    &util::rm($tmp_filename);
-    
-    # Check STDERR here
-    chomp $output_type;
-    if ($output_type eq "fail") {
-	print $outhandle "Could not convert $tailname$suffix to $convert_to format\n";
-	print $failhandle "$tailname$suffix: " . ref($self) . " failed to convert to $convert_to\n";
-	# The following  meant that if a conversion failed, the document would be counted twice - do we need it for anything?
-	#$self->{'num_not_processed'} ++;
-	if (-s "$errlog") {
-	    open(ERRLOG, "$errlog");
-	    while (<ERRLOG>) {
-		print $outhandle "$_";
-	    }
-	    print $outhandle "\n";
-	    close ERRLOG;
-	}
-	&util::rm("$errlog") if (-e "$errlog");
-	return "";
-    }
-
-    # store the *actual* output type and return the output filename
-    # it's possible we requested conversion to html, but only to text succeeded
-    #$self->{'convert_to_ext'} = $output_type;
-    if ($output_type =~ /html/i) {
-	$self->{'converted_to'} = "HTML";
-    } elsif ($output_type =~ /te?xt/i) {
-	$self->{'converted_to'} = "TEXT";
-    } elsif ($output_type =~ /item/i){
-	$self->{'converted_to'} = "PagedImg";
-    }
-    
-    my $output_filename = $tmp_filename;
-    if ($output_type =~ /item/i) {
-	# running under windows
-	if ($ENV{'GSDLOS'} =~ /^windows$/i) {
-	    $output_filename = $tmp_dirname . "\\$tailname\\" . $tailname . ".$output_type";
-	} else {
-	    $output_filename = $tmp_dirname . "\/$tailname\/" . $tailname . ".$output_type";
-	}
-    } else {
-	$output_filename =~ s/$suffix$/.$output_type/;
-    }
-    
-    return $output_filename;
-}
-
-
-# Override BasPlug read
-# We don't want to get language encoding stuff until after we've converted
-# our file to either TEXT or HTML or PagedImage.
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-    
-    my ($block_status,$filename) = $self->read_block(@_);
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-    $file = $self->read_tidy_file($file);
-    
-    my $output_ext = $self->{'convert_to_ext'};
-    my $conv_filename = "";
-    $conv_filename = $self->tmp_area_convert_file($output_ext, $filename);
-    
-    if ("$conv_filename" eq "") {return -1;} # had an error, will be passed down pipeline 
-    if (! -e "$conv_filename") {return -1;} 
-    $self->{'conv_filename'} = $conv_filename;
-    $self->convert_post_process($conv_filename);
-
-    # Run the "fribidi" (http://fribidi.org) Unicode Bidirectional Algorithm program over the converted file
-    # Added for fixing up Persian PDFs after being processed by pdftohtml, but may be useful in other cases too
-    if ($self->{'apply_fribidi'} && $self->{'converted_to'} =~ /(HTML|TEXT)/) {
-	my $fribidi_command = "fribidi \"$conv_filename\" >\"${conv_filename}.tmp\"";
-	if (system($fribidi_command) != 0) {
-	    print STDERR "ERROR: Cannot run fribidi on \"$conv_filename\".\n";
-	}
-	else {
-	    &util::mv("${conv_filename}.tmp", $conv_filename);
-	}	
-    }
-
-    my $secondary_plugins =  $self->{'secondary_plugins'};
-    my $num_secondary_plugins = scalar(keys %$secondary_plugins);
-
-    if ($num_secondary_plugins == 0) {
-	print $outhandle "Warning: No secondary plugin to use in conversion.  Skipping $file\n";
-	return 0; # effectively block it
-    }
-
-    my @plugin_names = keys %$secondary_plugins;
-    my $plugin_name = shift @plugin_names;
-	
-    if ($num_secondary_plugins > 1) {
-	print $outhandle "Warning: Multiple secondary plugins not supported yet!  Choosing $plugin_name\n.";
-    }
-   
-    my $secondary_plugin = $secondary_plugins->{$plugin_name};
-
-    # note: metadata is not carried on to the next level
-    my ($rv,$doc_obj) 
-	= $secondary_plugin->read_into_doc_obj ($pluginfo,"", $conv_filename, 
-						$metadata, $processor, $maxdocs, $total_count,
-						$gli);
-
-    if ((!defined $rv) || ($rv<1)) {
-	# wasn't processed
-	return $rv;
-    }
-    
-    # Override previous gsdlsourcefilename set by secondary plugin
-    my $collect_file = &util::filename_within_collection($filename);
-    my $collect_conv_file = &util::filename_within_collection($conv_filename);
-    $doc_obj->set_source_filename ($collect_file); 
-    $doc_obj->set_converted_filename($collect_conv_file);
-
-    my ($filemeta) = $file =~ /([^\\\/]+)$/;
-    $doc_obj->set_utf8_metadata_element($doc_obj->get_top_section(), "Source", &ghtml::dmsafe($filemeta));
-    $doc_obj->set_utf8_metadata_element($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
-    $doc_obj->set_utf8_metadata_element($doc_obj->get_top_section(), "FileSize", (-s $filename));
-
-    if ($self->{'cover_image'}) {
-	$self->associate_cover_image($doc_obj, $filename);
-    }
-
-    # do plugin specific processing of doc_obj
-    unless (defined ($self->process(undef, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli))) {
-	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
-	return -1;
-    }
-    # do any automatic metadata extraction
-    $self->auto_extract_metadata ($doc_obj);
-
-    # have we found a Title??
-    $self->title_fallback($doc_obj,$doc_obj->get_top_section(),$filemeta);
-
-#    # add an OID
-#    $doc_obj->set_OID();
-
-    # add an OID
-    # see if there is a plugin-specific set_OID function...
-    if (defined ($self->can('set_OID'))) {
-	# it will need $doc_obj to set the Identifier metadata...
-	$self->set_OID($doc_obj);
-    } else {
-	# use the default set_OID() in doc.pm
-	$doc_obj->set_OID();
-    }
-
-
-    # process the document
-    $processor->process($doc_obj);
-
-    $self->{'num_processed'} ++;
-
-    return 1;
-}
-
-
-# do plugin specific processing of doc_obj for doc_ext type
-sub process_type {
-    my $self = shift (@_);
-    my ($doc_ext, $base_dir, $file, $doc_obj) = @_;
-    
-    # associate original file with doc object
-    my $cursection = $doc_obj->get_top_section();
-    my $filename = &util::filename_cat($base_dir, $file);
-    my $assocfilename = "doc.$doc_ext";
-    if ($self->{'keep_original_filename'} == 1) {
-	# this should be the same filename that was used for the Source metadata, as we will use [Source] in the srclink
-	($assocfilename) = $file =~ /([^\\\/]+)$/;
-    }
-    $doc_obj->associate_file($filename, $assocfilename, undef, $cursection);
-
-    my $file_type;
-
-    if ($doc_ext eq "doc") {
-    	$file_type = "Word";
-    } elsif ($doc_ext eq "xls") {
-	$file_type = "Excel";
-    } elsif ($doc_ext eq "ppt") {
-	$file_type = "PPT"; 
-    } elsif ($doc_ext eq "pdf") {
-	$file_type = "PDF"; 
-    } elsif ($doc_ext eq "rtf") {
-	$file_type = "RTF";
-    } elsif ($doc_ext eq "ps") {
-	$file_type = "PS";
-    }
-
-    my $file_format = $file_type || "unknown";
-
-    # We use set instead of add here because we only want one value
-    $doc_obj->set_utf8_metadata_element($cursection, "FileFormat", $file_format);
-    my $doclink = "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[archivedir]/doc.$doc_ext\">";
-    if ($self->{'keep_original_filename'} == 1) {
-	$doclink = "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[archivedir]/[Source]\">";
-    }
-    $doc_obj->add_utf8_metadata ($cursection, "srclink",  $doclink); 
-    $doc_obj->add_utf8_metadata ($cursection, "srcicon",  "_icon".$doc_ext."_"); 
-    $doc_obj->add_utf8_metadata ($cursection, "/srclink", "</a>"); 
-
-    return 1;
-}
-
-1;
-
-
-
-
-
-
-
Index: dl/trunk/perllib/plugins/ConvertToRogPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ConvertToRogPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,454 +1,0 @@
-###########################################################################
-#
-# ConvertToRogPlug.pm -- plugin that inherits from RogPlug
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999 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 ConvertToRogPlug;
-
-use BasPlug;
-use RogPlug;
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @ConvertToRogPlug::ISA = ('RogPlug');
-}
-
-my $arguments = [
-		 ];
-my $options = { 'name'     => "ConvertToRogPlug",
-		'desc'     => "{ConvertToRogPlug.desc}",
-		'abstract' => "yes",
-		'inherits' => "yes" };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new RogPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    $self->{'convert_to'} = "Rog";
-    $self->{'convert_to_ext'} = "rog";
-
-    return bless $self, $class;
-}
-
-
-sub begin {
-    my $self = shift (@_);
-    
-    $self->SUPER::begin(@_);
-
-    $self->{'docnum'} = 0;
-}
-
-sub end {
-    my ($self) = @_;
-
-    # nothing to do, but keep symmetric with begin function
-    $self->SUPER::end(@_);
-}
-
-
-# Run conversion utility on the input file.  
-#
-# The conversion takes place in a collection specific 'tmp' directory so 
-# that we don't accidentally damage the input.
-#
-# The desired output type is indicated by $output_ext.  This is usually
-# something like "html" or "word", but can be "best" (or the empty string)
-# to indicate that the conversion utility should do the best it can.
-
-sub tmp_area_convert_file {
-    my $self = shift (@_);
-    my ($output_ext, $input_filename, $textref) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-    my $convert_to = $self->{'convert_to'};
-    my $failhandle = $self->{'failhandle'};
-
-    # softlink to collection tmp dir
-    my $tmp_dirname 
-	= &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, "tmp");
-    &util::mk_dir($tmp_dirname) if (!-e $tmp_dirname);
-
-    # derive tmp filename from input filename
-    my ($tailname, $dirname, $suffix)
-	= &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
-
-    # Remove any white space from filename -- no risk of name collision, and
-    # makes later conversion by utils simpler. Leave spaces in path...
-    $tailname =~ s/\s+//g; 
-
-    my $tmp_filename = &util::filename_cat($tmp_dirname, "$tailname$suffix");
-
-    &util::soft_link($input_filename, $tmp_filename);
-
-    my $verbosity = $self->{'verbosity'};
-    if ($verbosity > 0) {
-	print $outhandle "Converting $tailname$suffix to $convert_to format\n";
-    }
-
-    my $errlog = &util::filename_cat($tmp_dirname, "err.log");
-    
-    # Execute the conversion command and get the type of the result,
-    # making sure the converter gives us the appropriate output type
-    my $output_type = lc($convert_to);
-    my $cmd = "perl -S gsMusicConvert.pl -verbose $verbosity -errlog \"$errlog\" -output $output_type \"$tmp_filename\"";
-    $output_type = `$cmd`;
-
-    # remove symbolic link to original file
-    &util::rm($tmp_filename);
-
-    # Check STDERR here
-    chomp $output_type;
-    if ($output_type eq "fail") {
-	print $outhandle "Could not convert $tailname$suffix to $convert_to format\n";
-	print $failhandle "$tailname$suffix: " . ref($self) . " failed to convert to $convert_to\n";
-	$self->{'num_not_processed'} ++;
-	if (-s "$errlog") {
-	    open(ERRLOG, "$errlog");
-	    while (<ERRLOG>) {
-		print $outhandle "$_";
-	    }
-	    print $outhandle "\n";
-	    close ERRLOG;
-	}
-	&util::rm("$errlog") if (-e "$errlog");
-	return "";
-    }
-
-    # store the *actual* output type and return the output filename
-    # it's possible we requested conversion to html, but only to text succeeded
-
-    $self->{'convert_to_ext'} = $output_type;
-    $self->{'converted_to'} = "Rog";
-
-    my $output_filename = $tmp_filename;
-
-    $output_filename =~ s/$suffix$//;
-
-    return $output_filename;
-}
-
-
-# Remove collection specific tmp directory and all its contents.
-
-sub cleanup_tmp_area {
-    my $self = shift (@_);
-
-    my $tmp_dirname 
-	= &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, "tmp");
-    &util::rm_r($tmp_dirname);
-    &util::mk_dir($tmp_dirname);
-}
-
-
-# Exact copy of read_rog_record from RogPlug 
-# Needed for FILE in right scope
-
-sub read_rog_record
-{
-    my ($self,$file_buffer, $docnum, $seclevel) = @_;
-
-    my $next_line = $file_buffer->{'next_line'};
-
-    return 0 if (!defined $next_line);
-
-    if ($next_line eq "")
-    {
-	my $line;
-	while(defined($line=<FILE>))  
-	{
-	    $line =~ s/\r$//;
-	    $file_buffer->{'line_no'}++;
-	    next if ($line =~ m/^\#/);
-	    $next_line = $line;
-	    last;
-	}
-    }
-	    
-    if ($next_line !~ m/^song( +)\"([^\"]*)\"( +)\"([^\"]*)\"( +)(\d+)( *)$/) 
-    {
-	print STDERR "Error: Malformed Rog file: $next_line";
-	return 0;
-    }
-    else
-    {
-	# init default values
-	$file_buffer->{'song'}->{'tempo'}    = 120;
-	$file_buffer->{'song'}->{'ks_type'}  = 0;
-	$file_buffer->{'song'}->{'ks_num'}   = 0;
-	$file_buffer->{'song'}->{'metadata'} = [];
-	$file_buffer->{'song'}->{'content'}  = "";
-	
-	$file_buffer->{'song'}->{'subcol'} = $2;
-	$file_buffer->{'song'}->{'title'}  = $4;
-	$file_buffer->{'song'}->{'tval'}   = $6;
-
-	chomp($next_line);
-	my $content = $next_line;
-	if (defined $docnum) 
-	{
-	    $content.= " $docnum $seclevel";
-	}
-	$content .= "\n";
-
-	$file_buffer->{'song'}->{'content'} = $content;
-
-
-	my $line;
-	while(defined($line=<FILE>))  
-	{
-	    $line =~ s/\r$//;
-
-	    $file_buffer->{'line_no'}++;
-	    next if ($line =~ m/^\#/);
-	
-	    if ($line =~ m/^song/) 
-	    {	
-		$file_buffer->{'next_line'} = $line;
-		return 1;
-	    }
-	    elsif ($line =~ m/^tempo( +)(\d+)( *)$/) 
-	    {
-		$file_buffer->{'song'}->{'tempo'} = $2;
-		$file_buffer->{'song'}->{'content'} .= $line;
-	    } 
-	    elsif ($line =~ m/^keysig( +)(\d+)( +)(\d+)( *)$/) 
-	    {
-		$file_buffer->{'song'}->{'ks_type'} = $2;
-		$file_buffer->{'song'}->{'ks_num'}  = $4;
-		$file_buffer->{'song'}->{'content'} .= $line;	   
-	    } 
-	    elsif ($line =~ m/^timesig( +)(\d+)( +)(\d+)( *)$/) 
-	    {
-		$file_buffer->{'song'}->{'ts_numer'} = $2;
-		$file_buffer->{'song'}->{'ts_denom'} = $4;
-		$file_buffer->{'song'}->{'content'} .= $line;
-	    }
-	    elsif ($line =~ m/^metadata ([^:]*): (.*)/)
-	    {
-		push(@{$file_buffer->{'song'}->{'metadata'}},[$1,$2]);
-		$file_buffer->{'song'}->{'content'} .= $line;
-	    }
-	    else
-	    {
-		$file_buffer->{'song'}->{'content'} .= $line;
-	    }
-	}
-	
-	$file_buffer->{'next_line'} = undef;
-    }
-
-    return 1;
-}
-
-# Override RogPlug function so rog files are stored as sections (not docs)
-
-sub process_rog_record
-{
-    my ($self,$doc_obj,$cursection,$song) = @_;
-
-    $cursection = 
-	$doc_obj->insert_section($cursection);
-    $self->{'docnum'}++;
-
-    my $title = $song->{'title'};
-    my $title_safe = $title;
-    $title_safe =~ s/\'/\\\\&apos;/g;
-
-    # add metadata 
-    $doc_obj->add_metadata($cursection, "Tempo",         $song->{'tempo'}); 
-    $doc_obj->add_metadata($cursection, "KeySigType",    $song->{'ks_type'}); 
-    $doc_obj->add_metadata($cursection, "KeySigNum",     $song->{'ks_num'}); 
-    $doc_obj->add_metadata($cursection, "SubCollection", $song->{'subcol'}); 
-    $doc_obj->add_metadata($cursection, "Title",         $title); 
-    $doc_obj->add_metadata($cursection, "TitleSafe",     $title_safe); 
-    $doc_obj->add_metadata($cursection, "TVal",          $song->{'tval'}); 
-
-    foreach my $md ( @{$song->{'metadata'}} )
-    {
-	$doc_obj->add_metadata($cursection, $md->[0], $md->[1]); 
-    }
-
-    # add contents as text
-    $doc_obj->add_text($cursection,$song->{'content'});
-
-    return $cursection;
-}
-
-
-
-# Override BasPlug read
-# We don't want to get language encoding stuff until after we've converted
-# our file to Rog format
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-
-    # check process_exp, block_exp, associate_ext etc
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
- 
-    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
-
-    # read in file ($text will be in utf8)
-    my $text = "";
-
-    my $output_ext = $self->{'convert_to_ext'};
-    my $conv_filename = $self->tmp_area_convert_file($output_ext, $filename);
-
-    if ("$conv_filename" eq "") {return 0;} # allows continue on errors
-    $self->{'conv_filename'} = $conv_filename;
-
-
-    # create a new document
-    #my $doc_obj = new doc ($conv_filename, "indexed_doc");
-    # the original filename is used now
-    my $doc_obj = new doc ($filename, "indexed_doc");
-    # the converted filename is set separately
-    $doc_obj->set_converted_filename($conv_filename);
-
-    my $topsection = $doc_obj->get_top_section();
-    my $cursection = $topsection;
-
-    $self->{'docnum'}++;
-    my $docnum = $self->{'docnum'};
-
-    $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
-    my ($filemeta) = $file =~ /([^\\\/]+)$/;
-    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Source", &ghtml::dmsafe($filemeta));
-    if ($self->{'cover_image'}) {
-	$self->associate_cover_image($doc_obj, $filename);
-    }
-    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
-    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "FileSize", (-s $filename));
-
-    my $track_no = "1";
-    my $rog_filename = "$conv_filename$track_no.$output_ext";
-    while (1)
-    {
-	last unless open (FILE, $rog_filename) ;
-
-	my $file_buffer = { line_no => 0, next_line => "", song => {} };
-	
-	while ($self->read_rog_record($file_buffer, $docnum, $track_no))
-	{
-	    my $song = $file_buffer->{'song'};
-	    my $content = $song->{'content'};
-	    $content =~ s/^song\w+(.*)$/song $1 X.$track_no/;
-	    
-	    $cursection 
-		= $self->process_rog_record($doc_obj,$cursection,
-					    $file_buffer->{'song'});
-	}
-
-	close FILE;
-
-	$track_no++;
-	$rog_filename = "$conv_filename$track_no.$output_ext";
-    }
-
-    print STDERR "\n";
-
-    # include any metadata passed in from previous plugins 
-    # note that this metadata is associated with the top level section
-    $self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
-    # do plugin specific processing of doc_obj
-    unless (defined ($self->process(\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj))) {
-	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
-	return -1;
-    }
-    # do any automatic metadata extraction
-    $self->auto_extract_metadata ($doc_obj);
-    # add an OID
-    $doc_obj->set_OID();
-
-    my $oid = $doc_obj->get_OID();
-    my $appletlink = "<a href=\"javascript:meldexout(\'$oid\','[TitleSafe]')\">";
-
-    $doc_obj->add_utf8_metadata ($topsection, "audiolink",  $appletlink); 
-    $doc_obj->add_utf8_metadata ($topsection, "audioicon",  "_iconaudio_"); 
-    $doc_obj->add_utf8_metadata ($topsection, "/audiolink", "</a>"); 
-
-    # if no title metadata defined, set it to filename minus extension
-    my $existing_title = $doc_obj->get_metadata_element($topsection,"Title");
-    if (!defined $existing_title) 
-    {
-	my $title = $doc_obj->get_metadata_element($topsection,"Source");
-	$title =~ s/\..*?$//g;
-	$doc_obj->add_utf8_metadata ($topsection, "Title", $title); 
-
-	my $title_safe = $title;
-	$title_safe =~ s/\'/\\\\&apos;/g;
-	$doc_obj->add_utf8_metadata ($topsection, "TitleSafe", $title_safe); 
-    }
-
-    # process the document
-    $processor->process($doc_obj);
-    $self->cleanup_tmp_area();
-
-    $self->{'num_processed'} ++;
-
-    return 1;
-}
-
-
-# do plugin specific processing of doc_obj for HTML type
-sub process_type {
-    my $self = shift (@_);
-    my ($doc_ext, $textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
-    
-    my $conv_filename = $self->{'conv_filename'};
-    my $tmp_dirname = File::Basename::dirname($conv_filename);
-    my $tmp_tailname = File::Basename::basename($conv_filename);
-    
-    my $converted_to = $self->{'converted_to'};
-    my $ret_val = 1;    
-
-#   $ret_val = &RogPlug::process($self, $textref, $pluginfo,
-#				 $tmp_dirname, $tmp_tailname,
-#				 $metadata, $doc_obj);
-
-    # associate original file with doc object
-    my $cursection = $doc_obj->get_top_section();
-    my $filename = &util::filename_cat($base_dir, $file);
-    $doc_obj->associate_file($filename, "doc.$doc_ext", undef, $cursection);
-
-    my $doclink = "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[archivedir]/doc.$doc_ext\">";
-    $doc_obj->add_utf8_metadata ($cursection, "srclink",  $doclink); 
-    $doc_obj->add_utf8_metadata ($cursection, "srcicon",  "_icon".$doc_ext."_"); 
-    $doc_obj->add_utf8_metadata ($cursection, "/srclink", "</a>"); 
-    return $ret_val;
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/ConvertToRogPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ConvertToRogPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/ConvertToRogPlugin.pm	(revision 15865)
@@ -0,0 +1,454 @@
+###########################################################################
+#
+# ConvertToRogPlug.pm -- plugin that inherits from RogPlug
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999 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 ConvertToRogPlug;
+
+use BasPlug;
+use RogPlug;
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @ConvertToRogPlug::ISA = ('RogPlug');
+}
+
+my $arguments = [
+		 ];
+my $options = { 'name'     => "ConvertToRogPlug",
+		'desc'     => "{ConvertToRogPlug.desc}",
+		'abstract' => "yes",
+		'inherits' => "yes" };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new RogPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    $self->{'convert_to'} = "Rog";
+    $self->{'convert_to_ext'} = "rog";
+
+    return bless $self, $class;
+}
+
+
+sub begin {
+    my $self = shift (@_);
+    
+    $self->SUPER::begin(@_);
+
+    $self->{'docnum'} = 0;
+}
+
+sub end {
+    my ($self) = @_;
+
+    # nothing to do, but keep symmetric with begin function
+    $self->SUPER::end(@_);
+}
+
+
+# Run conversion utility on the input file.  
+#
+# The conversion takes place in a collection specific 'tmp' directory so 
+# that we don't accidentally damage the input.
+#
+# The desired output type is indicated by $output_ext.  This is usually
+# something like "html" or "word", but can be "best" (or the empty string)
+# to indicate that the conversion utility should do the best it can.
+
+sub tmp_area_convert_file {
+    my $self = shift (@_);
+    my ($output_ext, $input_filename, $textref) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+    my $convert_to = $self->{'convert_to'};
+    my $failhandle = $self->{'failhandle'};
+
+    # softlink to collection tmp dir
+    my $tmp_dirname 
+	= &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, "tmp");
+    &util::mk_dir($tmp_dirname) if (!-e $tmp_dirname);
+
+    # derive tmp filename from input filename
+    my ($tailname, $dirname, $suffix)
+	= &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
+
+    # Remove any white space from filename -- no risk of name collision, and
+    # makes later conversion by utils simpler. Leave spaces in path...
+    $tailname =~ s/\s+//g; 
+
+    my $tmp_filename = &util::filename_cat($tmp_dirname, "$tailname$suffix");
+
+    &util::soft_link($input_filename, $tmp_filename);
+
+    my $verbosity = $self->{'verbosity'};
+    if ($verbosity > 0) {
+	print $outhandle "Converting $tailname$suffix to $convert_to format\n";
+    }
+
+    my $errlog = &util::filename_cat($tmp_dirname, "err.log");
+    
+    # Execute the conversion command and get the type of the result,
+    # making sure the converter gives us the appropriate output type
+    my $output_type = lc($convert_to);
+    my $cmd = "perl -S gsMusicConvert.pl -verbose $verbosity -errlog \"$errlog\" -output $output_type \"$tmp_filename\"";
+    $output_type = `$cmd`;
+
+    # remove symbolic link to original file
+    &util::rm($tmp_filename);
+
+    # Check STDERR here
+    chomp $output_type;
+    if ($output_type eq "fail") {
+	print $outhandle "Could not convert $tailname$suffix to $convert_to format\n";
+	print $failhandle "$tailname$suffix: " . ref($self) . " failed to convert to $convert_to\n";
+	$self->{'num_not_processed'} ++;
+	if (-s "$errlog") {
+	    open(ERRLOG, "$errlog");
+	    while (<ERRLOG>) {
+		print $outhandle "$_";
+	    }
+	    print $outhandle "\n";
+	    close ERRLOG;
+	}
+	&util::rm("$errlog") if (-e "$errlog");
+	return "";
+    }
+
+    # store the *actual* output type and return the output filename
+    # it's possible we requested conversion to html, but only to text succeeded
+
+    $self->{'convert_to_ext'} = $output_type;
+    $self->{'converted_to'} = "Rog";
+
+    my $output_filename = $tmp_filename;
+
+    $output_filename =~ s/$suffix$//;
+
+    return $output_filename;
+}
+
+
+# Remove collection specific tmp directory and all its contents.
+
+sub cleanup_tmp_area {
+    my $self = shift (@_);
+
+    my $tmp_dirname 
+	= &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, "tmp");
+    &util::rm_r($tmp_dirname);
+    &util::mk_dir($tmp_dirname);
+}
+
+
+# Exact copy of read_rog_record from RogPlug 
+# Needed for FILE in right scope
+
+sub read_rog_record
+{
+    my ($self,$file_buffer, $docnum, $seclevel) = @_;
+
+    my $next_line = $file_buffer->{'next_line'};
+
+    return 0 if (!defined $next_line);
+
+    if ($next_line eq "")
+    {
+	my $line;
+	while(defined($line=<FILE>))  
+	{
+	    $line =~ s/\r$//;
+	    $file_buffer->{'line_no'}++;
+	    next if ($line =~ m/^\#/);
+	    $next_line = $line;
+	    last;
+	}
+    }
+	    
+    if ($next_line !~ m/^song( +)\"([^\"]*)\"( +)\"([^\"]*)\"( +)(\d+)( *)$/) 
+    {
+	print STDERR "Error: Malformed Rog file: $next_line";
+	return 0;
+    }
+    else
+    {
+	# init default values
+	$file_buffer->{'song'}->{'tempo'}    = 120;
+	$file_buffer->{'song'}->{'ks_type'}  = 0;
+	$file_buffer->{'song'}->{'ks_num'}   = 0;
+	$file_buffer->{'song'}->{'metadata'} = [];
+	$file_buffer->{'song'}->{'content'}  = "";
+	
+	$file_buffer->{'song'}->{'subcol'} = $2;
+	$file_buffer->{'song'}->{'title'}  = $4;
+	$file_buffer->{'song'}->{'tval'}   = $6;
+
+	chomp($next_line);
+	my $content = $next_line;
+	if (defined $docnum) 
+	{
+	    $content.= " $docnum $seclevel";
+	}
+	$content .= "\n";
+
+	$file_buffer->{'song'}->{'content'} = $content;
+
+
+	my $line;
+	while(defined($line=<FILE>))  
+	{
+	    $line =~ s/\r$//;
+
+	    $file_buffer->{'line_no'}++;
+	    next if ($line =~ m/^\#/);
+	
+	    if ($line =~ m/^song/) 
+	    {	
+		$file_buffer->{'next_line'} = $line;
+		return 1;
+	    }
+	    elsif ($line =~ m/^tempo( +)(\d+)( *)$/) 
+	    {
+		$file_buffer->{'song'}->{'tempo'} = $2;
+		$file_buffer->{'song'}->{'content'} .= $line;
+	    } 
+	    elsif ($line =~ m/^keysig( +)(\d+)( +)(\d+)( *)$/) 
+	    {
+		$file_buffer->{'song'}->{'ks_type'} = $2;
+		$file_buffer->{'song'}->{'ks_num'}  = $4;
+		$file_buffer->{'song'}->{'content'} .= $line;	   
+	    } 
+	    elsif ($line =~ m/^timesig( +)(\d+)( +)(\d+)( *)$/) 
+	    {
+		$file_buffer->{'song'}->{'ts_numer'} = $2;
+		$file_buffer->{'song'}->{'ts_denom'} = $4;
+		$file_buffer->{'song'}->{'content'} .= $line;
+	    }
+	    elsif ($line =~ m/^metadata ([^:]*): (.*)/)
+	    {
+		push(@{$file_buffer->{'song'}->{'metadata'}},[$1,$2]);
+		$file_buffer->{'song'}->{'content'} .= $line;
+	    }
+	    else
+	    {
+		$file_buffer->{'song'}->{'content'} .= $line;
+	    }
+	}
+	
+	$file_buffer->{'next_line'} = undef;
+    }
+
+    return 1;
+}
+
+# Override RogPlug function so rog files are stored as sections (not docs)
+
+sub process_rog_record
+{
+    my ($self,$doc_obj,$cursection,$song) = @_;
+
+    $cursection = 
+	$doc_obj->insert_section($cursection);
+    $self->{'docnum'}++;
+
+    my $title = $song->{'title'};
+    my $title_safe = $title;
+    $title_safe =~ s/\'/\\\\&apos;/g;
+
+    # add metadata 
+    $doc_obj->add_metadata($cursection, "Tempo",         $song->{'tempo'}); 
+    $doc_obj->add_metadata($cursection, "KeySigType",    $song->{'ks_type'}); 
+    $doc_obj->add_metadata($cursection, "KeySigNum",     $song->{'ks_num'}); 
+    $doc_obj->add_metadata($cursection, "SubCollection", $song->{'subcol'}); 
+    $doc_obj->add_metadata($cursection, "Title",         $title); 
+    $doc_obj->add_metadata($cursection, "TitleSafe",     $title_safe); 
+    $doc_obj->add_metadata($cursection, "TVal",          $song->{'tval'}); 
+
+    foreach my $md ( @{$song->{'metadata'}} )
+    {
+	$doc_obj->add_metadata($cursection, $md->[0], $md->[1]); 
+    }
+
+    # add contents as text
+    $doc_obj->add_text($cursection,$song->{'content'});
+
+    return $cursection;
+}
+
+
+
+# Override BasPlug read
+# We don't want to get language encoding stuff until after we've converted
+# our file to Rog format
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+
+    # check process_exp, block_exp, associate_ext etc
+    my ($block_status,$filename) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+ 
+    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
+
+    # read in file ($text will be in utf8)
+    my $text = "";
+
+    my $output_ext = $self->{'convert_to_ext'};
+    my $conv_filename = $self->tmp_area_convert_file($output_ext, $filename);
+
+    if ("$conv_filename" eq "") {return 0;} # allows continue on errors
+    $self->{'conv_filename'} = $conv_filename;
+
+
+    # create a new document
+    #my $doc_obj = new doc ($conv_filename, "indexed_doc");
+    # the original filename is used now
+    my $doc_obj = new doc ($filename, "indexed_doc");
+    # the converted filename is set separately
+    $doc_obj->set_converted_filename($conv_filename);
+
+    my $topsection = $doc_obj->get_top_section();
+    my $cursection = $topsection;
+
+    $self->{'docnum'}++;
+    my $docnum = $self->{'docnum'};
+
+    $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
+    my ($filemeta) = $file =~ /([^\\\/]+)$/;
+    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Source", &ghtml::dmsafe($filemeta));
+    if ($self->{'cover_image'}) {
+	$self->associate_cover_image($doc_obj, $filename);
+    }
+    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
+    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "FileSize", (-s $filename));
+
+    my $track_no = "1";
+    my $rog_filename = "$conv_filename$track_no.$output_ext";
+    while (1)
+    {
+	last unless open (FILE, $rog_filename) ;
+
+	my $file_buffer = { line_no => 0, next_line => "", song => {} };
+	
+	while ($self->read_rog_record($file_buffer, $docnum, $track_no))
+	{
+	    my $song = $file_buffer->{'song'};
+	    my $content = $song->{'content'};
+	    $content =~ s/^song\w+(.*)$/song $1 X.$track_no/;
+	    
+	    $cursection 
+		= $self->process_rog_record($doc_obj,$cursection,
+					    $file_buffer->{'song'});
+	}
+
+	close FILE;
+
+	$track_no++;
+	$rog_filename = "$conv_filename$track_no.$output_ext";
+    }
+
+    print STDERR "\n";
+
+    # include any metadata passed in from previous plugins 
+    # note that this metadata is associated with the top level section
+    $self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
+    # do plugin specific processing of doc_obj
+    unless (defined ($self->process(\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj))) {
+	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
+	return -1;
+    }
+    # do any automatic metadata extraction
+    $self->auto_extract_metadata ($doc_obj);
+    # add an OID
+    $doc_obj->set_OID();
+
+    my $oid = $doc_obj->get_OID();
+    my $appletlink = "<a href=\"javascript:meldexout(\'$oid\','[TitleSafe]')\">";
+
+    $doc_obj->add_utf8_metadata ($topsection, "audiolink",  $appletlink); 
+    $doc_obj->add_utf8_metadata ($topsection, "audioicon",  "_iconaudio_"); 
+    $doc_obj->add_utf8_metadata ($topsection, "/audiolink", "</a>"); 
+
+    # if no title metadata defined, set it to filename minus extension
+    my $existing_title = $doc_obj->get_metadata_element($topsection,"Title");
+    if (!defined $existing_title) 
+    {
+	my $title = $doc_obj->get_metadata_element($topsection,"Source");
+	$title =~ s/\..*?$//g;
+	$doc_obj->add_utf8_metadata ($topsection, "Title", $title); 
+
+	my $title_safe = $title;
+	$title_safe =~ s/\'/\\\\&apos;/g;
+	$doc_obj->add_utf8_metadata ($topsection, "TitleSafe", $title_safe); 
+    }
+
+    # process the document
+    $processor->process($doc_obj);
+    $self->cleanup_tmp_area();
+
+    $self->{'num_processed'} ++;
+
+    return 1;
+}
+
+
+# do plugin specific processing of doc_obj for HTML type
+sub process_type {
+    my $self = shift (@_);
+    my ($doc_ext, $textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
+    
+    my $conv_filename = $self->{'conv_filename'};
+    my $tmp_dirname = File::Basename::dirname($conv_filename);
+    my $tmp_tailname = File::Basename::basename($conv_filename);
+    
+    my $converted_to = $self->{'converted_to'};
+    my $ret_val = 1;    
+
+#   $ret_val = &RogPlug::process($self, $textref, $pluginfo,
+#				 $tmp_dirname, $tmp_tailname,
+#				 $metadata, $doc_obj);
+
+    # associate original file with doc object
+    my $cursection = $doc_obj->get_top_section();
+    my $filename = &util::filename_cat($base_dir, $file);
+    $doc_obj->associate_file($filename, "doc.$doc_ext", undef, $cursection);
+
+    my $doclink = "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[archivedir]/doc.$doc_ext\">";
+    $doc_obj->add_utf8_metadata ($cursection, "srclink",  $doclink); 
+    $doc_obj->add_utf8_metadata ($cursection, "srcicon",  "_icon".$doc_ext."_"); 
+    $doc_obj->add_utf8_metadata ($cursection, "/srclink", "</a>"); 
+    return $ret_val;
+}
+
+1;
Index: dl/trunk/perllib/plugins/DBPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/DBPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,377 +1,0 @@
-###########################################################################
-#
-# DBPlug.pm -- plugin to import records from a database
-# 
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 2003 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.
-#
-###########################################################################
-
-# A plugin that imports records from a database. This uses perl's DBI module, 
-# which includes back-ends for mysql, postgresql, comma separated values (CSV),
-# MS Excel, ODBC, sybase, etc... Extra modules may need to be installed to 
-# use this. See <GSDLHOME>/etc/packages/example.dbi for an example config file.
-#
-
-# Written by John McPherson for the NZDL project
-# Mar, Apr 2003
-
-package DBPlug;
-
-use strict;
-no strict 'refs'; # allow variable as a filehandle
-
-use BasPlug;
-use unicode;
-
-#use DBI; # database independent stuff
-
-sub BEGIN {
-    @DBPlug::ISA = ('BasPlug');
-}
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" }];
-
-my $options = { 'name'     => "DBPlug",
-		'desc'     => "{DBPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)\.dbi$^;
-}
-# we don't have a per-greenstone document process() function!
-sub process {
-
-}
-
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs,$total_count,$gli) = @_;
-        
-     #see if we can handle the passed file...
-     my ($block_status,$filename) = $self->read_block(@_);    
-     return $block_status if ((!defined $block_status) || ($block_status==0));
-
-    my $outhandle = $self->{'outhandle'};
-    my $verbosity = $self->{'verbosity'};
-
-    print $outhandle "DBPlug: processing $file\n" 
-	if $self->{'verbosity'} > 1;
-   
-    require DBI; # database independent stuff
-
-    # calculate the document hash, for document ids
-    my $hash="0";
-
-   
-    # default options - may be overridden by config file
-    my $language=undef;
-    my $encoding=undef;
-    my $dbplug_debug=0;
-    my $username='';
-    my $password='';
-
-    # these settings must be set by the config file:
-    my $db=undef;
-
-# get id of pages from "nonempty", get latest version number from "recent", and
-# then get pagename from "page" and content from "version" !
-
-    my $sql_query_prime = undef ;
-    my $sql_query = undef ;
-
-    my %db_to_greenstone_fields=();
-    my %callbacks=();
-
-
-    # read in config file.
-    if (!open (CONF, $filename)) {
-	    print $outhandle "DBPlug: can't read $filename: $!\n";
-	    return 0;
-    } 
-   
-    my $line;
-    my $statement="";
-    my $callback="";
-    while (defined($line=<CONF>)) {
-	chomp $line;
-	$line .= " "; # for multi-line statements - don't conjoin!
-	$line =~ s/\s*\#.*$//mg; # remove comments
-	$statement .= $line;
-
-	if ($line =~ /^\}\s*$/ && $callback) { # ends the callback
-	    $callback .= $statement ; $statement = "";
-	    # try to check that the function is "safe"
-	    if ($callback  =~ /\b(?:system|open|pipe|readpipe|qx|kill|eval|do|use|require|exec|fork)\b/ ||
-		$callback =~ /[\`]|\|\-/) {
-		# no backticks or functions that start new processes allowed
-		print $outhandle "DBPlug: bad function in callback\n";
-		return 0;
-	    }
-	    $callback =~ s/sub (\w+?)_callback/sub/;
-	    my $fieldname = $1;
-	    my $ret = eval "\$callbacks{'$fieldname'} = $callback ; 1";
-	    if (!defined($ret)) {
-		print $outhandle "DBPlug: error eval'ing callback: $@\n";
-		exit(1);
-	    }
-	    $callback="";
-	    print $outhandle "DBPlug: callback registered for '$fieldname'\n"
-	        if $dbplug_debug;
-	} elsif ($callback) {
-	    # add this line to the callback function
-	    $callback .= $statement;
-	    $statement = "";
-	} elsif ($statement =~ m/;\s*$/) { # ends with ";"
-	    # check that it is safe
-	    # assignment
-	    if ($statement =~ m~(\$\w+)\s* = \s*
-		(\d		# digits
-		 | ".*?(?<!\\)" # " up to the next " not preceded by a \
-		 | '.*?(?<!\\)' # ' up to the next ' not preceded by a \
-		)\s*;~x ||      # /x means ignore comments and whitespace in rx
-		$statement =~ m~(\%\w+)\s*=\s*(\([\w\s\"\',:=>]+\))\s*;~ ) {   
-		# evaluate the assignment, return 1 on success "
-		if (!eval "$1=$2; 1") {
-		    my $err=$@;
-		    chomp $err;
-		    $err =~ s/\.$//; # remove a trailing .
-		    print $outhandle "DBPlug: error evaluating `$statement'\n";
-		    print $outhandle " $err (in $filename)\n";
-		    return 0; # there was an error reading the config file
-		}
-	    } elsif ($statement =~ /sub \w+_callback/) {
-		# this is the start of a callback function definition
-		$callback = $statement;
-		$statement = "";
-	    } else {
-		print $outhandle "DBPlug: skipping statement `$statement'\n";
-	    }
-	    $statement = "";
-	}
-    }
-    close CONF;
-
-    
-    if (!defined($db)) {
-	print $outhandle "DBPlug: error: $filename does not specify a db!\n";
-	return 0;
-    }
-    if (!defined($sql_query)) {
-    	print $outhandle "DBPlug: error: no SQL query specified!\n";
-	return 0;
-    }
-    # connect to database
-    my $dbhandle=DBI->connect($db, $username, $password);
-
-    if (!defined($dbhandle)) {
-	die "DBPlug: could not connect to database, exiting.\n";
-    }
-    if (defined($dbplug_debug) && $dbplug_debug==1) {
-	print $outhandle "DBPlug (debug): connected ok\n";
-    }
-
-    my $statement_hand;
-
-    # The user gave 2 sql statements to execute?
-    if ($sql_query_prime) {
-	    $statement_hand=$dbhandle->prepare($sql_query_prime);
-	    $statement_hand->execute;
-	    if ($statement_hand->err) {
-		    print $outhandle "Error: " . $statement_hand->errstr . "\n";
-		    return undef;
-	    }
-    }
-
-  
-    $statement_hand=$dbhandle->prepare($sql_query);
-    $statement_hand->execute;
-    if ($statement_hand->err) {
-    	print $outhandle "Error:" . $statement_hand->errstr . "\n";
-	return undef;
-    }
-
-    # get the array-ref for the field names and cast it to array
-    my @field_names;
-    @field_names=@{ $statement_hand->{NAME} };
-
-    foreach my $fieldname (@field_names) {
-	if (defined($db_to_greenstone_fields{$fieldname})) {
-	    if (defined($dbplug_debug) && $dbplug_debug==1) {
-		print $outhandle "DBPlug (debug): mapping db field "
-		    . "'$fieldname' to "
-			. $db_to_greenstone_fields{$fieldname} . "\n";
-	    }
-	    $fieldname=$db_to_greenstone_fields{$fieldname};
-	}
-    }
-
-    # get rows
-
-    my $count = 0;
-    my @row_array;
-
-    @row_array=$statement_hand->fetchrow_array; # fetchrow_hashref?
-    
-    while (scalar(@row_array)) {
-	if (defined($dbplug_debug) && $dbplug_debug==1) {
-	    print $outhandle "DBPlug (debug): retrieved a row from query\n";
-	}
-
-	# create a new document
-	my $doc_obj = new doc ($filename, "indexed_doc");
-	$doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
-	my $cursection = $doc_obj->get_top_section();
-
-	# if $language not set in config file, will use BasPlug's default
-	if (defined($language)) {
-	    $doc_obj->add_utf8_metadata($cursection, "Language", $language);
-	}
-	# if $encoding not set in config file, will use BasPlug's default
-	if (defined($encoding)) {
-	    # allow some common aliases
-	    if ($encoding =~ m/^utf[-_]8$/i) {$encoding="utf8"}
-	    $encoding =~ s/-/_/g; # greenstone uses eg iso_8859_1
-	    $doc_obj->add_utf8_metadata($cursection, "Encoding", $encoding);
-	}
-	$doc_obj->add_utf8_metadata($cursection,
-				    "Source", &ghtml::dmsafe($db));
-	if ($self->{'cover_image'}) {
-	    $self->associate_cover_image($doc_obj, $filename);
-	}
-	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
-
-	$doc_obj->add_metadata($doc_obj->get_top_section(), "FileFormat", "DB");
-
-	# include any metadata passed in from previous plugins 
-	# note that this metadata is associated with the top level section
-	$self->extra_metadata ($doc_obj, $cursection,
-			       $metadata);
-
-	# do any automatic metadata extraction
-	$self->auto_extract_metadata ($doc_obj);
-
-	my $unique_id=undef;
-
-	foreach my $fieldname (@field_names) {
-	    my $fielddata=shift @row_array;
-
-	    if (! defined($fielddata) ) {
-	    	next; # this field was "" or NULL
-	    }
-	    # use the specified encoding, defaulting to utf-8
-	    if (defined($encoding) && $encoding ne "ascii"
-	    	&& $encoding ne "utf8") {
-	      $fielddata=&unicode::unicode2utf8(
-	      	&unicode::convert2unicode($encoding, \$fielddata)
-					       );
-	    }
-	    # see if we have a ****_callback() function defined
-	    if (exists $callbacks{$fieldname}) {
-		my $funcptr = $callbacks{$fieldname};
-		$fielddata = &$funcptr($fielddata);
-	    }
-
-	    if ($fieldname eq "text") {
-		# add as document text
-		$fielddata=~s@<@&lt;@g;
-		$fielddata=~s@>@&gt;@g; # for xml protection...
-		$fielddata=~s@_@\\_@g; # for macro language protection...
-		$doc_obj->add_utf8_text($cursection, $fielddata);
-	    } elsif ($fieldname eq "Identifier") {
-		# use as greenstone's unique record id
-		if ($fielddata =~ /^\d+$/) {
-		    # don't allow IDs that are completely numeric
-		    $unique_id="id" . $fielddata;
-		} else {
-		    $unique_id=$fielddata;
-		}
-	    } else {
-		# add as document metadata
-		$fielddata=~s/\[/&#91;/g;
-		$fielddata=~s/\]/&#93;/g;
-		$doc_obj->add_utf8_metadata($cursection,
-					    $fieldname, $fielddata);
-
-	    }
-	}
-
-
-	if (!defined $unique_id) {
-             $doc_obj->set_OID();
-             my $id = $doc_obj->get_OID();     
-	     $doc_obj->set_OID($id."s$count");
-	} else {
-	    # use our id from the database...
-	    $doc_obj->set_OID($unique_id);
-	}
-
-
-        # process the document
-	$processor->process($doc_obj);
-
-	$count++;
-
-	# get next row
-	@row_array=$statement_hand->fetchrow_array; # fetchrow_hashref?
-    } # end of row_array is not empty
-
-    # check "$sth->err" if empty array for error
-    if ($statement_hand->err) {
-	print $outhandle "DBPlug: received error: \"" .
-	    $statement_hand->errstr . "\"\n";
-    }
-
-    # clean up connection to database
-    $statement_hand->finish();
-    $dbhandle->disconnect();
-
-    # num of input files, rather than documents created?
-    $self->{'num_processed'}++;
-
-    if (defined($dbplug_debug) && $dbplug_debug==1) {
-        print $outhandle "DBPlug: imported $count DB records as documents.\n";
-    }
-    $count;
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/DBPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/DBPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/DBPlugin.pm	(revision 15865)
@@ -0,0 +1,377 @@
+###########################################################################
+#
+# DBPlug.pm -- plugin to import records from a database
+# 
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 2003 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.
+#
+###########################################################################
+
+# A plugin that imports records from a database. This uses perl's DBI module, 
+# which includes back-ends for mysql, postgresql, comma separated values (CSV),
+# MS Excel, ODBC, sybase, etc... Extra modules may need to be installed to 
+# use this. See <GSDLHOME>/etc/packages/example.dbi for an example config file.
+#
+
+# Written by John McPherson for the NZDL project
+# Mar, Apr 2003
+
+package DBPlug;
+
+use strict;
+no strict 'refs'; # allow variable as a filehandle
+
+use BasPlug;
+use unicode;
+
+#use DBI; # database independent stuff
+
+sub BEGIN {
+    @DBPlug::ISA = ('BasPlug');
+}
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" }];
+
+my $options = { 'name'     => "DBPlug",
+		'desc'     => "{DBPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)\.dbi$^;
+}
+# we don't have a per-greenstone document process() function!
+sub process {
+
+}
+
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs,$total_count,$gli) = @_;
+        
+     #see if we can handle the passed file...
+     my ($block_status,$filename) = $self->read_block(@_);    
+     return $block_status if ((!defined $block_status) || ($block_status==0));
+
+    my $outhandle = $self->{'outhandle'};
+    my $verbosity = $self->{'verbosity'};
+
+    print $outhandle "DBPlug: processing $file\n" 
+	if $self->{'verbosity'} > 1;
+   
+    require DBI; # database independent stuff
+
+    # calculate the document hash, for document ids
+    my $hash="0";
+
+   
+    # default options - may be overridden by config file
+    my $language=undef;
+    my $encoding=undef;
+    my $dbplug_debug=0;
+    my $username='';
+    my $password='';
+
+    # these settings must be set by the config file:
+    my $db=undef;
+
+# get id of pages from "nonempty", get latest version number from "recent", and
+# then get pagename from "page" and content from "version" !
+
+    my $sql_query_prime = undef ;
+    my $sql_query = undef ;
+
+    my %db_to_greenstone_fields=();
+    my %callbacks=();
+
+
+    # read in config file.
+    if (!open (CONF, $filename)) {
+	    print $outhandle "DBPlug: can't read $filename: $!\n";
+	    return 0;
+    } 
+   
+    my $line;
+    my $statement="";
+    my $callback="";
+    while (defined($line=<CONF>)) {
+	chomp $line;
+	$line .= " "; # for multi-line statements - don't conjoin!
+	$line =~ s/\s*\#.*$//mg; # remove comments
+	$statement .= $line;
+
+	if ($line =~ /^\}\s*$/ && $callback) { # ends the callback
+	    $callback .= $statement ; $statement = "";
+	    # try to check that the function is "safe"
+	    if ($callback  =~ /\b(?:system|open|pipe|readpipe|qx|kill|eval|do|use|require|exec|fork)\b/ ||
+		$callback =~ /[\`]|\|\-/) {
+		# no backticks or functions that start new processes allowed
+		print $outhandle "DBPlug: bad function in callback\n";
+		return 0;
+	    }
+	    $callback =~ s/sub (\w+?)_callback/sub/;
+	    my $fieldname = $1;
+	    my $ret = eval "\$callbacks{'$fieldname'} = $callback ; 1";
+	    if (!defined($ret)) {
+		print $outhandle "DBPlug: error eval'ing callback: $@\n";
+		exit(1);
+	    }
+	    $callback="";
+	    print $outhandle "DBPlug: callback registered for '$fieldname'\n"
+	        if $dbplug_debug;
+	} elsif ($callback) {
+	    # add this line to the callback function
+	    $callback .= $statement;
+	    $statement = "";
+	} elsif ($statement =~ m/;\s*$/) { # ends with ";"
+	    # check that it is safe
+	    # assignment
+	    if ($statement =~ m~(\$\w+)\s* = \s*
+		(\d		# digits
+		 | ".*?(?<!\\)" # " up to the next " not preceded by a \
+		 | '.*?(?<!\\)' # ' up to the next ' not preceded by a \
+		)\s*;~x ||      # /x means ignore comments and whitespace in rx
+		$statement =~ m~(\%\w+)\s*=\s*(\([\w\s\"\',:=>]+\))\s*;~ ) {   
+		# evaluate the assignment, return 1 on success "
+		if (!eval "$1=$2; 1") {
+		    my $err=$@;
+		    chomp $err;
+		    $err =~ s/\.$//; # remove a trailing .
+		    print $outhandle "DBPlug: error evaluating `$statement'\n";
+		    print $outhandle " $err (in $filename)\n";
+		    return 0; # there was an error reading the config file
+		}
+	    } elsif ($statement =~ /sub \w+_callback/) {
+		# this is the start of a callback function definition
+		$callback = $statement;
+		$statement = "";
+	    } else {
+		print $outhandle "DBPlug: skipping statement `$statement'\n";
+	    }
+	    $statement = "";
+	}
+    }
+    close CONF;
+
+    
+    if (!defined($db)) {
+	print $outhandle "DBPlug: error: $filename does not specify a db!\n";
+	return 0;
+    }
+    if (!defined($sql_query)) {
+    	print $outhandle "DBPlug: error: no SQL query specified!\n";
+	return 0;
+    }
+    # connect to database
+    my $dbhandle=DBI->connect($db, $username, $password);
+
+    if (!defined($dbhandle)) {
+	die "DBPlug: could not connect to database, exiting.\n";
+    }
+    if (defined($dbplug_debug) && $dbplug_debug==1) {
+	print $outhandle "DBPlug (debug): connected ok\n";
+    }
+
+    my $statement_hand;
+
+    # The user gave 2 sql statements to execute?
+    if ($sql_query_prime) {
+	    $statement_hand=$dbhandle->prepare($sql_query_prime);
+	    $statement_hand->execute;
+	    if ($statement_hand->err) {
+		    print $outhandle "Error: " . $statement_hand->errstr . "\n";
+		    return undef;
+	    }
+    }
+
+  
+    $statement_hand=$dbhandle->prepare($sql_query);
+    $statement_hand->execute;
+    if ($statement_hand->err) {
+    	print $outhandle "Error:" . $statement_hand->errstr . "\n";
+	return undef;
+    }
+
+    # get the array-ref for the field names and cast it to array
+    my @field_names;
+    @field_names=@{ $statement_hand->{NAME} };
+
+    foreach my $fieldname (@field_names) {
+	if (defined($db_to_greenstone_fields{$fieldname})) {
+	    if (defined($dbplug_debug) && $dbplug_debug==1) {
+		print $outhandle "DBPlug (debug): mapping db field "
+		    . "'$fieldname' to "
+			. $db_to_greenstone_fields{$fieldname} . "\n";
+	    }
+	    $fieldname=$db_to_greenstone_fields{$fieldname};
+	}
+    }
+
+    # get rows
+
+    my $count = 0;
+    my @row_array;
+
+    @row_array=$statement_hand->fetchrow_array; # fetchrow_hashref?
+    
+    while (scalar(@row_array)) {
+	if (defined($dbplug_debug) && $dbplug_debug==1) {
+	    print $outhandle "DBPlug (debug): retrieved a row from query\n";
+	}
+
+	# create a new document
+	my $doc_obj = new doc ($filename, "indexed_doc");
+	$doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
+	my $cursection = $doc_obj->get_top_section();
+
+	# if $language not set in config file, will use BasPlug's default
+	if (defined($language)) {
+	    $doc_obj->add_utf8_metadata($cursection, "Language", $language);
+	}
+	# if $encoding not set in config file, will use BasPlug's default
+	if (defined($encoding)) {
+	    # allow some common aliases
+	    if ($encoding =~ m/^utf[-_]8$/i) {$encoding="utf8"}
+	    $encoding =~ s/-/_/g; # greenstone uses eg iso_8859_1
+	    $doc_obj->add_utf8_metadata($cursection, "Encoding", $encoding);
+	}
+	$doc_obj->add_utf8_metadata($cursection,
+				    "Source", &ghtml::dmsafe($db));
+	if ($self->{'cover_image'}) {
+	    $self->associate_cover_image($doc_obj, $filename);
+	}
+	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
+
+	$doc_obj->add_metadata($doc_obj->get_top_section(), "FileFormat", "DB");
+
+	# include any metadata passed in from previous plugins 
+	# note that this metadata is associated with the top level section
+	$self->extra_metadata ($doc_obj, $cursection,
+			       $metadata);
+
+	# do any automatic metadata extraction
+	$self->auto_extract_metadata ($doc_obj);
+
+	my $unique_id=undef;
+
+	foreach my $fieldname (@field_names) {
+	    my $fielddata=shift @row_array;
+
+	    if (! defined($fielddata) ) {
+	    	next; # this field was "" or NULL
+	    }
+	    # use the specified encoding, defaulting to utf-8
+	    if (defined($encoding) && $encoding ne "ascii"
+	    	&& $encoding ne "utf8") {
+	      $fielddata=&unicode::unicode2utf8(
+	      	&unicode::convert2unicode($encoding, \$fielddata)
+					       );
+	    }
+	    # see if we have a ****_callback() function defined
+	    if (exists $callbacks{$fieldname}) {
+		my $funcptr = $callbacks{$fieldname};
+		$fielddata = &$funcptr($fielddata);
+	    }
+
+	    if ($fieldname eq "text") {
+		# add as document text
+		$fielddata=~s@<@&lt;@g;
+		$fielddata=~s@>@&gt;@g; # for xml protection...
+		$fielddata=~s@_@\\_@g; # for macro language protection...
+		$doc_obj->add_utf8_text($cursection, $fielddata);
+	    } elsif ($fieldname eq "Identifier") {
+		# use as greenstone's unique record id
+		if ($fielddata =~ /^\d+$/) {
+		    # don't allow IDs that are completely numeric
+		    $unique_id="id" . $fielddata;
+		} else {
+		    $unique_id=$fielddata;
+		}
+	    } else {
+		# add as document metadata
+		$fielddata=~s/\[/&#91;/g;
+		$fielddata=~s/\]/&#93;/g;
+		$doc_obj->add_utf8_metadata($cursection,
+					    $fieldname, $fielddata);
+
+	    }
+	}
+
+
+	if (!defined $unique_id) {
+             $doc_obj->set_OID();
+             my $id = $doc_obj->get_OID();     
+	     $doc_obj->set_OID($id."s$count");
+	} else {
+	    # use our id from the database...
+	    $doc_obj->set_OID($unique_id);
+	}
+
+
+        # process the document
+	$processor->process($doc_obj);
+
+	$count++;
+
+	# get next row
+	@row_array=$statement_hand->fetchrow_array; # fetchrow_hashref?
+    } # end of row_array is not empty
+
+    # check "$sth->err" if empty array for error
+    if ($statement_hand->err) {
+	print $outhandle "DBPlug: received error: \"" .
+	    $statement_hand->errstr . "\"\n";
+    }
+
+    # clean up connection to database
+    $statement_hand->finish();
+    $dbhandle->disconnect();
+
+    # num of input files, rather than documents created?
+    $self->{'num_processed'}++;
+
+    if (defined($dbplug_debug) && $dbplug_debug==1) {
+        print $outhandle "DBPlug: imported $count DB records as documents.\n";
+    }
+    $count;
+}
+
+1;
Index: dl/trunk/perllib/plugins/DSpacePlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/DSpacePlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,410 +1,0 @@
-
-###########################################################################
-#
-# DSpacePlug.pm -- plugin for import the collection from DSpace 
-# 
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999 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.
-#
-###########################################################################
-
-# DSpace Plug - 10/2004
-# 
-#
-# This plugin takes "contents" and dublin_core.xml file, which contain 
-# Metadata and lists of associated files for a particular document
-# and produces a document containing sections, one for each page.
-# The files should be named "contents" and "dublin_core.xml".  For each of 
-# document in DSpace, it is stored in one directory
-#
-# The format of the "contents" file is as follows:
-# 
-# File.type      bundle:ORIGINAL
-# license.txt    bundle:LICENSE
-# The format of the "dublin_core.xml" file is as follows:
-# The first line contains any metadata for the whole document
-# <dublin_core>
-# eg.
-# <dcvalue element="Title" qualifier="">Snail farming</dcvalue>
-# <dcvalue element="date" qualifier="">2004-10-15</dcvalue>
-#
-
-package DSpacePlug;
-
-use BasPlug;
-use plugin;
-#use ghtml;
-use XMLParser;
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @DSpacePlug::ISA = ('BasPlug');
-}
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "string",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" },
-      { 'name' => "only_first_doc",
-	'desc' => "{DSpacePlug.only_first_doc}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "first_inorder_ext",
-	'desc' => "{DSpacePlug.first_inorder_ext}",
-	'type' => "string",
-	'reqd' => "no" },
-      { 'name' => "first_inorder_mime",
-	'desc' => "{DSpacePlug.first_inorder_mime}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "block_exp",
-	'desc' => "{BasPlug.block_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_block_exp(),
-	'reqd' => "no" }];
-
-
-my $options = { 'name'     => "DSpacePlug",
-		'desc'     => "{DSpacePlug.desc}",
-		'inherits' => "yes",
-		'abstract' => "no",
-		'args'     => $arguments };
-
-
-my $primary_doc_lookup = { 'text/html' => '(?i)\.(gif|jpe?g|jpe|jpg|png|css)$' };
-
-# Important variation to regular plugin structure.  Need to declare
-# $self as global variable to file so XMLParser callback routines
-# can access the content of the object. 
-my ($self); 
-
-sub new {
-    my ($class) = shift (@_); 
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-    
-    #create XML::Parser object for parsing dublin_core.xml files
-    my $parser = new XML::Parser('Style' => 'Stream',
-				 'Handlers' => {'Char' => \&Char,
-						'Doctype' => \&Doctype
-						});
-    $self->{'parser'} = $parser;
-    $self->{'extra_blocks'} = {};
-
-    return bless $self, $class;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)contents$^;
-}
-
-# want to block all files except the "contents"
-sub get_default_block_exp {
-    my $self = shift (@_);
-    
-    # Block all files besides contents
-    return q^(?i)(handle|dublin_core\.xml|\.tx?t)$^;
-}
-
-sub read_content
-{
-    my $self = shift (@_);
-    my ($dir, $only_first_doc, $first_inorder_ext, $first_inorder_mime, $mimetype_list) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    my @fnamemime_list = ();
-    my @assocmime_list = ();
-
-    my $content_fname = &util::filename_cat($dir,"contents");
-
-    open(CIN,"<$content_fname") 
-	|| die "Unable to open $content_fname: $!\n";
-    
-    my $line;
-    my $pos = 0;
-
-    while (defined ($line = <CIN>)) {
-	if ($line =~ m/^(.*)\s+bundle:ORIGINAL\s*$/) {
-	    my $fname = $1;
-	    my $mtype = $mimetype_list->[$pos];
-	    my $fm_rec = { 'file' => $fname, 'mimetype' => $mtype};
-	    push(@fnamemime_list,$fm_rec);
-	    $pos++;
-	}
-    }
-    close CIN;
-
-    if ($only_first_doc){
-	my ($first_fname, @rest_fnames) = @fnamemime_list;
-	@fnamemime_list = ($first_fname);
-	@assocmime_list = @rest_fnames;
-    }
-
-    # allow user to specify the types of files (inorder)they would like to assign as
-    # a primary bitstream
-    if ($first_inorder_ext) {
-	# parse user-define file extension names
-	my @extfiles_list = split /,/, $first_inorder_ext;
-	my (@rest_fnames) = @fnamemime_list;
-	my @matched_list = ();
-	foreach my $file_ext (@extfiles_list) {
-	    $pos = 0;
-	    foreach my $allfiles (@fnamemime_list){
-		$allfiles->{'file'} =~ /^(.*)\.(.*?)$/;
-		my $allfiles_ext = $2;
-
-		if ($allfiles_ext =~ /$file_ext/) {
-		    print $outhandle "Existing file:$allfiles->{'file'} match the user-define File Extension:$file_ext\n";
-		    push (@matched_list, $allfiles);
-
-		    # delete the matched extension file from the array
-		    splice(@rest_fnames,$pos,1);
-
-		    return (\@matched_list, \@rest_fnames);
-
-		}
-		$pos++;
-	    }
-	}
-    }
-    
-    if ($first_inorder_mime) {
-	# parse user-define file mimetype
-	my @file_mime_list = split /,/, $first_inorder_mime;
-	my (@rest_fnames) = @fnamemime_list;
-	my @matched_list = ();
-	foreach my $file_mime (@file_mime_list) {
-	    $pos = 0;
-	    foreach my $allfiles (@fnamemime_list){
-		my $allfiles_mime = $allfiles->{'mimetype'};
-
-		if ($allfiles_mime =~ /$file_mime/) {
-		    print $outhandle "Existing file:$allfiles->{'file'} match the user-defined File MimeType:$file_mime\n";
-		    push (@matched_list, $allfiles);
-
-		    # delete the matched MIMEType file from the array
-		    splice(@rest_fnames,$pos,1);
-		    return (\@matched_list, \@rest_fnames);
-		}
-		$pos++;
-	    }
-	}
-    }
-    return (\@fnamemime_list, \@assocmime_list);
-}
-
-
-sub filemime_list_to_re
-{
-    my $self = shift (@_);
-    my ($fnamemime_list) = @_;
-
-    my @fname_list = map { "(".$_->{'file'}.")" } @$fnamemime_list;
-    my $fname_re = join("|",@fname_list);
-    $fname_re =~ s/\./\\\./g;
-
-    return $fname_re;
-}
-
-# Read dublin_core metadata from DSpace collection 
-sub metadata_read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli) = @_;
-
-    my $only_first_doc = $self->{'only_first_doc'};
-    my $first_inorder_ext = $self->{'first_inorder_ext'};
-    my $first_inorder_mime = $self->{'first_inorder_mime'};
-    
-    my $outhandle = $self->{'outhandle'};
-    
-    my $filename = &util::filename_cat($base_dir, $file);
-    # return 0 if $self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/;
-    
-    if ($filename !~ /dublin_core\.xml$/ || !-f $filename) {
-	return undef;
-    }
-    
-    print $outhandle "DSpacePlug: extracting metadata from $file\n"
-	if $self->{'verbosity'} > 1;
-    
-    my ($dir) = $filename =~ /^(.*?)[^\/\\]*$/;
-
-    eval {
-	$self->{'parser'}->parsefile($filename);
-    };
-    
-    if ($@) {
-	die "DSpacePlug: ERROR $filename is not a well formed dublin_core.xml file ($@)\n";
-    }
-
-    my $mimetype_list = $self->{'saved_metadata'}->{'dc.Format^mimetype'};
-    my ($doc_file_mimes, $assoc_file_mimes) = $self->read_content($dir, $only_first_doc, $first_inorder_ext, 
-								  $first_inorder_mime, $mimetype_list);
-
-    my $file_re = $self->filemime_list_to_re($doc_file_mimes);
-
-    if ($only_first_doc || $first_inorder_ext || $first_inorder_mime) {	
-	foreach my $afm ( @$assoc_file_mimes ) {
- 	    my $full_af = &util::filename_cat($dir,$afm->{'file'});
-	    $self->{'extra_blocks'}->{$full_af} = 1;
-	}
-    }
-    push(@$extrametakeys,$file_re);
-
-    if (defined $self->{'saved_metadata'}->{'dc.Format^extent'}) {
-	delete $self->{'saved_metadata'}->{'dc.Format^extent'};
-    }
-
-    if (defined $mimetype_list) {
-	delete $self->{'saved_metadata'}->{'dc.Format^mimetype'};
-
-	# Temporarily store associate file info in metadata table
-	# This will be removed in 'extra_metadata' in BasPlug and used
-	# to perform the actual file association (once the doc obj has
-	# been formed
-
-	my $main_doc = $doc_file_mimes->[0];
-	my $md_mimetype = $main_doc->{'mimetype'};
-
-	my $pd_lookup = $primary_doc_lookup->{$md_mimetype};
-
-	if (defined $pd_lookup) {
-	    my $filter_re = $pd_lookup;
-	    @$assoc_file_mimes = grep { $_->{'file'} !~ m/$filter_re/ }  @$assoc_file_mimes;
-	}
-
-	my @gsdlassocfile_tobe 
-	    = map { &util::filename_cat($dir,$_->{'file'}).":".$_->{'mimetype'}.":" } @$assoc_file_mimes;
-	$self->{'saved_metadata'}->{'gsdlassocfile_tobe'} = \@gsdlassocfile_tobe;
-
-    }
-    
-    $extrametadata->{$file_re} = $self->{'saved_metadata'};
-
-    return 1;
-}
-
-
-# The DSpacePlug read() function. This function does all the right things
-# to make general options work for a given plugin. It calls the process()
-# function which does all the work specific to a plugin (like the old
-# read functions used to do). Most plugins should define their own 
-# process() function and let this read() function keep control.
-#
-# DSpace overrides read() because there is no need to read the actual 
-# text of the file in, because the contents of the file is not text...
-#
-# Return number of files processed, undef if can't process
-# Note that $base_dir might be "" and that $file might 
-# include directories
-
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-    
-    # Block all files except contents
-    my $filename = &util::filename_cat($base_dir, $file);
-    return 0 if $self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/;
-
-    my $assocfile = $metadata->{'assocfile'};
-
-    return 0 if (($filename =~ /dublin_core\.xml$/) || ($filename =~ /contents$/));
-    return 0 if (defined $self->{'extra_blocks'}->{$filename});
-    return undef;
-}
-
-# do plugin specific processing of doc_obj
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
-    my $outhandle = $self->{'outhandle'};
-    
-    return 1;
-}
-
-sub Doctype {
-    my ($expat, $name, $sysid, $pubid, $internal) = @_;
-
-    die if ($name !~ /^dublin_core$/);
-}
-
-sub StartTag {
-    my ($expat, $element) = @_;
-    if ($element eq "dublin_core") {
-	$self->{'saved_metadata'} = {};
-    } elsif ($element eq "dcvalue") {
-	my $metaname = $_{'element'};
-	my $qualifier = $_{'qualifier'}||"";
-	if ($metaname ne "description") {
-	    $metaname .= "^$qualifier" if ($qualifier ne "none" && $qualifier ne "");
-	    $self->{'metaname'} = "dc.\u$metaname";
-	}
-    }
-}
-
-sub EndTag {
-    my ($expat, $element) = @_;
-    
-    if ($element eq "dcvalue") {
-	$self->{'metaname'} = "";
-    }
-}
-
-sub Text {
-    if (defined ($self->{'metaname'}) && $self->{'metaname'} ne "") {
-	# $_ == Metadata content
-	my $mname = $self->{'metaname'};
-	if (defined $self->{'saved_metadata'}->{$mname}) {
-	    # accumulate - add value to existing value(s)
-	    if (ref ($self->{'saved_metadata'}->{$mname}) eq "ARRAY") {
-		push (@{$self->{'saved_metadata'}->{$mname}}, $_);
-	    } else {
-		$self->{'saved_metadata'}->{$mname} = 
-		    [$self->{'saved_metadata'}->{$mname}, $_];
-	    }
-	} else {
-	    # accumulate - add value into (currently empty) array
-	    $self->{'saved_metadata'}->{$mname} = [$_];
-	}
-
-    }
-}
-
-# This Char function overrides the one in XML::Parser::Stream to overcome a
-# problem where $expat->{Text} is treated as the return value, slowing
-# things down significantly in some cases.
-sub Char {
-    use bytes;  # Necessary to prevent encoding issues with XML::Parser 2.31+
-    $_[0]->{'Text'} .= $_[1];
-    return undef;
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/DSpacePlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/DSpacePlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/DSpacePlugin.pm	(revision 15865)
@@ -0,0 +1,410 @@
+
+###########################################################################
+#
+# DSpacePlug.pm -- plugin for import the collection from DSpace 
+# 
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999 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.
+#
+###########################################################################
+
+# DSpace Plug - 10/2004
+# 
+#
+# This plugin takes "contents" and dublin_core.xml file, which contain 
+# Metadata and lists of associated files for a particular document
+# and produces a document containing sections, one for each page.
+# The files should be named "contents" and "dublin_core.xml".  For each of 
+# document in DSpace, it is stored in one directory
+#
+# The format of the "contents" file is as follows:
+# 
+# File.type      bundle:ORIGINAL
+# license.txt    bundle:LICENSE
+# The format of the "dublin_core.xml" file is as follows:
+# The first line contains any metadata for the whole document
+# <dublin_core>
+# eg.
+# <dcvalue element="Title" qualifier="">Snail farming</dcvalue>
+# <dcvalue element="date" qualifier="">2004-10-15</dcvalue>
+#
+
+package DSpacePlug;
+
+use BasPlug;
+use plugin;
+#use ghtml;
+use XMLParser;
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @DSpacePlug::ISA = ('BasPlug');
+}
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "string",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" },
+      { 'name' => "only_first_doc",
+	'desc' => "{DSpacePlug.only_first_doc}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "first_inorder_ext",
+	'desc' => "{DSpacePlug.first_inorder_ext}",
+	'type' => "string",
+	'reqd' => "no" },
+      { 'name' => "first_inorder_mime",
+	'desc' => "{DSpacePlug.first_inorder_mime}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "block_exp",
+	'desc' => "{BasPlug.block_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_block_exp(),
+	'reqd' => "no" }];
+
+
+my $options = { 'name'     => "DSpacePlug",
+		'desc'     => "{DSpacePlug.desc}",
+		'inherits' => "yes",
+		'abstract' => "no",
+		'args'     => $arguments };
+
+
+my $primary_doc_lookup = { 'text/html' => '(?i)\.(gif|jpe?g|jpe|jpg|png|css)$' };
+
+# Important variation to regular plugin structure.  Need to declare
+# $self as global variable to file so XMLParser callback routines
+# can access the content of the object. 
+my ($self); 
+
+sub new {
+    my ($class) = shift (@_); 
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+    
+    #create XML::Parser object for parsing dublin_core.xml files
+    my $parser = new XML::Parser('Style' => 'Stream',
+				 'Handlers' => {'Char' => \&Char,
+						'Doctype' => \&Doctype
+						});
+    $self->{'parser'} = $parser;
+    $self->{'extra_blocks'} = {};
+
+    return bless $self, $class;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)contents$^;
+}
+
+# want to block all files except the "contents"
+sub get_default_block_exp {
+    my $self = shift (@_);
+    
+    # Block all files besides contents
+    return q^(?i)(handle|dublin_core\.xml|\.tx?t)$^;
+}
+
+sub read_content
+{
+    my $self = shift (@_);
+    my ($dir, $only_first_doc, $first_inorder_ext, $first_inorder_mime, $mimetype_list) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    my @fnamemime_list = ();
+    my @assocmime_list = ();
+
+    my $content_fname = &util::filename_cat($dir,"contents");
+
+    open(CIN,"<$content_fname") 
+	|| die "Unable to open $content_fname: $!\n";
+    
+    my $line;
+    my $pos = 0;
+
+    while (defined ($line = <CIN>)) {
+	if ($line =~ m/^(.*)\s+bundle:ORIGINAL\s*$/) {
+	    my $fname = $1;
+	    my $mtype = $mimetype_list->[$pos];
+	    my $fm_rec = { 'file' => $fname, 'mimetype' => $mtype};
+	    push(@fnamemime_list,$fm_rec);
+	    $pos++;
+	}
+    }
+    close CIN;
+
+    if ($only_first_doc){
+	my ($first_fname, @rest_fnames) = @fnamemime_list;
+	@fnamemime_list = ($first_fname);
+	@assocmime_list = @rest_fnames;
+    }
+
+    # allow user to specify the types of files (inorder)they would like to assign as
+    # a primary bitstream
+    if ($first_inorder_ext) {
+	# parse user-define file extension names
+	my @extfiles_list = split /,/, $first_inorder_ext;
+	my (@rest_fnames) = @fnamemime_list;
+	my @matched_list = ();
+	foreach my $file_ext (@extfiles_list) {
+	    $pos = 0;
+	    foreach my $allfiles (@fnamemime_list){
+		$allfiles->{'file'} =~ /^(.*)\.(.*?)$/;
+		my $allfiles_ext = $2;
+
+		if ($allfiles_ext =~ /$file_ext/) {
+		    print $outhandle "Existing file:$allfiles->{'file'} match the user-define File Extension:$file_ext\n";
+		    push (@matched_list, $allfiles);
+
+		    # delete the matched extension file from the array
+		    splice(@rest_fnames,$pos,1);
+
+		    return (\@matched_list, \@rest_fnames);
+
+		}
+		$pos++;
+	    }
+	}
+    }
+    
+    if ($first_inorder_mime) {
+	# parse user-define file mimetype
+	my @file_mime_list = split /,/, $first_inorder_mime;
+	my (@rest_fnames) = @fnamemime_list;
+	my @matched_list = ();
+	foreach my $file_mime (@file_mime_list) {
+	    $pos = 0;
+	    foreach my $allfiles (@fnamemime_list){
+		my $allfiles_mime = $allfiles->{'mimetype'};
+
+		if ($allfiles_mime =~ /$file_mime/) {
+		    print $outhandle "Existing file:$allfiles->{'file'} match the user-defined File MimeType:$file_mime\n";
+		    push (@matched_list, $allfiles);
+
+		    # delete the matched MIMEType file from the array
+		    splice(@rest_fnames,$pos,1);
+		    return (\@matched_list, \@rest_fnames);
+		}
+		$pos++;
+	    }
+	}
+    }
+    return (\@fnamemime_list, \@assocmime_list);
+}
+
+
+sub filemime_list_to_re
+{
+    my $self = shift (@_);
+    my ($fnamemime_list) = @_;
+
+    my @fname_list = map { "(".$_->{'file'}.")" } @$fnamemime_list;
+    my $fname_re = join("|",@fname_list);
+    $fname_re =~ s/\./\\\./g;
+
+    return $fname_re;
+}
+
+# Read dublin_core metadata from DSpace collection 
+sub metadata_read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli) = @_;
+
+    my $only_first_doc = $self->{'only_first_doc'};
+    my $first_inorder_ext = $self->{'first_inorder_ext'};
+    my $first_inorder_mime = $self->{'first_inorder_mime'};
+    
+    my $outhandle = $self->{'outhandle'};
+    
+    my $filename = &util::filename_cat($base_dir, $file);
+    # return 0 if $self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/;
+    
+    if ($filename !~ /dublin_core\.xml$/ || !-f $filename) {
+	return undef;
+    }
+    
+    print $outhandle "DSpacePlug: extracting metadata from $file\n"
+	if $self->{'verbosity'} > 1;
+    
+    my ($dir) = $filename =~ /^(.*?)[^\/\\]*$/;
+
+    eval {
+	$self->{'parser'}->parsefile($filename);
+    };
+    
+    if ($@) {
+	die "DSpacePlug: ERROR $filename is not a well formed dublin_core.xml file ($@)\n";
+    }
+
+    my $mimetype_list = $self->{'saved_metadata'}->{'dc.Format^mimetype'};
+    my ($doc_file_mimes, $assoc_file_mimes) = $self->read_content($dir, $only_first_doc, $first_inorder_ext, 
+								  $first_inorder_mime, $mimetype_list);
+
+    my $file_re = $self->filemime_list_to_re($doc_file_mimes);
+
+    if ($only_first_doc || $first_inorder_ext || $first_inorder_mime) {	
+	foreach my $afm ( @$assoc_file_mimes ) {
+ 	    my $full_af = &util::filename_cat($dir,$afm->{'file'});
+	    $self->{'extra_blocks'}->{$full_af} = 1;
+	}
+    }
+    push(@$extrametakeys,$file_re);
+
+    if (defined $self->{'saved_metadata'}->{'dc.Format^extent'}) {
+	delete $self->{'saved_metadata'}->{'dc.Format^extent'};
+    }
+
+    if (defined $mimetype_list) {
+	delete $self->{'saved_metadata'}->{'dc.Format^mimetype'};
+
+	# Temporarily store associate file info in metadata table
+	# This will be removed in 'extra_metadata' in BasPlug and used
+	# to perform the actual file association (once the doc obj has
+	# been formed
+
+	my $main_doc = $doc_file_mimes->[0];
+	my $md_mimetype = $main_doc->{'mimetype'};
+
+	my $pd_lookup = $primary_doc_lookup->{$md_mimetype};
+
+	if (defined $pd_lookup) {
+	    my $filter_re = $pd_lookup;
+	    @$assoc_file_mimes = grep { $_->{'file'} !~ m/$filter_re/ }  @$assoc_file_mimes;
+	}
+
+	my @gsdlassocfile_tobe 
+	    = map { &util::filename_cat($dir,$_->{'file'}).":".$_->{'mimetype'}.":" } @$assoc_file_mimes;
+	$self->{'saved_metadata'}->{'gsdlassocfile_tobe'} = \@gsdlassocfile_tobe;
+
+    }
+    
+    $extrametadata->{$file_re} = $self->{'saved_metadata'};
+
+    return 1;
+}
+
+
+# The DSpacePlug read() function. This function does all the right things
+# to make general options work for a given plugin. It calls the process()
+# function which does all the work specific to a plugin (like the old
+# read functions used to do). Most plugins should define their own 
+# process() function and let this read() function keep control.
+#
+# DSpace overrides read() because there is no need to read the actual 
+# text of the file in, because the contents of the file is not text...
+#
+# Return number of files processed, undef if can't process
+# Note that $base_dir might be "" and that $file might 
+# include directories
+
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+    
+    # Block all files except contents
+    my $filename = &util::filename_cat($base_dir, $file);
+    return 0 if $self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/;
+
+    my $assocfile = $metadata->{'assocfile'};
+
+    return 0 if (($filename =~ /dublin_core\.xml$/) || ($filename =~ /contents$/));
+    return 0 if (defined $self->{'extra_blocks'}->{$filename});
+    return undef;
+}
+
+# do plugin specific processing of doc_obj
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
+    my $outhandle = $self->{'outhandle'};
+    
+    return 1;
+}
+
+sub Doctype {
+    my ($expat, $name, $sysid, $pubid, $internal) = @_;
+
+    die if ($name !~ /^dublin_core$/);
+}
+
+sub StartTag {
+    my ($expat, $element) = @_;
+    if ($element eq "dublin_core") {
+	$self->{'saved_metadata'} = {};
+    } elsif ($element eq "dcvalue") {
+	my $metaname = $_{'element'};
+	my $qualifier = $_{'qualifier'}||"";
+	if ($metaname ne "description") {
+	    $metaname .= "^$qualifier" if ($qualifier ne "none" && $qualifier ne "");
+	    $self->{'metaname'} = "dc.\u$metaname";
+	}
+    }
+}
+
+sub EndTag {
+    my ($expat, $element) = @_;
+    
+    if ($element eq "dcvalue") {
+	$self->{'metaname'} = "";
+    }
+}
+
+sub Text {
+    if (defined ($self->{'metaname'}) && $self->{'metaname'} ne "") {
+	# $_ == Metadata content
+	my $mname = $self->{'metaname'};
+	if (defined $self->{'saved_metadata'}->{$mname}) {
+	    # accumulate - add value to existing value(s)
+	    if (ref ($self->{'saved_metadata'}->{$mname}) eq "ARRAY") {
+		push (@{$self->{'saved_metadata'}->{$mname}}, $_);
+	    } else {
+		$self->{'saved_metadata'}->{$mname} = 
+		    [$self->{'saved_metadata'}->{$mname}, $_];
+	    }
+	} else {
+	    # accumulate - add value into (currently empty) array
+	    $self->{'saved_metadata'}->{$mname} = [$_];
+	}
+
+    }
+}
+
+# This Char function overrides the one in XML::Parser::Stream to overcome a
+# problem where $expat->{Text} is treated as the return value, slowing
+# things down significantly in some cases.
+sub Char {
+    use bytes;  # Necessary to prevent encoding issues with XML::Parser 2.31+
+    $_[0]->{'Text'} .= $_[1];
+    return undef;
+}
+
+1;
Index: /gsdl/trunk/perllib/plugins/DirectoryPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/DirectoryPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/DirectoryPlugin.pm	(revision 15865)
@@ -0,0 +1,455 @@
+###########################################################################
+#
+# RecPlug.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) 1999 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.
+#
+###########################################################################
+
+# RecPlug is a plugin which recurses through directories processing
+# each file it finds.
+
+# RecPlug has one option: use_metadata_files.  When this is set, it will
+# check each directory for an XML file called "metadata.xml" that specifies
+# metadata for the files (and subdirectories) in the directory.
+#
+# Here's an example of a metadata file that uses three FileSet structures
+# (ignore the # characters):
+
+#<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+#<!DOCTYPE DirectoryMetadata SYSTEM "http://greenstone.org/dtd/DirectoryMetadata/1.0/DirectoryMetadata.dtd">
+#<DirectoryMetadata>
+#  <FileSet>
+#    <FileName>nugget.*</FileName>
+#    <Description>
+#      <Metadata name="Title">Nugget Point, The Catlins</Metadata>
+#      <Metadata name="Place" mode="accumulate">Nugget Point</Metadata>
+#    </Description>
+#  </FileSet>
+#  <FileSet>
+#    <FileName>nugget-point-1.jpg</FileName>
+#    <Description>
+#      <Metadata name="Title">Nugget Point Lighthouse, The Catlins</Metadata>
+#      <Metadata name="Subject">Lighthouse</Metadata>
+#    </Description>
+#  </FileSet>
+#  <FileSet>
+#    <FileName>kaka-point-dir</FileName>
+#    <Description>
+#      <Metadata name="Title">Kaka Point, The Catlins</Metadata>
+#    </Description>
+#  </FileSet>
+#</DirectoryMetadata>
+
+# Metadata elements are read and applied to files in the order they appear
+# in the file.
+#
+# The FileName element describes the subfiles in the directory that the
+# metadata applies to as a perl regular expression (a FileSet group may
+# contain multiple FileName elements). So, <FileName>nugget.*</FileName>
+# indicates that the metadata records in the following Description block
+# apply to every subfile that starts with "nugget".  For these files, a
+# Title metadata element is set, overriding any old value that the Title
+# might have had.
+#
+# Occasionally, we want to have multiple metadata values applied to a
+# document; in this case we use the "mode=accumulate" attribute of the
+# particular Metadata element.  In the second metadata element of the first
+# FileSet above, the "Place" metadata is accumulating, and may therefore be
+# given several values.  If we wanted to override these values and use a
+# single metadata element again, we could set the mode attribute to
+# "override" instead.  Remember: every element is assumed to be in override
+# mode unless you specify otherwise, so if you want to accumulate metadata
+# for some field, every occurance must have "mode=accumulate" specified.
+#
+# The second FileSet element above applies to a specific file, called
+# nugget-point-1.jpg.  This element overrides the Title metadata set in the
+# first FileSet, and adds a "Subject" metadata field.
+#
+# The third and final FileSet sets metadata for a subdirectory rather than
+# a file.  The metadata specified (a Title) will be passed into the
+# subdirectory and applied to every file that occurs in the subdirectory
+# (and to every subsubdirectory and its contents, and so on) unless the
+# metadata is explictly overridden later in the import.
+
+
+
+package RecPlug;
+
+use BasPlug;
+use plugin;
+use util;
+use metadatautil;
+
+use File::Basename;
+use strict;
+no strict 'refs';
+use Encode;
+
+BEGIN {
+    @RecPlug::ISA = ('BasPlug');
+}
+
+my $arguments =
+    [ { 'name' => "block_exp",
+	'desc' => "{BasPlug.block_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_block_exp(),
+	'reqd' => "no" },
+      # this option has been deprecated. leave it here for now so we can warn people not to use it
+      { 'name' => "use_metadata_files",
+	'desc' => "{RecPlug.use_metadata_files}",
+	'type' => "flag",
+	'reqd' => "no",
+	'hiddengli' => "yes" },
+      { 'name' => "recheck_directories",
+	'desc' => "{RecPlug.recheck_directories}",
+	'type' => "flag",
+	'reqd' => "no" } ];
+    
+my $options = { 'name'     => "RecPlug",
+		'desc'     => "{RecPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+    
+    if ($self->{'info_only'}) {
+	# don't worry about any options or initialisations etc
+	return bless $self, $class;
+    }
+
+    # we have left this option in so we can warn people who are still using it
+    if ($self->{'use_metadata_files'}) {
+	die "ERROR: RecPlug -use_metadata_files option has been deprecated. Please remove the option and add MetadataXMLPlug to your plugin list instead!\n";
+    }
+	    
+    $self->{'subdir_extrametakeys'} = {};
+
+    return bless $self, $class;
+}
+
+sub begin {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $processor, $maxdocs) = @_;
+
+    my $proc_package_name = ref $processor;
+
+    if ($proc_package_name !~ /buildproc$/ && $self->{'incremental'} == 1) {
+
+	# Only lookup timestamp info for import.pl, and only if incremental is set
+
+	my $output_dir = $processor->getoutputdir();
+	my $archives_inf = &util::filename_cat($output_dir,"archives.inf");
+    
+	if ( -e $archives_inf ) {
+	    $self->{'inf_timestamp'} = -M $archives_inf;
+	}
+    }
+
+    $self->SUPER::begin($pluginfo, $base_dir, $processor, $maxdocs);
+}
+
+
+# return 1 if this class might recurse using $pluginfo
+sub is_recursive {
+    my $self = shift (@_);
+    
+    return 1;
+}
+
+sub get_default_block_exp {
+    my $self = shift (@_);
+    
+    return '(CVS|\.svn)';
+}
+
+# return number of files processed, undef if can't process
+# Note that $base_dir might be "" and that $file might 
+# include directories
+
+# This function passes around metadata hash structures.  Metadata hash
+# structures are hashes that map from a (scalar) key (the metadata element
+# name) to either a scalar metadata value or a reference to an array of
+# such values.
+
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $in_metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+    
+    my $outhandle = $self->{'outhandle'};
+    my $verbosity = $self->{'verbosity'};
+    my $read_metadata_files = $self->{'use_metadata_files'};
+
+    # Calculate the directory name and ensure it is a directory and
+    # that it is not explicitly blocked.
+    my $dirname = $file;
+    $dirname = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
+    return undef unless (-d $dirname);
+    return 0 if ($self->{'block_exp'} ne "" && $dirname =~ /$self->{'block_exp'}/);
+
+    # check to make sure we're not reading the archives or index directory
+    my $gsdlhome = quotemeta($ENV{'GSDLHOME'});
+    if ($dirname =~ m/^$gsdlhome\/.*?\/import.*?\/(archives|index)$/) {
+	print $outhandle "RecPlug: $dirname appears to be a reference to a Greenstone collection, skipping.\n";
+        return 0;
+    }
+    
+    # check to see we haven't got a cyclic path...
+    if ($dirname =~ m%(/.*){,41}%) {
+	print $outhandle "RecPlug: $dirname is 40 directories deep, is this a recursive path? if not increase constant in RecPlug.pm.\n";
+	return 0;
+    }
+    
+    # check to see we haven't got a cyclic path...
+    if ($dirname =~ m%.*?import/(.+?)/import/\1.*%) {
+	print $outhandle "RecPlug: $dirname appears to be in a recursive loop...\n";
+	return 0;
+    }
+    
+    if (($verbosity > 2) && ((scalar keys %$in_metadata) > 0)) {
+        print $outhandle "RecPlug: metadata passed in: ", 
+	join(", ", keys %$in_metadata), "\n";
+    }
+    
+    # Recur over directory contents.
+    my (@dir, $subfile);
+    my $count = 0;
+    
+    print $outhandle "RecPlug: getting directory $dirname\n" if ($verbosity);
+    
+    # find all the files in the directory
+    if (!opendir (DIR, $dirname)) {
+	if ($gli) {
+	    print STDERR "<ProcessingError n='$file' r='Could not read directory $dirname'>\n";
+	}
+	print $outhandle "RecPlug: WARNING - couldn't read directory $dirname\n";
+	return -1; # error in processing
+    }
+    @dir = readdir (DIR);
+    closedir (DIR);
+
+    # Re-order the files in the list so any directories ending with .all are moved to the end
+    for (my $i = scalar(@dir) - 1; $i >= 0; $i--) {
+	if (-d &util::filename_cat($dirname, $dir[$i]) && $dir[$i] =~ /\.all$/) {
+	    push(@dir, splice(@dir, $i, 1));
+	}
+    }
+
+    # setup the metadata structures. we do a metadata_read pass to see if there is any additional metadata, then pass it to read
+    
+    my $additionalmetadata = 0;      # is there extra metadata available?
+    my %extrametadata;               # maps from filespec to extra metadata keys
+    my @extrametakeys;               # keys of %extrametadata in order read
+
+    my $os_dirsep = &util::get_os_dirsep();
+    my $dirsep    = &util::get_dirsep();
+    my $base_dir_regexp = $base_dir;
+    $base_dir_regexp =~ s/\//$os_dirsep/g;
+    my $local_dirname = $dirname;
+    $local_dirname =~ s/^$base_dir_regexp($os_dirsep)//;
+    $local_dirname .= $dirsep;
+
+    if (defined $self->{'subdir_extrametakeys'}->{$local_dirname}) {
+	my $extrakeys = $self->{'subdir_extrametakeys'}->{$local_dirname};
+	foreach my $ek (@$extrakeys) {
+	    my $extrakeys_re  = $ek->{'re'};
+	    my $extrakeys_md  = $ek->{'md'};
+	    push(@extrametakeys,$extrakeys_re);
+	    $extrametadata{$extrakeys_re} = $extrakeys_md;
+	}
+	delete($self->{'subdir_extrametakeys'}->{$local_dirname});
+    }
+    
+    # apply metadata pass for each of the files in the directory
+    my $out_metadata; 
+    my $num_files = scalar(@dir);
+    for (my $i = 0; $i < scalar(@dir); $i++) {
+	my $subfile = $dir[$i];
+	my $this_file_base_dir = $base_dir;
+	last if ($maxdocs != -1 && $count >= $maxdocs);
+	next if ($subfile =~ m/^\.\.?$/);
+
+	# Recursively read each $subfile
+	print $outhandle "RecPlug metadata recurring: $subfile\n" if ($verbosity > 2);
+	
+	$count += &plugin::metadata_read ($pluginfo, $this_file_base_dir,
+					  &util::filename_cat($file, $subfile),
+					  $out_metadata, \@extrametakeys, \%extrametadata,
+					  $processor, $maxdocs, $gli);
+	$additionalmetadata = 1;
+    }
+   
+    # filter out any extrametakeys that mention subdirectories and store
+    # for later use (i.e. when that sub-directory is being processed)
+
+    foreach my $ek (@extrametakeys) {
+	my ($subdir_re,$extrakey_dir) = &File::Basename::fileparse($ek);
+	$extrakey_dir =~ s/\\\./\./g; # remove RE syntax
+
+	my $dirsep_re = &util::get_re_dirsep();
+
+	my $ek_non_re = $ek;
+	$ek_non_re =~ s/\\\./\./g; # remove RE syntax
+
+	if ($ek_non_re =~ m/$dirsep_re/) { # specifies at least one directory
+	    my $md = $extrametadata{$ek};
+
+	    my $subdir_extrametakeys = $self->{'subdir_extrametakeys'};
+
+	    my $subdir_rec = { 're' => $subdir_re, 'md' => $md };
+
+	    push(@{$subdir_extrametakeys->{$extrakey_dir}},$subdir_rec);
+	}
+    }
+    
+    # import each of the files in the directory
+    $count=0;
+    for (my $i = 0; $i <= scalar(@dir); $i++) {
+	# When every file in the directory has been done, pause for a moment (figuratively!)
+	# If the -recheck_directories argument hasn't been provided, stop now (default)
+	# Otherwise, re-read the contents of the directory to check for new files
+	#   Any new files are added to the @dir list and are processed as normal
+	#   This is necessary when documents to be indexed are specified in bibliographic DBs
+	#   These files are copied/downloaded and stored in a new folder at import time
+	if ($i == $num_files) {
+	    last unless $self->{'recheck_directories'};
+
+	    # Re-read the files in the directory to see if there are any new files
+	    last if (!opendir (DIR, $dirname));
+	    my @dirnow = readdir (DIR);
+	    closedir (DIR);
+
+	    # We're only interested if there are more files than there were before
+	    last if (scalar(@dirnow) <= scalar(@dir));
+
+	    # Any new files are added to the end of @dir to get processed by the loop
+	    my $j;
+	    foreach my $subfilenow (@dirnow) {
+		for ($j = 0; $j < $num_files; $j++) {
+		    last if ($subfilenow eq $dir[$j]);
+		}
+		if ($j == $num_files) {
+		    # New file
+		    push(@dir, $subfilenow);
+		}
+	    }
+	    # When the new files have been processed, check again
+	    $num_files = scalar(@dir);
+	}
+
+	my $subfile = $dir[$i];
+	my $this_file_base_dir = $base_dir;
+	last if ($maxdocs != -1 && ($count + $total_count) >= $maxdocs);
+	next if ($subfile =~ /^\.\.?$/);
+
+	# Follow Windows shortcuts
+	if ($subfile =~ /(?i)\.lnk$/ && $ENV{'GSDLOS'} =~ /^windows$/i) {
+	    require Win32::Shortcut;
+	    my $shortcut = new Win32::Shortcut(&util::filename_cat($dirname, $subfile));
+	    if ($shortcut) {
+		# The file to be processed is now the target of the shortcut
+		$this_file_base_dir = "";
+		$file = "";
+		$subfile = $shortcut->Path;
+	    }
+	}
+
+	# check for a symlink pointing back to a leading directory
+	if (-d "$dirname/$subfile" && -l "$dirname/$subfile") {
+	    # readlink gives a "fatal error" on systems that don't implement
+	    # symlinks. This assumes the the -l test above would fail on those.
+	    my $linkdest=readlink "$dirname/$subfile";
+	    if (!defined ($linkdest)) {
+		# system error - file not found?
+		warn "RecPlug: symlink problem - $!";
+	    } else {
+		# see if link points to current or a parent directory
+		if ($linkdest =~ m@^[\./\\]+$@ ||
+		    index($dirname, $linkdest) != -1) {
+		    warn "RecPlug: Ignoring recursive symlink ($dirname/$subfile -> $linkdest)\n";
+		    next;
+		    ;
+		}
+	    }
+	}
+
+	print $outhandle "RecPlug: preparing metadata for $subfile\n" if ($verbosity > 2);
+
+	# Make a copy of $in_metadata to pass to $subfile
+	$out_metadata = {};
+	&metadatautil::combine_metadata_structures($out_metadata, $in_metadata);
+
+        ## encode the filename as perl5 doesn't handle unicode filenames       
+        my $tmpfile = Encode::encode_utf8($subfile); 
+
+	# Next add metadata read in XML files (if it is supplied)
+	if ($additionalmetadata == 1) {
+	    
+	    my ($filespec, $mdref);
+	    foreach $filespec (@extrametakeys) {
+                ## use the utf8 encoded filename to do the filename comparison
+		if ($tmpfile =~ /^$filespec$/) {
+		    print $outhandle "File \"$subfile\" matches filespec \"$filespec\"\n" 
+			if ($verbosity > 2);
+		    $mdref = $extrametadata{$filespec};
+		    &metadatautil::combine_metadata_structures($out_metadata, $mdref);
+		}
+	    }
+	}
+
+
+	my $file_subfile = &util::filename_cat($file, $subfile);
+	my $filename_subfile 
+	    = &util::filename_cat($this_file_base_dir,$file_subfile);
+	if (defined $self->{'inf_timestamp'}) {
+	    my $inf_timestamp = $self->{'inf_timestamp'};
+
+	    if (! -d $filename_subfile) {
+		my $filename_timestamp = -M $filename_subfile;
+		if ($filename_timestamp > $inf_timestamp) {
+		    # filename has been around for longer than inf
+#####		    print $outhandle "**** Skipping $subfile\n";
+		    next;
+		}
+	    }
+	}
+
+	# Recursively read each $subfile
+	print $outhandle "RecPlug recurring: $subfile\n" if ($verbosity > 2);
+	
+	$count += &plugin::read ($pluginfo, $this_file_base_dir,
+				 $file_subfile,
+				 $out_metadata, $processor, $maxdocs, ($total_count + $count), $gli);
+    }
+
+    return $count;
+}
+
+1;
Index: dl/trunk/perllib/plugins/EMAILPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/EMAILPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,1128 +1,0 @@
-###########################################################################
-#
-# EMAILPlug.pm - a plugin for parsing email files
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999-2002 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.
-#
-###########################################################################
-
-
-
-# EMAILPlug
-#
-# by Gordon Paynter (gwp@cs.waikato.ac.nz)
-#
-# Email plug reads email files.  These are named with a simple
-# number (i.e. as they appear in maildir folders) or with the 
-# extension .mbx (for mbox mail file format)
-#
-# Document text:
-#   The document text consists of all the text 
-#   after the first blank line in the document.
-#
-# Metadata (not Dublin Core!):
-#   $Headers      All the header content (optional, not stored by default)
-#   $Subject      Subject: header
-#   $To           To: header
-#   $From         From: header
-#   $FromName     Name of sender (where available)
-#   $FromAddr     E-mail address of sender
-#   $DateText     Date: header
-#   $Date         Date: header in GSDL format (eg: 19990924)
-#
-#   $Title	  made up of Subject, Date and Sender (for default formatting)
-#
-#
-# John McPherson - June/July 2001
-# added (basic) MIME support and quoted-printable and base64 decodings.
-# Minor fixes for names that are actually email addresses (ie <...> was lost)
-#
-# See:  * RFC 822  - ARPA Internet Text Messages
-#       * RFC 2045 - Multipurpose Internet Mail Extensions (MIME) -part1
-#       * RFC 2046 - MIME (part 2)  Media Types (and multipart messages)
-#       * RFC 2047 - MIME (part 3)  Message Header Extensions
-#       * RFC 1806 - Content Dispositions (ie inline/attachment)
-
-# 12/05/02 Added usage datastructure - John Thompson
-package EMAILPlug;
-
-use strict;
-no strict "refs"; # so we can use a variable as a filehandle for print $out
-
-
-use SplitPlug;
-use unicode;  # gs conv functions
-use gsprintf 'gsprintf'; # translations
-
-use sorttools;
-use util;
-
-sub BEGIN {
-    @EMAILPlug::ISA = ('SplitPlug');
-}
-
-
-my $arguments = 
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_process_exp() },
-      { 'name' => "no_attachments",
-	'desc' => "{EMAILPlug.no_attachments}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "headers",
-	'desc' => "{EMAILPlug.headers}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "split_exp",
-	'desc' => "{EMAILPlug.split_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_split_exp() } 
-      ];
-
-my $options = { 'name'     => "EMAILPlug",
-		'desc'     => "{EMAILPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-# Create a new EMAILPlug object with which to parse a file.
-# Accomplished by creating a new BasPlug and using bless to 
-# turn it into an EMAILPlug.
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new SplitPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    $self->{'assoc_filenames'} = {}; # to save attach names so we don't clobber
-
-    # this might not actually be true at read-time, but after processing
-    # it should all be utf8.
-    $self->{'input_encoding'}="utf8";
-    return bless $self, $class;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-    # mbx/email for mailbox file format, \d+ for maildir (each message is
-    # in a separate file, with a unique number for filename)
-    # mozilla and IE will save individual mbx format files with a ".eml" ext.
-    return q@([\\/]\d+|\.(mbx|email|eml))$@;
-}
-
-# This plugin splits the mbox mail files at lines starting with From<sp>
-# It is supposed to be "\n\nFrom ", but this isn't always used.
-# add \d{4} so that the line ends in a year (in case the text has an
-# unescaped "From " at the start of a line).
-sub get_default_split_exp {
-    return q^\nFrom .*\d{4}\n^;
-    
-}
-
-
-# do plugin specific processing of doc_obj
-sub process {
-
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    # Check that we're dealing with a valid mail file
-    # mbox message files start with "From "
-    # maildir messages usually start with Return-Path and Delivered-To
-    # mh is very similar to maildir
-    my $startoffile=substr($$textref,0,256);
-    if (($startoffile !~ /^(From )/) &&
-	($startoffile !~ /^(From|To|Envelope.*|Received|Return-Path|Date|Subject|Content\-.*|MIME-Version|Forwarded):/im)) {
-	return undef;
-    }
-
-
-    print STDERR "<Processing n='$file' p='EMAILPlug'>\n" if ($gli);
-
-    gsprintf($outhandle, "EMAILPlug: {common.processing} $file\n")
-	if $self->{'verbosity'} > 1;
-
-    my $cursection = $doc_obj->get_top_section();
-
-    #
-    # Parse the document's text and extract metadata
-    #
-
-    # Protect backslashes
-    $$textref =~ s@\\@\\\\@g;
-
-    # Separate header from body of message
-    my $Headers = $$textref;
-    $Headers =~ s/\r?\n\r?\n(.*)$//s;
-    $$textref = $1;
-    $Headers .= "\n";
-    
-    # Unfold headers - see rfc822
-    $Headers =~ s/\r?\n[\t\ ]+/ /gs;
-    # Extract basic metadata from header
-    my @headers = ("From", "To", "Subject", "Date");
-    my %raw;
-    foreach my $name (@headers) {
-	$raw{$name} = "No $name value";
-    }
-
-    # Get a default encoding for the header - RFC says should be ascii...
-    my $default_header_encoding="iso_8859_1";
-
-    # We don't know what character set is the user's default...
-    # We could use textcat to guess... for now we'll look at mime content-type
-#    if ($Headers =~ /([[:^ascii:]])/) {
-#    }
-    if ($Headers =~ /^Content\-type:.*charset=\"?([a-z0-9\-_]+)/mi) {
-	$default_header_encoding=$1;
-	$default_header_encoding =~ s@\-@_@g;
-	$default_header_encoding =~ tr/A-Z/a-z/;
-    }
-
-
-    # Examine each line of the headers
-    my ($line, $name, $value);
-    my @parts;
-    foreach $line (split(/\n/, $Headers)) {
-	
-	# Ignore lines with no content or which begin with whitespace
-	next unless ($line =~ /:/);
-	next if ($line =~ /^\s/);
-
-	# Find out what metadata is on this line
-	@parts = split(/:/, $line);
-	$name = shift @parts;
-        # get fieldname in canonical form - first cap, then lower case.
-	$name =~ tr/A-Z/a-z/;
-        # uppercase the first character according to the current locale
-	$name=~s/(.+)/\u$1/;
-	next unless $name;
-	next unless ($raw{$name});
-
-	# Find the value of that metadata
-	$value = join(":", @parts);
-	$value =~ s/^\s+//;
-	$value =~ s/\s+$//;
-	# decode headers if stored using =?<charset>?[BQ]?<data>?= (rfc2047)
-	if ($value =~ /=\?.*\?[BbQq]\?.*\?=/) {
-	    my $original_value=$value;
-	    my $encoded=$value;
-	    $value="";
-	    # we should ignore spaces between consecutive encoded-texts
-	    $encoded =~ s@\?=\s+=\?@\?==\?@g;
-	    while ($encoded =~ s/(.*?)=\?([^\?]*)\?([bq])\?([^\?]+)\?=//i) {
-		my ($charset, $encoding, $data)=($2,$3,$4);
-		my ($decoded_data);
-		$value.="$1"; # any leading chars
-		$data=~s/^\s*//; $data=~s/\s*$//; # strip whitespace from ends
-		chomp $data;
-		$encoding =~ tr/BQ/bq/;
-		if ($encoding eq "q") { # quoted printable
-		    $data =~ s/_/\ /g;  # from rfc2047 (sec 4.2.2)
-		    $decoded_data=qp_decode($data);
-		    # qp_decode adds \n, which is default for body text
-		    chomp($decoded_data);
-		} else { # base 64
-		    $decoded_data=base64_decode($data);
-		}
-		$self->convert2unicode($charset, \$decoded_data);
-		$value .= $decoded_data;
-	      } # end of while loop
-	    
-	    # get any trailing characters
-	    $self->convert2unicode($default_header_encoding, \$encoded);
-	    $value.=$encoded;
-
-	    if ($value =~ /^\s*$/) { # we couldn't extract anything...
-	      $self->convert2unicode($default_header_encoding,
-				     \$original_value);
-	      $value=$original_value;
-	    }
-        } # end of if =?...?=
-
-        # In the absense of other charset information, assume the
-        # header is the default (usually "iso_8859_1") and convert to unicode.
-        else {
-	    $self->convert2unicode($default_header_encoding, \$value);
-	}
-	
-	# Store the metadata
-	$value =~ s@_@\\_@g; # protect against GS macro language
-	$raw{$name} = $value;
-    }
-
-    # Extract the name and e-mail address from the From metadata
-    my $frommeta = $raw{"From"};
-    my $fromnamemeta;
-    my $fromaddrmeta;
-
-    $frommeta =~ s/\s*$//;  # Remove trailing space, if any
-
-    if ($frommeta =~ m/(.+)\s*<(.+)>/) {
-	$fromnamemeta=$1;
-	$fromaddrmeta=$2;
-    } elsif ($frommeta =~ m/(.+@.+)\s+\((.*)\)/) {
-	$fromnamemeta=$2;
-	$fromaddrmeta=$1;
-    } 
-    if (!defined($fromaddrmeta)) {
-	$fromaddrmeta=$frommeta;
-    }
-    $fromaddrmeta=~s/<//; $fromaddrmeta=~s/>//;
-    # minor attempt to prevent spam-bots from harvesting addresses...
-    $fromaddrmeta=~s/@/&#64;/;
-
-    $doc_obj->add_utf8_metadata ($cursection, "FromAddr", $fromaddrmeta);
-
-    if (defined($fromnamemeta) && $fromnamemeta) { # must be > 0 long
-	$fromnamemeta =~ s/\"//g;  # remove quotes
-	$fromnamemeta =~ s/\s+$//; # remove trailing whitespace
-    }
-    else {
-	$fromnamemeta = $fromaddrmeta;
-    }
-    # if name is an address
-    $fromnamemeta =~ s/<//g; $fromnamemeta =~ s/>//g;
-    $fromnamemeta=~s/@/&#64\;/;
-    $doc_obj->add_utf8_metadata ($cursection, "FromName", $fromnamemeta);
-
-    $raw{"From"}=$frommeta;
-
-    # Process Date information
-    if ($raw{"Date"} !~ /No Date/) {
-	$raw{"DateText"} = $raw{"Date"};
-	
-	# Convert the date text to internal date format
-	$value = $raw{"Date"};
-	# proper mbox format: Tue, 07 Jan 2003 17:27:42 +1300
-	my ($day, $month, $year) = $value =~ /(\d?\d)\s([A-Z][a-z][a-z])\s(\d\d\d?\d?)/;
-	if (!defined($day) || !defined($month) || !defined ($year)) {
-	    # try monthly archive format: Wed Apr 23 00:26:08 2008
-	    ($month,$day, $year) = $value =~ /([A-Z][a-z][a-z])\s\s?(\d?\d)\s\d\d:\d\d:\d\d\s(\d\d\d\d)/;
-	}
-
-	# make some assumptions about the year formatting...
-	# some (old) software thinks 2001 is 101, some think 2001 is 01
-	if ($year < 20) { $year += 2000; } # assume not really 1920...
-	elsif ($year < 150) { $year += 1900; } # assume not really 2150...
-	$raw{"Date"} = &sorttools::format_date($day, $month, $year);
-	
-    } else {
-	# We have not extracted a date
-	$raw{"DateText"} = "Unknown.";
-	$raw{"Date"} = "19000000";
-    }
-
-    # Add extracted metadata to document object
-    foreach my $name (keys %raw) {
-	$value = $raw{$name};
-	if ($value) {
-	    # assume subject, etc headers have no special HTML meaning.
-	    $value = &text_into_html($value);
-	    # escape [] so it isn't re-interpreted as metadata
-	    $value =~ s/\[/&#91;/g; $value =~ s/\]/&#93;/g;
-	} else {
-	    $value = "No $name field";
-	}
-	$doc_obj->add_utf8_metadata ($cursection, $name, $value);
-    }
-
-
-    # extract a message ID from the headers, if there is one, and we'll use
-    # that as the greenstone doc ID. Having a predictable ID means we can
-    # link to other messages, eg from In-Reply-To or References headers...
-    if ($Headers =~ m@^Message-ID:(.+)$@mi) {
-	my $id=escape_msg_id($1);
-	$doc_obj->{'msgid'}=$id;
-    }
-    # link to another message, if this is a reply
-    if ($Headers =~ m@^In-Reply-To:(.+)$@mi) {
-	my $id=escape_msg_id($1);
-	$doc_obj->add_utf8_metadata ($cursection, 'InReplyTo', $id);
-    } elsif ($Headers =~ m@^References:.*\s([^\s]+)$@mi) {
-	# References can have multiple, get the last one
-	my $id=escape_msg_id($1);
-	# not necessarily in-reply-to, but same thread...
-	$doc_obj->add_utf8_metadata ($cursection, 'InReplyTo', $id);
-    }
-
-
-
-    my $mimetype="text/plain";
-    my $mimeinfo="";
-    my $charset = $default_header_encoding;
-    # Do MIME and encoding stuff. Allow \s in mimeinfo in case there is
-    # more than one parameter given to Content-type.
-    # eg: Content-type: text/plain; charset="us-ascii"; format="flowed"
-    if ($Headers =~ m@^content\-type:\s*([\w\.\-/]+)\s*(\;\s*.+)?\s*$@mi)
-	{
-	    $mimetype=$1;
-	    $mimetype =~ tr/[A-Z]/[a-z]/;
-
-	    if ($mimetype eq "text") { # for pre-RFC2045 messages (c. 1996)
-		$mimetype = "text/plain";
-	    }
-
-	    $mimeinfo=$2;
-	    if (!defined $mimeinfo) {
-		$mimeinfo="";
-	    } else { # strip leading and trailing stuff
-		$mimeinfo =~ s/^\;\s*//;
-		$mimeinfo =~ s/\s*$//;
-	    }
-	    if ($mimeinfo =~ /charset=\"([^\"]+)\"/i) {
-	      $charset = $1;
-	    }
-	}
-
-    my $transfer_encoding="7bit";
-    if ($Headers =~ /^content-transfer-encoding:\s*([^\s]+)\s*$/mi) {
-	$transfer_encoding=$1;
-    }
-
-    if ($mimetype eq "text/html") {
-	$$textref= $self->text_from_part($$textref, $Headers);
-    } elsif ($mimetype ne "text/plain") {
-	$self->{'doc_obj'} = $doc_obj; # in case we need to associate files...
-	$$textref=$self->text_from_mime_message($mimetype,$mimeinfo,$$textref);
-    } else { # mimetype eq text/plain
-
-	if ($transfer_encoding =~ /quoted\-printable/) {
-	    $$textref=qp_decode($$textref);
-	} elsif ($transfer_encoding =~ /base64/) {
-	    $$textref=base64_decode($$textref);
-	}
-	$self->convert2unicode($charset, $textref);
-
-	$$textref = &text_into_html($$textref);
-	$$textref =~ s@_@\\_@g; # protect against GS macro language
-
-    }
-
-    
-    if ($self->{'headers'} && $self->{'headers'} == 1) {
-	# Add "All headers" metadata
-	$Headers = &text_into_html($Headers);
-
-	$Headers = "No headers" unless ($Headers =~ /\w/);
-	$Headers =~ s/@/&#64\;/g;
-	# escape [] so it isn't re-interpreted as metadata
-	$Headers =~ s/\[/&#91;/g; $Headers =~ s/\]/&#93;/g;
-	$self->convert2unicode($charset, \$Headers);
-
-	$Headers =~ s@_@\\_@g; # protect against GS macro language
-	$doc_obj->add_utf8_metadata ($cursection, "Headers", $Headers);
-    }
-
-
-    # Add Title metadata
-    my $Title = text_into_html($raw{'Subject'});
-    $Title .= "<br>From: " . text_into_html($fromnamemeta);
-    $Title .= "<br>Date: " . text_into_html($raw{'DateText'});
-    $Title =~ s/\[/&#91;/g; $Title =~ s/\]/&#93;/g;
-
-    $doc_obj->add_utf8_metadata ($cursection, "Title", $Title);
-	
-    # Add FileFormat metadata
-    $doc_obj->add_metadata($cursection, "FileFormat", "EMAIL");
-
-    # Add text to document object
-    $$textref = "No message" unless ($$textref =~ /\w/);
-
-    $doc_obj->add_utf8_text($cursection, $$textref);
-
-    return 1;
-}
-
-
-# Convert a text string into HTML.
-#
-# The HTML is going to be inserted into a GML file, so 
-# we have to be careful not to use symbols like ">",
-# which ocurs frequently in email messages (and use
-# &gt instead.
-#
-# This function also turns links and email addresses into hyperlinks,
-# and replaces carriage returns with <BR> tags (and multiple carriage
-# returns with <P> tags).
-
-
-sub text_into_html {
-    my ($text) = @_;
-
-    # Convert problem characters into HTML symbols
-    $text =~ s/&/&amp;/g;
-    $text =~ s/</&lt;/g;
-    $text =~ s/>/&gt;/g;
-    $text =~ s/\"/&quot;/g;
-
-    # convert email addresses and URIs into links
-# don't markup email addresses for now
-#    $text =~ s/([\w\d\.\-]+@[\w\d\.\-]+)/<a href=\"mailto:$1\">$1<\/a>/g;
-
-    # try to munge email addresses a little bit...
-    $text =~ s/@/&#64;/;
-    # assume hostnames are \.\w\- only, then might have a trailing '/.*'
-    # assume URI doesn't finish with a '.'
-    $text =~ s@((http|ftp|https)://[\w\-]+(\.[\w\-]+)*/?((&amp;|\.|\%[a-f0-9]{2})?[\w\?\=\-_/~]+)*(\#[\w\.\-_]*)?)@<a href=\"$1\">$1<\/a>@gi;
-
-
-    # Clean up whitespace and convert \n charaters to <BR> or <P>
-    $text =~ s/ +/ /g;
-    $text =~ s/\s*$//g; 
-    $text =~ s/^\s*//g;
-    $text =~ s/\n/\n<br>/g;
-    $text =~ s/<br>\s*<br>/<p>/gi;
-
-    return $text;
-}
-
-
-
-
-#Process a MIME message.
-# the textref we are given DOES NOT include the header.
-sub text_from_mime_message {
-    my $self = shift(@_);
-    my ($mimetype,$mimeinfo,$text)=(@_);
-    my $outhandle=$self->{'outhandle'};
-    # Check for multiparts - $mimeinfo will be a boundary
-    if ($mimetype =~ /multipart/) {
-	my $boundary="";
-	if ($mimeinfo =~ m@boundary=(\"[^\"]+\"|[^\s]+)\s*$@im) {
-	    $boundary=$1;
-	    if ($boundary =~ m@^\"@) {
-		$boundary =~ s@^\"@@; $boundary =~ s@\"$@@;
-	    }
-	} else {
-	    print $outhandle "EMAILPlug: (warning) couldn't parse MIME boundary\n";
-	}
-	# parts start with "--$boundary"
-	# message ends with "--$boundary--"
-	# RFC says boundary is <70 chars, [A-Za-z'()+_,-./:=?], so escape any
-	# that perl might want to interpolate. Also allows spaces...
-	$boundary=~s/\\/\\\\/g;
-	$boundary=~s/([\?\+\.\(\)\:\/\'])/\\$1/g;
-	my @message_parts = split("\r?\n\-\-$boundary", "\n$text");
-	# remove first "part" and last "part" (final --)
-	shift @message_parts;
-	my $last=pop @message_parts;
-	# if our boundaries are a bit dodgy and we only found 1 part...
-	if (!defined($last)) {$last="";}
-	# make sure it is only -- and whitespace
-	if ($last !~ /^\-\-\s*$/ms) {
-	    print $outhandle "EMAILPlug: (warning) last part of MIME message isn't empty\n";
-	}
-	foreach my $message_part (@message_parts) {
-	    # remove the leading newline left from split.
-	    $message_part=~s/^\r?\n//;
-	}
-	if ($mimetype eq "multipart/alternative") {
-	    # check for an HTML version first, then TEXT, otherwise use first.
-	    my $part_text="";
-	    foreach my $message_part (@message_parts) {
-		if ($message_part =~ m@^content\-type:\s*text/html@i)
-		{
-		    # Use the HTML version
-		    $part_text = $self->text_from_part($message_part);
-		    $mimetype="text/html";
-		    last;
-		}
-	    }
-	    if ($part_text eq "") { # try getting a text part instead
-		foreach my $message_part (@message_parts) {
-		    if ($message_part =~ m@^content\-type:\s*text/plain@i)
-		    {
-			# Use the plain version
-			$part_text = $self->text_from_part($message_part);
-			if ($part_text =~/[^\s]/) {
-			    $part_text = text_into_html($part_text);
-			}
-			$mimetype="text/plain";
-			last;
-		    }
-		}
-	    }
-	    if ($part_text eq "") { #use first part (no html/text part found)
-		$part_text = $self->text_from_part(shift @message_parts);
-		$part_text = text_into_html($part_text);
-	    }
-	    if ($part_text eq "") { # we couldn't get anything!!!
-		# or it was an empty message...
-		# do nothing...
-		gsprintf($outhandle, "{BasPlug.empty_file} - empty body?\n");
-	    } else {
-		$text = $part_text;
-	    }
-	} elsif ($mimetype =~ m@multipart/(mixed|digest|related|signed)@) {
-	    $text = "";
-	    # signed is for PGP/GPG messages... the last part is a hash
-	    if ($mimetype =~ m@multipart/signed@) {
-		pop @message_parts;
-	    }
-	    my $is_first_part=1;
-	    foreach my $message_part (@message_parts) {
-		if ($is_first_part && $text ne "") {$is_first_part=0;}
-
-		if ($mimetype eq "multipart/digest") {
-		    # default type - RTFRFC!! Set if not already set
-		    $message_part =~ m@^(.*)\n\r?\n@s;
-		    my $part_header=$1;
-		    if ($part_header !~ m@^content-type@mi) {
-			$message_part="Content-type: message/rfc822\n"
-			    . $message_part; # prepend default type
-		    }
-		}
-
-		$text .= $self->process_multipart_part($message_part,
-						       $is_first_part);
-	    } # foreach message part.
-	} else {
-	    # we can't handle this multipart type (not mixed or alternative)
-	    # the RFC also mentions "parallel".
-	}
-    } # end of ($mimetype =~ multipart)
-    elsif ($mimetype =~ m@message/rfc822@) {
-	my $msg_header = $text;
-	$msg_header =~ s/\r?\n\r?\n(.*)$//s;
-	$text = $1;
-
-	if ($msg_header =~ /^content\-type:\s*([\w\.\-\/]+)\s*\;?\s*(.+?)\s*$/mi)
-	{
-	    $mimetype=$1;
-	    $mimeinfo=$2;
-	    $mimetype =~ tr/[A-Z]/[a-z]/;
-
-	    my $msg_text;
-	    if ($mimetype =~ m@multipart/@) {
-		$msg_text = text_from_mime_message($self, $mimetype, $mimeinfo,
-						   $text);
-	    } else {
-		$msg_text=$self->text_from_part($text,$msg_header);
-	    }
-
-	    my $brief_header=text_into_html(get_brief_headers($msg_header));
-	    $text= "\n<b>&lt;&lt;attached message&gt;&gt;</b><br>";
-	    $text.= "<table><tr><td width=\"5%\"> </td>\n";
-	    $text.="<td>" . $brief_header . "\n</p>" . $msg_text 
-		. "</td></tr></table>";
-	}
-    } else {
-	# we don't do any processing of the content.
-    }
-
-    return $text;
-}
-
-
-
-# used for turning a message id into a more friendly string for greenstone
-sub escape_msg_id {
-#msgid
-    my $id=shift;
-    chomp $id; $id =~ s!\s!!g; # remove spaces
-    $id =~ s![<>\[\]]!!g; # remove [ ] < and >
-    $id =~ s![_&]!-!g; # replace symbols that might cause problems
-    $id =~ s!\.!-!g; # . means section to greenstone doc ids!
-    $id =~ s!@!-!g; # replace @ symbol, to avoid spambots
-    return $id;
-}
-
-
-
-sub process_multipart_part {
-    my $self = shift;
-    my $message_part = shift;
-    my $is_first_part = shift;
-
-    my $return_text="";
-    my $part_header=$message_part;
-    my $part_body;
-    if ($message_part=~ /^\s*\n/) {
-	# no header... use defaults
-	$part_body=$message_part;
-	$part_header="Content-type: text/plain; charset=us-ascii";
-    } elsif ($part_header=~s/\r?\n\r?\n(.*)$//s) {
-	$part_body=$1;
-    } else {
-	# something's gone wrong...
-	$part_header="";
-	$part_body=$message_part;
-    }
-    
-    $part_header =~ s/\r?\n[\t\ ]+/ /gs; #unfold
-    my $part_content_type="";
-    my $part_content_info="";
-
-    if ($part_header =~ m@^content\-type:\s*([\w\.\-/]+)\s*(\;.*)?$@mi) {
-	$part_content_type=$1; $part_content_type =~ tr/A-Z/a-z/;
-	$part_content_info=$2;
-	if (!defined($part_content_info)) {
-	    $part_content_info="";
-	} else {
-	    $part_content_info =~ s/^\;\s*//;
-	    $part_content_info =~ s/\s*$//;
-	}
-    }
-    my $filename="";
-    if ($part_header =~ m@name=\"?([^\"\n]+)\"?@mis) {
-	$filename=$1;
-	$filename =~ s@\r?\s*$@@; # remove trailing space, if any
-    }
-    
-    # disposition - either inline or attachment.
-    # NOT CURRENTLY USED - we display all text types instead...
-    # $part_header =~ /^content\-disposition:\s*([\w+])/mis;
-    
-    # add <<attachment>> to each part except the first...
-    if (!$is_first_part) {
-	$return_text.="\n<p><hr><strong>&lt;&lt;attachment&gt;&gt;";
-	# add part info header
-	my $header_text = "<br>Type: $part_content_type<br>\n";
-	if ($filename ne "") {
-	    $header_text .= "Filename: $filename\n";
-	}
-	$header_text =~ s@_@\\_@g;
-	$return_text .= $header_text . "</strong></p>\n<p>\n";
-    }
-
-    if ($part_content_type =~ m@text/@)
-    {
-	# $message_part includes the mime part headers
-	my $part_text = $self->text_from_part($message_part);
-	if ($part_content_type !~ m@text/(ht|x)ml@) {
-	    $part_text = text_into_html($part_text);
-	}
-	if ($part_text eq "") {
-	    $part_text = ' ';
-	}
-	$return_text .= $part_text;
-    } elsif ($part_content_type =~ m@message/rfc822@) {
-	# This is a forwarded message
-	my $message_part_headers=$part_body;
-	$message_part_headers=~s/\r?\n\r?\n(.*)$//s;
-	my $message_part_body=$1;
-	$message_part_headers =~ s/\r?\n[\t\ ]+/ /gs; #unfold
-	
-	my $rfc822_formatted_body=""; # put result in here
-	if ($message_part_headers =~
-	    /^content\-type:\s*([\w\.\-\/]+)\s*(\;.*)?$/ims)
-	{
-	    # The message header uses MIME flags
-	    my $message_content_type=$1;
-	    my $message_content_info=$2;
-	    if (!defined($message_content_info)) {
-		$message_content_info="";
-	    } else {
-		$message_content_info =~ s/^\;\s*//;
-		$message_content_info =~ s/\s*$//;
-	    }
-	    $message_content_type =~ tr/A-Z/a-z/;
-	    if ($message_content_type =~ /multipart/) {
-		$rfc822_formatted_body=
-		    $self->text_from_mime_message($message_content_type,
-						  $message_content_info,
-						  $message_part_body);
-	    } else {
-		$message_part_body=$self->text_from_part($part_body,
-							$message_part_headers);
-		$rfc822_formatted_body=text_into_html($message_part_body);
-	    }
-	} else {
-	    # message doesn't use MIME flags
-	    $rfc822_formatted_body=text_into_html($message_part_body);
-	    $rfc822_formatted_body =~ s@_@\\_@g;
-	}
-	# Add the returned text to the output
-	# don't put all the headers...
-#	$message_part_headers =~ s/^(X\-.*|received|message\-id|return\-path):.*\n//img;
-	my $brief_headers=get_brief_headers($message_part_headers);
-	$return_text.=text_into_html($brief_headers);
-	$return_text.="</p><p>\n";
-	$return_text.=$rfc822_formatted_body;
-	$return_text.="</p>\n";
-	# end of message/rfc822
-    } elsif ($part_content_type =~ /multipart/) { 
-	# recurse again
-	
-	my $tmptext= $self->text_from_mime_message($part_content_type,
-						   $part_content_info,
-						   $part_body);
-	$return_text.=$tmptext;
-    } else {
-	# this part isn't text/* or another message...
-	if ($is_first_part) {
-	    # this is the first part of a multipart, or only part!
-	    $return_text="\n<p><hr><strong>&lt;&lt;attachment&gt;&gt;";
-	    # add part info header
-	    my $header_text="<br>Type: $part_content_type<br>\n";
-	    $header_text.="Filename: $filename</strong></p>\n<p>\n";
-	    $header_text =~ s@_@\\_@g;
-	    $return_text.=$header_text;
-	}
-	
-	# save attachment by default
-	if (!$self->{'no_attachments'}
-	    && $filename ne "") { # this part has a file...
-	    my $encoding="8bit";
-	    if ($part_header =~
-		/^content-transfer-encoding:\s*(\w+)/mi ) {
-		$encoding=$1; $encoding =~ tr/A-Z/a-z/;
-	    }
-	    my $tmpdir=$ENV{'GSDLHOME'} . "/tmp";
-	    my $save_filename=$filename;
-	    
-	    # make sure we don't clobber files with same name;
-	    # need to keep state between .mbx files
-	    my $assoc_files=$self->{'assoc_filenames'};
-	    if ($assoc_files->{$filename}) { # it's been set...
-		$assoc_files->{$filename}++;
-		$filename =~ m/(.+)\.(\w+)$/;
-		my ($filestem, $ext)=($1,$2);
-		$save_filename="${filestem}_"
-		    . $assoc_files->{$filename} . ".$ext";
-	    } else { # first file with this name
-		$assoc_files->{$filename}=1;
-	    }
-	    open (SAVE, ">$tmpdir/$save_filename") ||
-		warn "EMAILPlug: Can't save attachment as $tmpdir/$save_filename: $!";
-	    my $part_text = $message_part;
-	    $part_text =~ s/(.*?)\r?\n\r?\n//s; # remove header
-	    if ($encoding eq "base64") {
-		print SAVE base64_decode($part_text);
-	    } elsif ($encoding eq "quoted-printable") {
-		print SAVE qp_decode($part_text);
-	    } else { # 7bit, 8bit, binary, etc...
-		print SAVE $part_text;
-	    }
-	    close SAVE;
-	    my $doc_obj=$self->{'doc_obj'};
-	    $doc_obj->associate_file("$tmpdir/$save_filename",
-				     "$save_filename",
-				     $part_content_type # mimetype
-				     );
-	    # clean up tmp area...
-	    # Can't do this as it hasn't been copied/linked yet!!!
-#			&util::rm("$tmpdir/$save_filename");
-	    my $outhandle=$self->{'outhandle'};
-	    print $outhandle "EMAILPlug: saving attachment \"$filename\"\n"; #
-	    
-	    # be nice if "download" was a translatable macro :(
-	    $return_text .="<a href=\"_httpdocimg_/$save_filename\">download</a>";
-	} # end of save attachment
-    } # end of !text/message part
-
-
-    return $return_text;
-}
-
-
-# Return only the "important" headers from a set of message headers
-sub get_brief_headers {
-    my $msg_header = shift;
-    my $brief_header = "";
-
-    # Order matters!
-    if ($msg_header =~ /^(From:.*)$/im) {$brief_header.="$1\n";}
-    if ($msg_header =~ /^(To:.*)$/im) {$brief_header.="$1\n";}
-    if ($msg_header =~ /^(Cc:.*)$/im) {$brief_header.="$1\n";}
-    if ($msg_header =~ /^(Subject:.*)$/im) {$brief_header.="$1\n";}
-    if ($msg_header =~ /^(Date:.*)$/im) {$brief_header.="$1\n";}
-
-    return $brief_header;
-}
-
-
-# Process a MIME part. Return "" if we can't decode it.
-# should only be called for parts with type "text/*" ?
-# Either pass the entire mime part (including the part's header),
-# or pass the mime part's text and optionally the part's header.
-sub text_from_part {
-    my $self = shift;
-    my $text = shift || '';
-    my $part_header = shift;
-
-
-    my $type="text/plain"; # default, overridden from part header
-    my $charset=undef;     # convert2unicode() will guess if necessary
-
-    if (! $part_header) { # no header argument was given. check the body
-	$part_header = $text;
-	# check for empty part header (leading blank line)
-	if ($text =~ /^\s*\r?\n/) {
-	    $part_header="Content-type: text/plain; charset=us-ascii";
-	} else {
-	    $part_header =~ s/\r?\n\r?\n(.*)$//s;
-	    $text=$1; if (!defined($text)) {$text="";}
-	}
-	$part_header =~ s/\r?\n[\t ]+/ /gs; #unfold
-    }
-
-    if ($part_header =~
-	/content\-type:\s*([\w\.\-\/]+).*?charset=\"?([^\;\"\s]+)\"?/is) {
-	$type=$1;
-	$charset=$2;
-    }
-    my $encoding="";
-    if ($part_header =~ /^content\-transfer\-encoding:\s*([^\s]+)/mis) {
-	$encoding=$1; $encoding=~tr/A-Z/a-z/;
-    }
-    # Content-Transfer-Encoding is per-part
-    if ($encoding ne "") {
-	if ($encoding =~ /quoted\-printable/) {
-	    $text=qp_decode($text);
-	} elsif ($encoding =~ /base64/) {
-	    $text=base64_decode($text);
-	} elsif ($encoding !~ /[78]bit/) { # leave 7/8 bit as is.
-	    # rfc2045 also allows binary, which we ignore (for now).
-	    my $outhandle=$self->{'outhandle'};
-	    print $outhandle "EMAILPlug: unknown transfer encoding: $encoding\n";
-	    return "";
-	}
-    }
-
-    if ($type eq "text/html") {
-	# only get stuff between <body> tags, or <html> tags.
-	$text =~ s@^.*<html[^>]*>@@is;
-	$text =~ s@</html>.*$@@is;
-	$text =~ s/^.*?<body[^>]*>//si;
-	$text =~ s/<\/body>.*$//si;
-    }
-    elsif ($type eq "text/xml") {
-	$text=~s/</&lt;/g;$text=~s/>/&gt;/g;
-	$text="<pre>\n$text\n</pre>\n";
-    }
-    # convert to unicode
-    $self->convert2unicode($charset, \$text);
-    $text =~ s@_@\\_@g; # protect against GS macro language
-    return $text;
-}
-
-
-
-
-# decode quoted-printable text
-sub qp_decode {
-    my $text=shift;
-
-    # if a line ends with "=\s*", it is a soft line break, otherwise
-    # keep in any newline characters.
-
-    $text =~ s/=\s*\r?\n//mg;
-    $text =~ s/=([0-9A-Fa-f]{2})/chr (hex "0x$1")/eg;
-    return $text;
-}
-
-# decode base64 text. This is fairly slow (since it's interpreted perl rather
-# than compiled XS stuff like in the ::MIME modules, but this is more portable
-# for us at least).
-# see rfc2045 for description, but basically, bits 7 and 8 are set to zero;
-# 4 bytes of encoded text become 3 bytes of binary - remove 2 highest bits
-# from each encoded byte.
-
-
-sub base64_decode {
-    my $enc_text = shift;
-# A=>0, B=>1, ..., '+'=>62, '/'=>63
-# also '=' is used for padding at the end, but we remove it anyway.
-    my $mimechars="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
-# map each MIME char into it's value, for more efficient lookup.
-    my %index;
-    map { $index{$_} = index ($mimechars, $_) } (split ('', $mimechars));
-# remove all non-base64 chars. eval to get variable in transliteration...
-# also remove '=' - we'll assume (!!) that there are no errors in the encoding
-    eval "\$enc_text =~ tr|$mimechars||cd";
-    my $decoded="";
-    while (length ($enc_text)>3)
-    { 
-	my $fourchars=substr($enc_text,0,4,"");
-	my @chars=(split '',$fourchars);
-	$decoded.=chr( $index{$chars[0]}        << 2 | $index{$chars[1]} >> 4);
-	$decoded.=chr( ($index{$chars[1]} & 15) << 4 | $index{$chars[2]} >> 2);
-	$decoded.=chr( ($index{$chars[2]} & 3 ) << 6 |  $index{$chars[3]});
-    } 
-# if there are any input chars left, there are either
-# 2 encoded bytes (-> 1 raw byte) left or 3 encoded (-> 2 raw) bytes left.
-    my @chars=(split '',$enc_text);
-    if (length($enc_text)) {
-	$decoded.=chr($index{$chars[0]} << 2 | (int $index{$chars[1]} >> 4));
-    } 
-    if (length($enc_text)==3) {
-	$decoded.=chr( ($index{$chars[1]} & 15) << 4 | $index{$chars[2]} >> 2);
-    }
-    return $decoded;
-}
-
-# returns 0 if valid utf-8, 1 if invalid
-sub is_utf8 {
-    my $self = shift;
-    my $textref = shift;
-
-    $$textref =~ m/^/g; # to set \G
-    my $badbytesfound=0;
-    while ($$textref =~ m!\G.*?([\x80-\xff]+)!sg) {
-	my $highbytes=$1;
-	my $highbyteslength=length($highbytes);
-	# replace any non utf8 complaint bytes
-	$highbytes =~ /^/g; # set pos()
-	while ($highbytes =~
-	       m!\G (?: [\xc0-\xdf][\x80-\xbf] | # 2 byte utf-8
-		     [\xe0-\xef][\x80-\xbf]{2} | # 3 byte
-		     [\xf0-\xf7][\x80-\xbf]{3} | # 4 byte
-		     [\xf8-\xfb][\x80-\xbf]{4} | # 5 byte
-		     [\xfc-\xfd][\x80-\xbf]{5}   # 6 byte
-		     )*([\x80-\xff])? !xg
-	       ) {
-	    my $badbyte=$1;
-	    if (!defined $badbyte) {next} # hit end of string
-	    return 1;
-	}
-    }
-    return 0;
-}
-
-
-
-sub convert2unicode {
-  my $self = shift(@_);
-  my ($charset, $textref) = @_;
-
-  if (!$$textref) {
-      # nothing to do!
-      return;
-  }
-
-  if (! defined $charset) {
-      # check if we have valid utf-8
-      if ($self->is_utf8($textref)) { $charset = "utf8" }
-
-      # default to latin
-      $charset = "iso_8859_1" if ! defined($charset);
-  }
-
-  # first get our character encoding name in the right form.
-  $charset =~ tr/A-Z/a-z/; # lowercase
-  $charset =~ s/\-/_/g;
-  if ($charset =~ /gb_?2312/) { $charset="gb" }
-  # assumes EUC-KR, not ISO-2022 !?
-  $charset =~ s/^ks_c_5601_1987/korean/;
-  if ($charset eq 'utf_8') {$charset='utf8'}
-
-  my $outhandle = $self->{'outhandle'};
-
-  if ($charset eq "utf8") {
-      # no conversion needed, but lets check that it's valid utf8
-      # see utf-8 manpage for valid ranges
-      $$textref =~ m/^/g; # to set \G
-      my $badbytesfound=0;
-      while ($$textref =~ m!\G.*?([\x80-\xff]+)!sg) {
-	  my $highbytes=$1;
-	  my $highbyteslength=length($highbytes);
-	  # replace any non utf8 complaint bytes
-	  $highbytes =~ /^/g; # set pos()
-	  while ($highbytes =~
-		 m!\G (?: [\xc0-\xdf][\x80-\xbf] | # 2 byte utf-8
-		       [\xe0-\xef][\x80-\xbf]{2} | # 3 byte
-		       [\xf0-\xf7][\x80-\xbf]{3} | # 4 byte
-		       [\xf8-\xfb][\x80-\xbf]{4} | # 5 byte
-		       [\xfc-\xfd][\x80-\xbf]{5}   # 6 byte
-		       )*([\x80-\xff])? !xg
-		 ) {
-	      my $badbyte=$1;
-	      if (!defined $badbyte) {next} # hit end of string
-	      my $pos=pos($highbytes);
-	      substr($highbytes, $pos-1, 1, "\xc2\x80");
-	      # update the position to continue searching (for \G)
-	      pos($highbytes) = $pos+1; # set to just after the \x80
-	      $badbytesfound=1;
-	  }
-	  if ($badbytesfound==1) {
-	      # claims to be utf8, but it isn't!
-	      print $outhandle "EMAILPlug: Headers claim utf-8 but bad bytes "
-		  . "detected and removed.\n";
-
-	      my $replength=length($highbytes);
-	      my $textpos=pos($$textref);
-	      # replace bad bytes with good bytes
-	      substr( $$textref, $textpos-$replength,
-		      $replength, $highbytes);
-	      # update the position to continue searching (for \G)
-	      pos($$textref)=$textpos+($replength-$highbyteslength);
-	  }
-      }
-      return;
-  }
-
-  # It appears that we can't always trust ascii text so we'll treat it
-  # as iso-8859-1 (letting characters above 0x80 through without
-  # converting them to utf-8 will result in invalid XML documents
-  # which can't be parsed at build time).
-  $charset = "iso_8859_1" if ($charset eq "us_ascii" || $charset eq "ascii");
-
-  if ($charset eq "iso_8859_1") {
-      # test if the mailer lied, and it has win1252 chars in it...
-      # 1252 has characters between 0x80 and 0x9f, 8859-1 doesn't
-      if ($$textref =~ m/[\x80-\x9f]/) {
-	  print $outhandle "EMAILPlug: Headers claim ISO charset but MS ";
-	  print $outhandle "codepage 1252 detected.\n";
-	  $charset = "windows_1252";
-      }
-  }
-  my $utf8_text=&unicode::unicode2utf8(&unicode::convert2unicode($charset,$textref));
-
-  if ($utf8_text ne "") {
-      $$textref=$utf8_text;
-  } else {
-      # we didn't get any text... unsupported encoding perhaps? Or it is
-      # empty anyway. We'll try to continue, assuming 8859-1. We could strip
-      # characters out here if this causes problems...
-      my $outhandle=$self->{'outhandle'};
-      print $outhandle "EMAILPlug: falling back to iso-8859-1\n";
-      $$textref=&unicode::unicode2utf8(&unicode::convert2unicode("iso_8859_1",$textref));
-
-  }
-}
-
-
-sub set_OID {
-    my $self = shift (@_);
-    my ($doc_obj, $id, $segment_number) = @_;
-    
-    if ( exists $doc_obj->{'msgid'} ) {
-	$doc_obj->set_OID($doc_obj->{'msgid'});
-    } else {
-	$doc_obj->set_OID("$id\_$segment_number");
-    }
-}
-
-
-# Perl packages have to return true if they are run.
-1;
Index: /gsdl/trunk/perllib/plugins/EmailPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/EmailPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/EmailPlugin.pm	(revision 15865)
@@ -0,0 +1,1128 @@
+###########################################################################
+#
+# EMAILPlug.pm - a plugin for parsing email files
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999-2002 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.
+#
+###########################################################################
+
+
+
+# EMAILPlug
+#
+# by Gordon Paynter (gwp@cs.waikato.ac.nz)
+#
+# Email plug reads email files.  These are named with a simple
+# number (i.e. as they appear in maildir folders) or with the 
+# extension .mbx (for mbox mail file format)
+#
+# Document text:
+#   The document text consists of all the text 
+#   after the first blank line in the document.
+#
+# Metadata (not Dublin Core!):
+#   $Headers      All the header content (optional, not stored by default)
+#   $Subject      Subject: header
+#   $To           To: header
+#   $From         From: header
+#   $FromName     Name of sender (where available)
+#   $FromAddr     E-mail address of sender
+#   $DateText     Date: header
+#   $Date         Date: header in GSDL format (eg: 19990924)
+#
+#   $Title	  made up of Subject, Date and Sender (for default formatting)
+#
+#
+# John McPherson - June/July 2001
+# added (basic) MIME support and quoted-printable and base64 decodings.
+# Minor fixes for names that are actually email addresses (ie <...> was lost)
+#
+# See:  * RFC 822  - ARPA Internet Text Messages
+#       * RFC 2045 - Multipurpose Internet Mail Extensions (MIME) -part1
+#       * RFC 2046 - MIME (part 2)  Media Types (and multipart messages)
+#       * RFC 2047 - MIME (part 3)  Message Header Extensions
+#       * RFC 1806 - Content Dispositions (ie inline/attachment)
+
+# 12/05/02 Added usage datastructure - John Thompson
+package EMAILPlug;
+
+use strict;
+no strict "refs"; # so we can use a variable as a filehandle for print $out
+
+
+use SplitPlug;
+use unicode;  # gs conv functions
+use gsprintf 'gsprintf'; # translations
+
+use sorttools;
+use util;
+
+sub BEGIN {
+    @EMAILPlug::ISA = ('SplitPlug');
+}
+
+
+my $arguments = 
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_process_exp() },
+      { 'name' => "no_attachments",
+	'desc' => "{EMAILPlug.no_attachments}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "headers",
+	'desc' => "{EMAILPlug.headers}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "split_exp",
+	'desc' => "{EMAILPlug.split_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_split_exp() } 
+      ];
+
+my $options = { 'name'     => "EMAILPlug",
+		'desc'     => "{EMAILPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+# Create a new EMAILPlug object with which to parse a file.
+# Accomplished by creating a new BasPlug and using bless to 
+# turn it into an EMAILPlug.
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new SplitPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    $self->{'assoc_filenames'} = {}; # to save attach names so we don't clobber
+
+    # this might not actually be true at read-time, but after processing
+    # it should all be utf8.
+    $self->{'input_encoding'}="utf8";
+    return bless $self, $class;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+    # mbx/email for mailbox file format, \d+ for maildir (each message is
+    # in a separate file, with a unique number for filename)
+    # mozilla and IE will save individual mbx format files with a ".eml" ext.
+    return q@([\\/]\d+|\.(mbx|email|eml))$@;
+}
+
+# This plugin splits the mbox mail files at lines starting with From<sp>
+# It is supposed to be "\n\nFrom ", but this isn't always used.
+# add \d{4} so that the line ends in a year (in case the text has an
+# unescaped "From " at the start of a line).
+sub get_default_split_exp {
+    return q^\nFrom .*\d{4}\n^;
+    
+}
+
+
+# do plugin specific processing of doc_obj
+sub process {
+
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    # Check that we're dealing with a valid mail file
+    # mbox message files start with "From "
+    # maildir messages usually start with Return-Path and Delivered-To
+    # mh is very similar to maildir
+    my $startoffile=substr($$textref,0,256);
+    if (($startoffile !~ /^(From )/) &&
+	($startoffile !~ /^(From|To|Envelope.*|Received|Return-Path|Date|Subject|Content\-.*|MIME-Version|Forwarded):/im)) {
+	return undef;
+    }
+
+
+    print STDERR "<Processing n='$file' p='EMAILPlug'>\n" if ($gli);
+
+    gsprintf($outhandle, "EMAILPlug: {common.processing} $file\n")
+	if $self->{'verbosity'} > 1;
+
+    my $cursection = $doc_obj->get_top_section();
+
+    #
+    # Parse the document's text and extract metadata
+    #
+
+    # Protect backslashes
+    $$textref =~ s@\\@\\\\@g;
+
+    # Separate header from body of message
+    my $Headers = $$textref;
+    $Headers =~ s/\r?\n\r?\n(.*)$//s;
+    $$textref = $1;
+    $Headers .= "\n";
+    
+    # Unfold headers - see rfc822
+    $Headers =~ s/\r?\n[\t\ ]+/ /gs;
+    # Extract basic metadata from header
+    my @headers = ("From", "To", "Subject", "Date");
+    my %raw;
+    foreach my $name (@headers) {
+	$raw{$name} = "No $name value";
+    }
+
+    # Get a default encoding for the header - RFC says should be ascii...
+    my $default_header_encoding="iso_8859_1";
+
+    # We don't know what character set is the user's default...
+    # We could use textcat to guess... for now we'll look at mime content-type
+#    if ($Headers =~ /([[:^ascii:]])/) {
+#    }
+    if ($Headers =~ /^Content\-type:.*charset=\"?([a-z0-9\-_]+)/mi) {
+	$default_header_encoding=$1;
+	$default_header_encoding =~ s@\-@_@g;
+	$default_header_encoding =~ tr/A-Z/a-z/;
+    }
+
+
+    # Examine each line of the headers
+    my ($line, $name, $value);
+    my @parts;
+    foreach $line (split(/\n/, $Headers)) {
+	
+	# Ignore lines with no content or which begin with whitespace
+	next unless ($line =~ /:/);
+	next if ($line =~ /^\s/);
+
+	# Find out what metadata is on this line
+	@parts = split(/:/, $line);
+	$name = shift @parts;
+        # get fieldname in canonical form - first cap, then lower case.
+	$name =~ tr/A-Z/a-z/;
+        # uppercase the first character according to the current locale
+	$name=~s/(.+)/\u$1/;
+	next unless $name;
+	next unless ($raw{$name});
+
+	# Find the value of that metadata
+	$value = join(":", @parts);
+	$value =~ s/^\s+//;
+	$value =~ s/\s+$//;
+	# decode headers if stored using =?<charset>?[BQ]?<data>?= (rfc2047)
+	if ($value =~ /=\?.*\?[BbQq]\?.*\?=/) {
+	    my $original_value=$value;
+	    my $encoded=$value;
+	    $value="";
+	    # we should ignore spaces between consecutive encoded-texts
+	    $encoded =~ s@\?=\s+=\?@\?==\?@g;
+	    while ($encoded =~ s/(.*?)=\?([^\?]*)\?([bq])\?([^\?]+)\?=//i) {
+		my ($charset, $encoding, $data)=($2,$3,$4);
+		my ($decoded_data);
+		$value.="$1"; # any leading chars
+		$data=~s/^\s*//; $data=~s/\s*$//; # strip whitespace from ends
+		chomp $data;
+		$encoding =~ tr/BQ/bq/;
+		if ($encoding eq "q") { # quoted printable
+		    $data =~ s/_/\ /g;  # from rfc2047 (sec 4.2.2)
+		    $decoded_data=qp_decode($data);
+		    # qp_decode adds \n, which is default for body text
+		    chomp($decoded_data);
+		} else { # base 64
+		    $decoded_data=base64_decode($data);
+		}
+		$self->convert2unicode($charset, \$decoded_data);
+		$value .= $decoded_data;
+	      } # end of while loop
+	    
+	    # get any trailing characters
+	    $self->convert2unicode($default_header_encoding, \$encoded);
+	    $value.=$encoded;
+
+	    if ($value =~ /^\s*$/) { # we couldn't extract anything...
+	      $self->convert2unicode($default_header_encoding,
+				     \$original_value);
+	      $value=$original_value;
+	    }
+        } # end of if =?...?=
+
+        # In the absense of other charset information, assume the
+        # header is the default (usually "iso_8859_1") and convert to unicode.
+        else {
+	    $self->convert2unicode($default_header_encoding, \$value);
+	}
+	
+	# Store the metadata
+	$value =~ s@_@\\_@g; # protect against GS macro language
+	$raw{$name} = $value;
+    }
+
+    # Extract the name and e-mail address from the From metadata
+    my $frommeta = $raw{"From"};
+    my $fromnamemeta;
+    my $fromaddrmeta;
+
+    $frommeta =~ s/\s*$//;  # Remove trailing space, if any
+
+    if ($frommeta =~ m/(.+)\s*<(.+)>/) {
+	$fromnamemeta=$1;
+	$fromaddrmeta=$2;
+    } elsif ($frommeta =~ m/(.+@.+)\s+\((.*)\)/) {
+	$fromnamemeta=$2;
+	$fromaddrmeta=$1;
+    } 
+    if (!defined($fromaddrmeta)) {
+	$fromaddrmeta=$frommeta;
+    }
+    $fromaddrmeta=~s/<//; $fromaddrmeta=~s/>//;
+    # minor attempt to prevent spam-bots from harvesting addresses...
+    $fromaddrmeta=~s/@/&#64;/;
+
+    $doc_obj->add_utf8_metadata ($cursection, "FromAddr", $fromaddrmeta);
+
+    if (defined($fromnamemeta) && $fromnamemeta) { # must be > 0 long
+	$fromnamemeta =~ s/\"//g;  # remove quotes
+	$fromnamemeta =~ s/\s+$//; # remove trailing whitespace
+    }
+    else {
+	$fromnamemeta = $fromaddrmeta;
+    }
+    # if name is an address
+    $fromnamemeta =~ s/<//g; $fromnamemeta =~ s/>//g;
+    $fromnamemeta=~s/@/&#64\;/;
+    $doc_obj->add_utf8_metadata ($cursection, "FromName", $fromnamemeta);
+
+    $raw{"From"}=$frommeta;
+
+    # Process Date information
+    if ($raw{"Date"} !~ /No Date/) {
+	$raw{"DateText"} = $raw{"Date"};
+	
+	# Convert the date text to internal date format
+	$value = $raw{"Date"};
+	# proper mbox format: Tue, 07 Jan 2003 17:27:42 +1300
+	my ($day, $month, $year) = $value =~ /(\d?\d)\s([A-Z][a-z][a-z])\s(\d\d\d?\d?)/;
+	if (!defined($day) || !defined($month) || !defined ($year)) {
+	    # try monthly archive format: Wed Apr 23 00:26:08 2008
+	    ($month,$day, $year) = $value =~ /([A-Z][a-z][a-z])\s\s?(\d?\d)\s\d\d:\d\d:\d\d\s(\d\d\d\d)/;
+	}
+
+	# make some assumptions about the year formatting...
+	# some (old) software thinks 2001 is 101, some think 2001 is 01
+	if ($year < 20) { $year += 2000; } # assume not really 1920...
+	elsif ($year < 150) { $year += 1900; } # assume not really 2150...
+	$raw{"Date"} = &sorttools::format_date($day, $month, $year);
+	
+    } else {
+	# We have not extracted a date
+	$raw{"DateText"} = "Unknown.";
+	$raw{"Date"} = "19000000";
+    }
+
+    # Add extracted metadata to document object
+    foreach my $name (keys %raw) {
+	$value = $raw{$name};
+	if ($value) {
+	    # assume subject, etc headers have no special HTML meaning.
+	    $value = &text_into_html($value);
+	    # escape [] so it isn't re-interpreted as metadata
+	    $value =~ s/\[/&#91;/g; $value =~ s/\]/&#93;/g;
+	} else {
+	    $value = "No $name field";
+	}
+	$doc_obj->add_utf8_metadata ($cursection, $name, $value);
+    }
+
+
+    # extract a message ID from the headers, if there is one, and we'll use
+    # that as the greenstone doc ID. Having a predictable ID means we can
+    # link to other messages, eg from In-Reply-To or References headers...
+    if ($Headers =~ m@^Message-ID:(.+)$@mi) {
+	my $id=escape_msg_id($1);
+	$doc_obj->{'msgid'}=$id;
+    }
+    # link to another message, if this is a reply
+    if ($Headers =~ m@^In-Reply-To:(.+)$@mi) {
+	my $id=escape_msg_id($1);
+	$doc_obj->add_utf8_metadata ($cursection, 'InReplyTo', $id);
+    } elsif ($Headers =~ m@^References:.*\s([^\s]+)$@mi) {
+	# References can have multiple, get the last one
+	my $id=escape_msg_id($1);
+	# not necessarily in-reply-to, but same thread...
+	$doc_obj->add_utf8_metadata ($cursection, 'InReplyTo', $id);
+    }
+
+
+
+    my $mimetype="text/plain";
+    my $mimeinfo="";
+    my $charset = $default_header_encoding;
+    # Do MIME and encoding stuff. Allow \s in mimeinfo in case there is
+    # more than one parameter given to Content-type.
+    # eg: Content-type: text/plain; charset="us-ascii"; format="flowed"
+    if ($Headers =~ m@^content\-type:\s*([\w\.\-/]+)\s*(\;\s*.+)?\s*$@mi)
+	{
+	    $mimetype=$1;
+	    $mimetype =~ tr/[A-Z]/[a-z]/;
+
+	    if ($mimetype eq "text") { # for pre-RFC2045 messages (c. 1996)
+		$mimetype = "text/plain";
+	    }
+
+	    $mimeinfo=$2;
+	    if (!defined $mimeinfo) {
+		$mimeinfo="";
+	    } else { # strip leading and trailing stuff
+		$mimeinfo =~ s/^\;\s*//;
+		$mimeinfo =~ s/\s*$//;
+	    }
+	    if ($mimeinfo =~ /charset=\"([^\"]+)\"/i) {
+	      $charset = $1;
+	    }
+	}
+
+    my $transfer_encoding="7bit";
+    if ($Headers =~ /^content-transfer-encoding:\s*([^\s]+)\s*$/mi) {
+	$transfer_encoding=$1;
+    }
+
+    if ($mimetype eq "text/html") {
+	$$textref= $self->text_from_part($$textref, $Headers);
+    } elsif ($mimetype ne "text/plain") {
+	$self->{'doc_obj'} = $doc_obj; # in case we need to associate files...
+	$$textref=$self->text_from_mime_message($mimetype,$mimeinfo,$$textref);
+    } else { # mimetype eq text/plain
+
+	if ($transfer_encoding =~ /quoted\-printable/) {
+	    $$textref=qp_decode($$textref);
+	} elsif ($transfer_encoding =~ /base64/) {
+	    $$textref=base64_decode($$textref);
+	}
+	$self->convert2unicode($charset, $textref);
+
+	$$textref = &text_into_html($$textref);
+	$$textref =~ s@_@\\_@g; # protect against GS macro language
+
+    }
+
+    
+    if ($self->{'headers'} && $self->{'headers'} == 1) {
+	# Add "All headers" metadata
+	$Headers = &text_into_html($Headers);
+
+	$Headers = "No headers" unless ($Headers =~ /\w/);
+	$Headers =~ s/@/&#64\;/g;
+	# escape [] so it isn't re-interpreted as metadata
+	$Headers =~ s/\[/&#91;/g; $Headers =~ s/\]/&#93;/g;
+	$self->convert2unicode($charset, \$Headers);
+
+	$Headers =~ s@_@\\_@g; # protect against GS macro language
+	$doc_obj->add_utf8_metadata ($cursection, "Headers", $Headers);
+    }
+
+
+    # Add Title metadata
+    my $Title = text_into_html($raw{'Subject'});
+    $Title .= "<br>From: " . text_into_html($fromnamemeta);
+    $Title .= "<br>Date: " . text_into_html($raw{'DateText'});
+    $Title =~ s/\[/&#91;/g; $Title =~ s/\]/&#93;/g;
+
+    $doc_obj->add_utf8_metadata ($cursection, "Title", $Title);
+	
+    # Add FileFormat metadata
+    $doc_obj->add_metadata($cursection, "FileFormat", "EMAIL");
+
+    # Add text to document object
+    $$textref = "No message" unless ($$textref =~ /\w/);
+
+    $doc_obj->add_utf8_text($cursection, $$textref);
+
+    return 1;
+}
+
+
+# Convert a text string into HTML.
+#
+# The HTML is going to be inserted into a GML file, so 
+# we have to be careful not to use symbols like ">",
+# which ocurs frequently in email messages (and use
+# &gt instead.
+#
+# This function also turns links and email addresses into hyperlinks,
+# and replaces carriage returns with <BR> tags (and multiple carriage
+# returns with <P> tags).
+
+
+sub text_into_html {
+    my ($text) = @_;
+
+    # Convert problem characters into HTML symbols
+    $text =~ s/&/&amp;/g;
+    $text =~ s/</&lt;/g;
+    $text =~ s/>/&gt;/g;
+    $text =~ s/\"/&quot;/g;
+
+    # convert email addresses and URIs into links
+# don't markup email addresses for now
+#    $text =~ s/([\w\d\.\-]+@[\w\d\.\-]+)/<a href=\"mailto:$1\">$1<\/a>/g;
+
+    # try to munge email addresses a little bit...
+    $text =~ s/@/&#64;/;
+    # assume hostnames are \.\w\- only, then might have a trailing '/.*'
+    # assume URI doesn't finish with a '.'
+    $text =~ s@((http|ftp|https)://[\w\-]+(\.[\w\-]+)*/?((&amp;|\.|\%[a-f0-9]{2})?[\w\?\=\-_/~]+)*(\#[\w\.\-_]*)?)@<a href=\"$1\">$1<\/a>@gi;
+
+
+    # Clean up whitespace and convert \n charaters to <BR> or <P>
+    $text =~ s/ +/ /g;
+    $text =~ s/\s*$//g; 
+    $text =~ s/^\s*//g;
+    $text =~ s/\n/\n<br>/g;
+    $text =~ s/<br>\s*<br>/<p>/gi;
+
+    return $text;
+}
+
+
+
+
+#Process a MIME message.
+# the textref we are given DOES NOT include the header.
+sub text_from_mime_message {
+    my $self = shift(@_);
+    my ($mimetype,$mimeinfo,$text)=(@_);
+    my $outhandle=$self->{'outhandle'};
+    # Check for multiparts - $mimeinfo will be a boundary
+    if ($mimetype =~ /multipart/) {
+	my $boundary="";
+	if ($mimeinfo =~ m@boundary=(\"[^\"]+\"|[^\s]+)\s*$@im) {
+	    $boundary=$1;
+	    if ($boundary =~ m@^\"@) {
+		$boundary =~ s@^\"@@; $boundary =~ s@\"$@@;
+	    }
+	} else {
+	    print $outhandle "EMAILPlug: (warning) couldn't parse MIME boundary\n";
+	}
+	# parts start with "--$boundary"
+	# message ends with "--$boundary--"
+	# RFC says boundary is <70 chars, [A-Za-z'()+_,-./:=?], so escape any
+	# that perl might want to interpolate. Also allows spaces...
+	$boundary=~s/\\/\\\\/g;
+	$boundary=~s/([\?\+\.\(\)\:\/\'])/\\$1/g;
+	my @message_parts = split("\r?\n\-\-$boundary", "\n$text");
+	# remove first "part" and last "part" (final --)
+	shift @message_parts;
+	my $last=pop @message_parts;
+	# if our boundaries are a bit dodgy and we only found 1 part...
+	if (!defined($last)) {$last="";}
+	# make sure it is only -- and whitespace
+	if ($last !~ /^\-\-\s*$/ms) {
+	    print $outhandle "EMAILPlug: (warning) last part of MIME message isn't empty\n";
+	}
+	foreach my $message_part (@message_parts) {
+	    # remove the leading newline left from split.
+	    $message_part=~s/^\r?\n//;
+	}
+	if ($mimetype eq "multipart/alternative") {
+	    # check for an HTML version first, then TEXT, otherwise use first.
+	    my $part_text="";
+	    foreach my $message_part (@message_parts) {
+		if ($message_part =~ m@^content\-type:\s*text/html@i)
+		{
+		    # Use the HTML version
+		    $part_text = $self->text_from_part($message_part);
+		    $mimetype="text/html";
+		    last;
+		}
+	    }
+	    if ($part_text eq "") { # try getting a text part instead
+		foreach my $message_part (@message_parts) {
+		    if ($message_part =~ m@^content\-type:\s*text/plain@i)
+		    {
+			# Use the plain version
+			$part_text = $self->text_from_part($message_part);
+			if ($part_text =~/[^\s]/) {
+			    $part_text = text_into_html($part_text);
+			}
+			$mimetype="text/plain";
+			last;
+		    }
+		}
+	    }
+	    if ($part_text eq "") { #use first part (no html/text part found)
+		$part_text = $self->text_from_part(shift @message_parts);
+		$part_text = text_into_html($part_text);
+	    }
+	    if ($part_text eq "") { # we couldn't get anything!!!
+		# or it was an empty message...
+		# do nothing...
+		gsprintf($outhandle, "{BasPlug.empty_file} - empty body?\n");
+	    } else {
+		$text = $part_text;
+	    }
+	} elsif ($mimetype =~ m@multipart/(mixed|digest|related|signed)@) {
+	    $text = "";
+	    # signed is for PGP/GPG messages... the last part is a hash
+	    if ($mimetype =~ m@multipart/signed@) {
+		pop @message_parts;
+	    }
+	    my $is_first_part=1;
+	    foreach my $message_part (@message_parts) {
+		if ($is_first_part && $text ne "") {$is_first_part=0;}
+
+		if ($mimetype eq "multipart/digest") {
+		    # default type - RTFRFC!! Set if not already set
+		    $message_part =~ m@^(.*)\n\r?\n@s;
+		    my $part_header=$1;
+		    if ($part_header !~ m@^content-type@mi) {
+			$message_part="Content-type: message/rfc822\n"
+			    . $message_part; # prepend default type
+		    }
+		}
+
+		$text .= $self->process_multipart_part($message_part,
+						       $is_first_part);
+	    } # foreach message part.
+	} else {
+	    # we can't handle this multipart type (not mixed or alternative)
+	    # the RFC also mentions "parallel".
+	}
+    } # end of ($mimetype =~ multipart)
+    elsif ($mimetype =~ m@message/rfc822@) {
+	my $msg_header = $text;
+	$msg_header =~ s/\r?\n\r?\n(.*)$//s;
+	$text = $1;
+
+	if ($msg_header =~ /^content\-type:\s*([\w\.\-\/]+)\s*\;?\s*(.+?)\s*$/mi)
+	{
+	    $mimetype=$1;
+	    $mimeinfo=$2;
+	    $mimetype =~ tr/[A-Z]/[a-z]/;
+
+	    my $msg_text;
+	    if ($mimetype =~ m@multipart/@) {
+		$msg_text = text_from_mime_message($self, $mimetype, $mimeinfo,
+						   $text);
+	    } else {
+		$msg_text=$self->text_from_part($text,$msg_header);
+	    }
+
+	    my $brief_header=text_into_html(get_brief_headers($msg_header));
+	    $text= "\n<b>&lt;&lt;attached message&gt;&gt;</b><br>";
+	    $text.= "<table><tr><td width=\"5%\"> </td>\n";
+	    $text.="<td>" . $brief_header . "\n</p>" . $msg_text 
+		. "</td></tr></table>";
+	}
+    } else {
+	# we don't do any processing of the content.
+    }
+
+    return $text;
+}
+
+
+
+# used for turning a message id into a more friendly string for greenstone
+sub escape_msg_id {
+#msgid
+    my $id=shift;
+    chomp $id; $id =~ s!\s!!g; # remove spaces
+    $id =~ s![<>\[\]]!!g; # remove [ ] < and >
+    $id =~ s![_&]!-!g; # replace symbols that might cause problems
+    $id =~ s!\.!-!g; # . means section to greenstone doc ids!
+    $id =~ s!@!-!g; # replace @ symbol, to avoid spambots
+    return $id;
+}
+
+
+
+sub process_multipart_part {
+    my $self = shift;
+    my $message_part = shift;
+    my $is_first_part = shift;
+
+    my $return_text="";
+    my $part_header=$message_part;
+    my $part_body;
+    if ($message_part=~ /^\s*\n/) {
+	# no header... use defaults
+	$part_body=$message_part;
+	$part_header="Content-type: text/plain; charset=us-ascii";
+    } elsif ($part_header=~s/\r?\n\r?\n(.*)$//s) {
+	$part_body=$1;
+    } else {
+	# something's gone wrong...
+	$part_header="";
+	$part_body=$message_part;
+    }
+    
+    $part_header =~ s/\r?\n[\t\ ]+/ /gs; #unfold
+    my $part_content_type="";
+    my $part_content_info="";
+
+    if ($part_header =~ m@^content\-type:\s*([\w\.\-/]+)\s*(\;.*)?$@mi) {
+	$part_content_type=$1; $part_content_type =~ tr/A-Z/a-z/;
+	$part_content_info=$2;
+	if (!defined($part_content_info)) {
+	    $part_content_info="";
+	} else {
+	    $part_content_info =~ s/^\;\s*//;
+	    $part_content_info =~ s/\s*$//;
+	}
+    }
+    my $filename="";
+    if ($part_header =~ m@name=\"?([^\"\n]+)\"?@mis) {
+	$filename=$1;
+	$filename =~ s@\r?\s*$@@; # remove trailing space, if any
+    }
+    
+    # disposition - either inline or attachment.
+    # NOT CURRENTLY USED - we display all text types instead...
+    # $part_header =~ /^content\-disposition:\s*([\w+])/mis;
+    
+    # add <<attachment>> to each part except the first...
+    if (!$is_first_part) {
+	$return_text.="\n<p><hr><strong>&lt;&lt;attachment&gt;&gt;";
+	# add part info header
+	my $header_text = "<br>Type: $part_content_type<br>\n";
+	if ($filename ne "") {
+	    $header_text .= "Filename: $filename\n";
+	}
+	$header_text =~ s@_@\\_@g;
+	$return_text .= $header_text . "</strong></p>\n<p>\n";
+    }
+
+    if ($part_content_type =~ m@text/@)
+    {
+	# $message_part includes the mime part headers
+	my $part_text = $self->text_from_part($message_part);
+	if ($part_content_type !~ m@text/(ht|x)ml@) {
+	    $part_text = text_into_html($part_text);
+	}
+	if ($part_text eq "") {
+	    $part_text = ' ';
+	}
+	$return_text .= $part_text;
+    } elsif ($part_content_type =~ m@message/rfc822@) {
+	# This is a forwarded message
+	my $message_part_headers=$part_body;
+	$message_part_headers=~s/\r?\n\r?\n(.*)$//s;
+	my $message_part_body=$1;
+	$message_part_headers =~ s/\r?\n[\t\ ]+/ /gs; #unfold
+	
+	my $rfc822_formatted_body=""; # put result in here
+	if ($message_part_headers =~
+	    /^content\-type:\s*([\w\.\-\/]+)\s*(\;.*)?$/ims)
+	{
+	    # The message header uses MIME flags
+	    my $message_content_type=$1;
+	    my $message_content_info=$2;
+	    if (!defined($message_content_info)) {
+		$message_content_info="";
+	    } else {
+		$message_content_info =~ s/^\;\s*//;
+		$message_content_info =~ s/\s*$//;
+	    }
+	    $message_content_type =~ tr/A-Z/a-z/;
+	    if ($message_content_type =~ /multipart/) {
+		$rfc822_formatted_body=
+		    $self->text_from_mime_message($message_content_type,
+						  $message_content_info,
+						  $message_part_body);
+	    } else {
+		$message_part_body=$self->text_from_part($part_body,
+							$message_part_headers);
+		$rfc822_formatted_body=text_into_html($message_part_body);
+	    }
+	} else {
+	    # message doesn't use MIME flags
+	    $rfc822_formatted_body=text_into_html($message_part_body);
+	    $rfc822_formatted_body =~ s@_@\\_@g;
+	}
+	# Add the returned text to the output
+	# don't put all the headers...
+#	$message_part_headers =~ s/^(X\-.*|received|message\-id|return\-path):.*\n//img;
+	my $brief_headers=get_brief_headers($message_part_headers);
+	$return_text.=text_into_html($brief_headers);
+	$return_text.="</p><p>\n";
+	$return_text.=$rfc822_formatted_body;
+	$return_text.="</p>\n";
+	# end of message/rfc822
+    } elsif ($part_content_type =~ /multipart/) { 
+	# recurse again
+	
+	my $tmptext= $self->text_from_mime_message($part_content_type,
+						   $part_content_info,
+						   $part_body);
+	$return_text.=$tmptext;
+    } else {
+	# this part isn't text/* or another message...
+	if ($is_first_part) {
+	    # this is the first part of a multipart, or only part!
+	    $return_text="\n<p><hr><strong>&lt;&lt;attachment&gt;&gt;";
+	    # add part info header
+	    my $header_text="<br>Type: $part_content_type<br>\n";
+	    $header_text.="Filename: $filename</strong></p>\n<p>\n";
+	    $header_text =~ s@_@\\_@g;
+	    $return_text.=$header_text;
+	}
+	
+	# save attachment by default
+	if (!$self->{'no_attachments'}
+	    && $filename ne "") { # this part has a file...
+	    my $encoding="8bit";
+	    if ($part_header =~
+		/^content-transfer-encoding:\s*(\w+)/mi ) {
+		$encoding=$1; $encoding =~ tr/A-Z/a-z/;
+	    }
+	    my $tmpdir=$ENV{'GSDLHOME'} . "/tmp";
+	    my $save_filename=$filename;
+	    
+	    # make sure we don't clobber files with same name;
+	    # need to keep state between .mbx files
+	    my $assoc_files=$self->{'assoc_filenames'};
+	    if ($assoc_files->{$filename}) { # it's been set...
+		$assoc_files->{$filename}++;
+		$filename =~ m/(.+)\.(\w+)$/;
+		my ($filestem, $ext)=($1,$2);
+		$save_filename="${filestem}_"
+		    . $assoc_files->{$filename} . ".$ext";
+	    } else { # first file with this name
+		$assoc_files->{$filename}=1;
+	    }
+	    open (SAVE, ">$tmpdir/$save_filename") ||
+		warn "EMAILPlug: Can't save attachment as $tmpdir/$save_filename: $!";
+	    my $part_text = $message_part;
+	    $part_text =~ s/(.*?)\r?\n\r?\n//s; # remove header
+	    if ($encoding eq "base64") {
+		print SAVE base64_decode($part_text);
+	    } elsif ($encoding eq "quoted-printable") {
+		print SAVE qp_decode($part_text);
+	    } else { # 7bit, 8bit, binary, etc...
+		print SAVE $part_text;
+	    }
+	    close SAVE;
+	    my $doc_obj=$self->{'doc_obj'};
+	    $doc_obj->associate_file("$tmpdir/$save_filename",
+				     "$save_filename",
+				     $part_content_type # mimetype
+				     );
+	    # clean up tmp area...
+	    # Can't do this as it hasn't been copied/linked yet!!!
+#			&util::rm("$tmpdir/$save_filename");
+	    my $outhandle=$self->{'outhandle'};
+	    print $outhandle "EMAILPlug: saving attachment \"$filename\"\n"; #
+	    
+	    # be nice if "download" was a translatable macro :(
+	    $return_text .="<a href=\"_httpdocimg_/$save_filename\">download</a>";
+	} # end of save attachment
+    } # end of !text/message part
+
+
+    return $return_text;
+}
+
+
+# Return only the "important" headers from a set of message headers
+sub get_brief_headers {
+    my $msg_header = shift;
+    my $brief_header = "";
+
+    # Order matters!
+    if ($msg_header =~ /^(From:.*)$/im) {$brief_header.="$1\n";}
+    if ($msg_header =~ /^(To:.*)$/im) {$brief_header.="$1\n";}
+    if ($msg_header =~ /^(Cc:.*)$/im) {$brief_header.="$1\n";}
+    if ($msg_header =~ /^(Subject:.*)$/im) {$brief_header.="$1\n";}
+    if ($msg_header =~ /^(Date:.*)$/im) {$brief_header.="$1\n";}
+
+    return $brief_header;
+}
+
+
+# Process a MIME part. Return "" if we can't decode it.
+# should only be called for parts with type "text/*" ?
+# Either pass the entire mime part (including the part's header),
+# or pass the mime part's text and optionally the part's header.
+sub text_from_part {
+    my $self = shift;
+    my $text = shift || '';
+    my $part_header = shift;
+
+
+    my $type="text/plain"; # default, overridden from part header
+    my $charset=undef;     # convert2unicode() will guess if necessary
+
+    if (! $part_header) { # no header argument was given. check the body
+	$part_header = $text;
+	# check for empty part header (leading blank line)
+	if ($text =~ /^\s*\r?\n/) {
+	    $part_header="Content-type: text/plain; charset=us-ascii";
+	} else {
+	    $part_header =~ s/\r?\n\r?\n(.*)$//s;
+	    $text=$1; if (!defined($text)) {$text="";}
+	}
+	$part_header =~ s/\r?\n[\t ]+/ /gs; #unfold
+    }
+
+    if ($part_header =~
+	/content\-type:\s*([\w\.\-\/]+).*?charset=\"?([^\;\"\s]+)\"?/is) {
+	$type=$1;
+	$charset=$2;
+    }
+    my $encoding="";
+    if ($part_header =~ /^content\-transfer\-encoding:\s*([^\s]+)/mis) {
+	$encoding=$1; $encoding=~tr/A-Z/a-z/;
+    }
+    # Content-Transfer-Encoding is per-part
+    if ($encoding ne "") {
+	if ($encoding =~ /quoted\-printable/) {
+	    $text=qp_decode($text);
+	} elsif ($encoding =~ /base64/) {
+	    $text=base64_decode($text);
+	} elsif ($encoding !~ /[78]bit/) { # leave 7/8 bit as is.
+	    # rfc2045 also allows binary, which we ignore (for now).
+	    my $outhandle=$self->{'outhandle'};
+	    print $outhandle "EMAILPlug: unknown transfer encoding: $encoding\n";
+	    return "";
+	}
+    }
+
+    if ($type eq "text/html") {
+	# only get stuff between <body> tags, or <html> tags.
+	$text =~ s@^.*<html[^>]*>@@is;
+	$text =~ s@</html>.*$@@is;
+	$text =~ s/^.*?<body[^>]*>//si;
+	$text =~ s/<\/body>.*$//si;
+    }
+    elsif ($type eq "text/xml") {
+	$text=~s/</&lt;/g;$text=~s/>/&gt;/g;
+	$text="<pre>\n$text\n</pre>\n";
+    }
+    # convert to unicode
+    $self->convert2unicode($charset, \$text);
+    $text =~ s@_@\\_@g; # protect against GS macro language
+    return $text;
+}
+
+
+
+
+# decode quoted-printable text
+sub qp_decode {
+    my $text=shift;
+
+    # if a line ends with "=\s*", it is a soft line break, otherwise
+    # keep in any newline characters.
+
+    $text =~ s/=\s*\r?\n//mg;
+    $text =~ s/=([0-9A-Fa-f]{2})/chr (hex "0x$1")/eg;
+    return $text;
+}
+
+# decode base64 text. This is fairly slow (since it's interpreted perl rather
+# than compiled XS stuff like in the ::MIME modules, but this is more portable
+# for us at least).
+# see rfc2045 for description, but basically, bits 7 and 8 are set to zero;
+# 4 bytes of encoded text become 3 bytes of binary - remove 2 highest bits
+# from each encoded byte.
+
+
+sub base64_decode {
+    my $enc_text = shift;
+# A=>0, B=>1, ..., '+'=>62, '/'=>63
+# also '=' is used for padding at the end, but we remove it anyway.
+    my $mimechars="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
+# map each MIME char into it's value, for more efficient lookup.
+    my %index;
+    map { $index{$_} = index ($mimechars, $_) } (split ('', $mimechars));
+# remove all non-base64 chars. eval to get variable in transliteration...
+# also remove '=' - we'll assume (!!) that there are no errors in the encoding
+    eval "\$enc_text =~ tr|$mimechars||cd";
+    my $decoded="";
+    while (length ($enc_text)>3)
+    { 
+	my $fourchars=substr($enc_text,0,4,"");
+	my @chars=(split '',$fourchars);
+	$decoded.=chr( $index{$chars[0]}        << 2 | $index{$chars[1]} >> 4);
+	$decoded.=chr( ($index{$chars[1]} & 15) << 4 | $index{$chars[2]} >> 2);
+	$decoded.=chr( ($index{$chars[2]} & 3 ) << 6 |  $index{$chars[3]});
+    } 
+# if there are any input chars left, there are either
+# 2 encoded bytes (-> 1 raw byte) left or 3 encoded (-> 2 raw) bytes left.
+    my @chars=(split '',$enc_text);
+    if (length($enc_text)) {
+	$decoded.=chr($index{$chars[0]} << 2 | (int $index{$chars[1]} >> 4));
+    } 
+    if (length($enc_text)==3) {
+	$decoded.=chr( ($index{$chars[1]} & 15) << 4 | $index{$chars[2]} >> 2);
+    }
+    return $decoded;
+}
+
+# returns 0 if valid utf-8, 1 if invalid
+sub is_utf8 {
+    my $self = shift;
+    my $textref = shift;
+
+    $$textref =~ m/^/g; # to set \G
+    my $badbytesfound=0;
+    while ($$textref =~ m!\G.*?([\x80-\xff]+)!sg) {
+	my $highbytes=$1;
+	my $highbyteslength=length($highbytes);
+	# replace any non utf8 complaint bytes
+	$highbytes =~ /^/g; # set pos()
+	while ($highbytes =~
+	       m!\G (?: [\xc0-\xdf][\x80-\xbf] | # 2 byte utf-8
+		     [\xe0-\xef][\x80-\xbf]{2} | # 3 byte
+		     [\xf0-\xf7][\x80-\xbf]{3} | # 4 byte
+		     [\xf8-\xfb][\x80-\xbf]{4} | # 5 byte
+		     [\xfc-\xfd][\x80-\xbf]{5}   # 6 byte
+		     )*([\x80-\xff])? !xg
+	       ) {
+	    my $badbyte=$1;
+	    if (!defined $badbyte) {next} # hit end of string
+	    return 1;
+	}
+    }
+    return 0;
+}
+
+
+
+sub convert2unicode {
+  my $self = shift(@_);
+  my ($charset, $textref) = @_;
+
+  if (!$$textref) {
+      # nothing to do!
+      return;
+  }
+
+  if (! defined $charset) {
+      # check if we have valid utf-8
+      if ($self->is_utf8($textref)) { $charset = "utf8" }
+
+      # default to latin
+      $charset = "iso_8859_1" if ! defined($charset);
+  }
+
+  # first get our character encoding name in the right form.
+  $charset =~ tr/A-Z/a-z/; # lowercase
+  $charset =~ s/\-/_/g;
+  if ($charset =~ /gb_?2312/) { $charset="gb" }
+  # assumes EUC-KR, not ISO-2022 !?
+  $charset =~ s/^ks_c_5601_1987/korean/;
+  if ($charset eq 'utf_8') {$charset='utf8'}
+
+  my $outhandle = $self->{'outhandle'};
+
+  if ($charset eq "utf8") {
+      # no conversion needed, but lets check that it's valid utf8
+      # see utf-8 manpage for valid ranges
+      $$textref =~ m/^/g; # to set \G
+      my $badbytesfound=0;
+      while ($$textref =~ m!\G.*?([\x80-\xff]+)!sg) {
+	  my $highbytes=$1;
+	  my $highbyteslength=length($highbytes);
+	  # replace any non utf8 complaint bytes
+	  $highbytes =~ /^/g; # set pos()
+	  while ($highbytes =~
+		 m!\G (?: [\xc0-\xdf][\x80-\xbf] | # 2 byte utf-8
+		       [\xe0-\xef][\x80-\xbf]{2} | # 3 byte
+		       [\xf0-\xf7][\x80-\xbf]{3} | # 4 byte
+		       [\xf8-\xfb][\x80-\xbf]{4} | # 5 byte
+		       [\xfc-\xfd][\x80-\xbf]{5}   # 6 byte
+		       )*([\x80-\xff])? !xg
+		 ) {
+	      my $badbyte=$1;
+	      if (!defined $badbyte) {next} # hit end of string
+	      my $pos=pos($highbytes);
+	      substr($highbytes, $pos-1, 1, "\xc2\x80");
+	      # update the position to continue searching (for \G)
+	      pos($highbytes) = $pos+1; # set to just after the \x80
+	      $badbytesfound=1;
+	  }
+	  if ($badbytesfound==1) {
+	      # claims to be utf8, but it isn't!
+	      print $outhandle "EMAILPlug: Headers claim utf-8 but bad bytes "
+		  . "detected and removed.\n";
+
+	      my $replength=length($highbytes);
+	      my $textpos=pos($$textref);
+	      # replace bad bytes with good bytes
+	      substr( $$textref, $textpos-$replength,
+		      $replength, $highbytes);
+	      # update the position to continue searching (for \G)
+	      pos($$textref)=$textpos+($replength-$highbyteslength);
+	  }
+      }
+      return;
+  }
+
+  # It appears that we can't always trust ascii text so we'll treat it
+  # as iso-8859-1 (letting characters above 0x80 through without
+  # converting them to utf-8 will result in invalid XML documents
+  # which can't be parsed at build time).
+  $charset = "iso_8859_1" if ($charset eq "us_ascii" || $charset eq "ascii");
+
+  if ($charset eq "iso_8859_1") {
+      # test if the mailer lied, and it has win1252 chars in it...
+      # 1252 has characters between 0x80 and 0x9f, 8859-1 doesn't
+      if ($$textref =~ m/[\x80-\x9f]/) {
+	  print $outhandle "EMAILPlug: Headers claim ISO charset but MS ";
+	  print $outhandle "codepage 1252 detected.\n";
+	  $charset = "windows_1252";
+      }
+  }
+  my $utf8_text=&unicode::unicode2utf8(&unicode::convert2unicode($charset,$textref));
+
+  if ($utf8_text ne "") {
+      $$textref=$utf8_text;
+  } else {
+      # we didn't get any text... unsupported encoding perhaps? Or it is
+      # empty anyway. We'll try to continue, assuming 8859-1. We could strip
+      # characters out here if this causes problems...
+      my $outhandle=$self->{'outhandle'};
+      print $outhandle "EMAILPlug: falling back to iso-8859-1\n";
+      $$textref=&unicode::unicode2utf8(&unicode::convert2unicode("iso_8859_1",$textref));
+
+  }
+}
+
+
+sub set_OID {
+    my $self = shift (@_);
+    my ($doc_obj, $id, $segment_number) = @_;
+    
+    if ( exists $doc_obj->{'msgid'} ) {
+	$doc_obj->set_OID($doc_obj->{'msgid'});
+    } else {
+	$doc_obj->set_OID("$id\_$segment_number");
+    }
+}
+
+
+# Perl packages have to return true if they are run.
+1;
Index: dl/trunk/perllib/plugins/ExcelPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ExcelPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,116 +1,0 @@
-###########################################################################
-#
-# ExcelPlug.pm -- plugin for importing Microsoft Excel files.
-#  (currently only versions 95 and 97)
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 2002 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 ExcelPlug;
-
-use ConvertToPlug;
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @ExcelPlug::ISA = ('ConvertToPlug');
-}
-
-my $arguments = 
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_process_exp() }
-      ];
-
-my $options = { 'name'     => "ExcelPlug",
-		'desc'     => "{ExcelPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'srcreplaceable' => "yes", # Source docs in Excel format can be replaced with GS-generated html
-		'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-    
-    my $self = new ConvertToPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    if ($self->{'info_only'}) {
-	# don't worry about any options etc
-	return bless $self, $class;
-    }
-
-    my $secondary_plugin_options = $self->{'secondary_plugin_options'};
-    if (!defined $secondary_plugin_options->{'HTMLPlug'}) {
-	$secondary_plugin_options->{'HTMLPlug'} = [];
-    }
-    my $html_options = $secondary_plugin_options->{'HTMLPlug'};
-    
-    #$self->{'input_encoding'} = "utf8";
-    #$self->{'extract_language'} = 1;
-    push(@$html_options, "-input_encoding", "utf8");
-    push(@$html_options,"-extract_language") if $self->{'extract_language'};
-    $self = bless $self, $class;
-    
-    $self->load_secondary_plugins($class,$secondary_plugin_options,$hashArgOptLists);
-    return bless $self;    
-}
-
-sub convert_post_process
-{
-    my $self = shift (@_);
-    my ($conv_filename) = @_;
-    
-    my $outhandle=$self->{'outhandle'};
-    
-    my ($language, $encoding) = $self->textcat_get_language_encoding ($conv_filename);
-    
-    # read in file ($text will be in utf8)
-    my $text = "";
-    $self->read_file ($conv_filename, $encoding, $language, \$text);
-    
-    # turn any high bytes that aren't valid utf-8 into utf-8.
-    #unicode::ensure_utf8(\$text);
-    
-    # Write it out again!
-    #$self->utf8_write_file (\$text, $conv_filename);
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-    return q^(?i)\.xls$^;
-}
-    
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-
-    return $self->process_type("xls",$base_dir,$file,$doc_obj);
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/ExcelPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ExcelPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/ExcelPlugin.pm	(revision 15865)
@@ -0,0 +1,116 @@
+###########################################################################
+#
+# ExcelPlug.pm -- plugin for importing Microsoft Excel files.
+#  (currently only versions 95 and 97)
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 2002 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 ExcelPlug;
+
+use ConvertToPlug;
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @ExcelPlug::ISA = ('ConvertToPlug');
+}
+
+my $arguments = 
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_process_exp() }
+      ];
+
+my $options = { 'name'     => "ExcelPlug",
+		'desc'     => "{ExcelPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'srcreplaceable' => "yes", # Source docs in Excel format can be replaced with GS-generated html
+		'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+    
+    my $self = new ConvertToPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    if ($self->{'info_only'}) {
+	# don't worry about any options etc
+	return bless $self, $class;
+    }
+
+    my $secondary_plugin_options = $self->{'secondary_plugin_options'};
+    if (!defined $secondary_plugin_options->{'HTMLPlug'}) {
+	$secondary_plugin_options->{'HTMLPlug'} = [];
+    }
+    my $html_options = $secondary_plugin_options->{'HTMLPlug'};
+    
+    #$self->{'input_encoding'} = "utf8";
+    #$self->{'extract_language'} = 1;
+    push(@$html_options, "-input_encoding", "utf8");
+    push(@$html_options,"-extract_language") if $self->{'extract_language'};
+    $self = bless $self, $class;
+    
+    $self->load_secondary_plugins($class,$secondary_plugin_options,$hashArgOptLists);
+    return bless $self;    
+}
+
+sub convert_post_process
+{
+    my $self = shift (@_);
+    my ($conv_filename) = @_;
+    
+    my $outhandle=$self->{'outhandle'};
+    
+    my ($language, $encoding) = $self->textcat_get_language_encoding ($conv_filename);
+    
+    # read in file ($text will be in utf8)
+    my $text = "";
+    $self->read_file ($conv_filename, $encoding, $language, \$text);
+    
+    # turn any high bytes that aren't valid utf-8 into utf-8.
+    #unicode::ensure_utf8(\$text);
+    
+    # Write it out again!
+    #$self->utf8_write_file (\$text, $conv_filename);
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+    return q^(?i)\.xls$^;
+}
+    
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+
+    return $self->process_type("xls",$base_dir,$file,$doc_obj);
+}
+
+1;
Index: dl/trunk/perllib/plugins/FOXPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/FOXPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,307 +1,0 @@
-###########################################################################
-#
-# FOXPlug.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) 1999 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.
-#
-###########################################################################
-
-# plugin to process a Foxbase dbt file. This plugin provides the basic
-# functionality to read in the dbt and dbf files and process each record.
-# This general plugin should be overridden for a particular database to process
-# the appropriate fields in the file.
-
-# 12/05/02 Added usage datastructure - John Thompson
-
-package FOXPlug;
-
-use BasPlug;
-use util;
-use doc;
-use unicode;
-use cnseg;
-# use gb;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-
-sub BEGIN {
-    @FOXPlug::ISA = ('BasPlug');
-}
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_process_exp() },
-      { 'name' => "block_exp",
-	'desc' => "{BasPlug.block_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_block_exp() } ];
-
-my $options = { 'name'     => "FOXPlug",
-		'desc'     => "{FOXPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)\.dbf$^;
-}
-
-#dbt files are processed at the same time as dbf files
-sub get_default_block_exp {
-    my $self = shift (@_);
-
-    return q^(?i)\.dbt$^;
-}
-
-# return number of files processed, undef if can't process
-# Note that $base_dir might be "" and that $file might 
-# include directories
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
- 
-    #check for associate_ext, blocking etc, are we processing this file?
-    my ($block_status,$fullname) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-
-    print STDERR "<Processing n='$file' p='FOXPlug'>\n" if ($gli);
-    print STDERR "FOXPlug: processing $file\n" if $self->{'verbosity'} > 1;
-
-    my ($parent_dir) = $fullname =~ /^(.*)\/[^\/]+\.dbf$/i;
-
-    # open the file
-    if (!open (FOXBASEIN, $fullname)) {
-	if ($gli) {
-	    print STDERR "<ProcessingError n='$file' r='Could not read $fullname'>\n";
-	}
-	print STDERR "FOXPlug::read - couldn't read $fullname\n";
-	return -1; # error in processing
-    }
-
-    # read in the database header
-    my ($temp, %dbf);
-    
-    # read in information about dbt file
-    if (read (FOXBASEIN, $temp, 32) < 32) {
-	if ($gli) {
-	    print STDERR "<ProcessingError n='$file' r='EOF while reading database header'>\n";
-	}
-	print STDERR "FOXPlug::read - eof while reading database header\n";
-	close (FOXBASEIN);
-	return -1;
-    }
-    
-    # unpack the header
-    ($dbf{'hasdbt'},
-     $dbf{'modyear'}, $dbf{'modmonth'}, $dbf{'modday'},
-     $dbf{'numrecords'}, $dbf{'headerlen'}, 
-     $dbf{'recordlen'}) = unpack ("CCCCVvv", $temp);
-    
-    # process hasdbt
-    if ($dbf{'hasdbt'} == 131) {
-	$dbf{'hasdbt'} = 1;
-    } elsif ($dbf{'hasdbt'} == 3 || $dbf{'hasdbt'} == 48) {
-	$dbf{'hasdbt'} = 0;
-    } else {
-	if ($gli) {
-	    print STDERR "<ProcessingError n='$file' r='Does not seem to be a Foxbase file'>\n";
-	}
-	print STDERR "FOXPlug:read - $fullname doesn't seem to be a Foxbase file\n";
-	return -1;
-    }
-
-    # read in the field description
-    $dbf{'numfields'} = 0;
-    $dbf{'fieldinfo'} = [];
-    while (read (FOXBASEIN, $temp, 1) > 0) {
-	last if ($temp eq "\x0d");
-	last if (read (FOXBASEIN, $temp, 31, 1) < 31);
-
-	my %field = ();
-	$field{'name'} = $self->extracttext($temp, 11);
-	($field{'type'}, $field{'pos'}, $field{'len'}, $field{'dp'}) 
-	    = unpack ("x11a1VCC", $temp);
-
-	push (@{$dbf{'fieldinfo'}}, \%field);
-
-	$dbf{'numfields'} ++;
-    }
-
-    # open the dbt file if we need to
-    my $dbtfullname = $fullname;
-    if ($fullname =~ /f$/) {
-	$dbtfullname =~ s/f$/t/;
-    } else {
-	$dbtfullname =~ s/F$/T/;
-    }
-    if ($dbf{'hasdbt'} && !open (DBTIN, $dbtfullname)) {
-	if ($gli) {
-	    print STDERR "<ProcessingError n='$file' r='Could not read $dbtfullname'>\n";
-	}
-	print STDERR "FOXPlug::read - couldn't read $dbtfullname\n";
-	close (FOXBASEIN);
-	return -1;
-    }
-
-    # read in and process each record in the database
-    my $numrecords = 0;
-    while (($numrecords < $dbf{'numrecords'}) && 
-	   (read (FOXBASEIN, $temp, $dbf{'recordlen'}) == $dbf{'recordlen'})) {
-
-	# create a new record
-	my $record = [];
-	
-	foreach my $field (@{$dbf{'fieldinfo'}}) {
-	    my $fieldvalue = "";
-	    
-	    if ($field->{'type'} eq "M" && $dbf{'hasdbt'}) {
-		# a memo field, look up this field in the dbt file
-		my $seekpos = substr ($temp, $field->{'pos'}, $field->{'len'});
-
-		$seekpos =~ s/^\s*//;
-		$seekpos = 0 unless $seekpos =~ /^\d+$/;
-		
-		$seekpos = $seekpos * 512;
-
-		if ($seekpos == 0) {
-		    # there is no memo field
-
-		} elsif (seek (DBTIN, $seekpos, 0)) {
-		    while (read (DBTIN, $fieldvalue, 512, length($fieldvalue)) > 0) {
-			last if ($fieldvalue =~ /\cZ/);
-		    }
-
-		    # remove everything after the control-Z
-		    substr($fieldvalue, index($fieldvalue, "\cZ")) = "";
-
-		} else {
-		    print STDERR "\nERROR - seek (to $seekpos) failed\n";
-		}
-
-	    } else {
-		# a normal field
-		$fieldvalue = substr ($temp, $field->{'pos'}, $field->{'len'});
-	    }
-
-	    push (@$record, {%$field, 'value'=>$fieldvalue});
-	}
-
-	# process this record
-	$self->process_record ($pluginfo, $base_dir, $file, $metadata, $processor, 
-			       $numrecords, $record);
-	
-	# finished another record...
-	$numrecords++;
-    }
-
-    # close the dbt file if we need to
-    if ($dbf{'hasdbt'}) {
-	close (DBTIN);
-    }
-
-    # close the dbf file
-    close (FOXBASEIN);
-
-    # finished processing
-    return 1;
-}
-
-
-# will extract a string from some larger string, making it
-# conform to a number of constraints
-sub extracttext {
-    my $self = shift (@_);
-    my ($text, $maxlen, $offset, $stopstr) = @_;
-    $offset = 0 unless defined $offset;
-    $stopstr = "\x00" unless defined $stopstr;
-    
-    # decide where the string finishes
-    my $end = index ($text, $stopstr, $offset);
-    $end = length ($text) if $end < 0;
-    $end = $offset+$maxlen if (defined $maxlen) && ($end-$offset > $maxlen);
-    
-    return "" if ($end <= $offset);
-    return substr ($text, $offset, $end-$offset);
-}
-
-
-# process_record should be overriden for a particular type
-# of database. This default version outputs an html document
-# containing all the fields in the record as a table.
-# It also assumes that the text is in utf-8.
-sub process_record {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $numrecords, $record) = @_;
-
-    # create a new document
-    my $doc_obj = new doc ($file, "indexed_doc");
-    $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
-    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
-    my $section = $doc_obj->get_top_section();
-
-    $doc_obj->add_metadata($section, "FileFormat", "FOX");
-    $doc_obj->add_metadata($section, "FileSize",   (-s $file));
-
-    # start of document
-    $doc_obj->add_utf8_text($section, "<table>\n");
-
-    # add each field
-    foreach my $field (@$record) {
-	if (defined ($field->{'name'}) && defined ($field->{'value'})) {
-	    $doc_obj->add_utf8_text($section, "  <tr>\n");
-	    $doc_obj->add_utf8_text($section, "    <td>$field->{'name'}</td>\n");
-	    $doc_obj->add_utf8_text($section, "    <td>$field->{'value'}</td>\n");
-	    $doc_obj->add_utf8_text($section, "  </tr>\n");
-	}
-    }
-
-    # end of document
-    $doc_obj->add_utf8_text($section, "</table>\n");
-
-    # add an object id
-    $doc_obj->set_OID();
-
-    # process the document
-    $processor->process($doc_obj);
-}
-
-
-1;
Index: /gsdl/trunk/perllib/plugins/FOXPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/FOXPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/FOXPlugin.pm	(revision 15865)
@@ -0,0 +1,307 @@
+###########################################################################
+#
+# FOXPlug.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) 1999 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.
+#
+###########################################################################
+
+# plugin to process a Foxbase dbt file. This plugin provides the basic
+# functionality to read in the dbt and dbf files and process each record.
+# This general plugin should be overridden for a particular database to process
+# the appropriate fields in the file.
+
+# 12/05/02 Added usage datastructure - John Thompson
+
+package FOXPlug;
+
+use BasPlug;
+use util;
+use doc;
+use unicode;
+use cnseg;
+# use gb;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+
+sub BEGIN {
+    @FOXPlug::ISA = ('BasPlug');
+}
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_process_exp() },
+      { 'name' => "block_exp",
+	'desc' => "{BasPlug.block_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_block_exp() } ];
+
+my $options = { 'name'     => "FOXPlug",
+		'desc'     => "{FOXPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)\.dbf$^;
+}
+
+#dbt files are processed at the same time as dbf files
+sub get_default_block_exp {
+    my $self = shift (@_);
+
+    return q^(?i)\.dbt$^;
+}
+
+# return number of files processed, undef if can't process
+# Note that $base_dir might be "" and that $file might 
+# include directories
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+ 
+    #check for associate_ext, blocking etc, are we processing this file?
+    my ($block_status,$fullname) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+
+    print STDERR "<Processing n='$file' p='FOXPlug'>\n" if ($gli);
+    print STDERR "FOXPlug: processing $file\n" if $self->{'verbosity'} > 1;
+
+    my ($parent_dir) = $fullname =~ /^(.*)\/[^\/]+\.dbf$/i;
+
+    # open the file
+    if (!open (FOXBASEIN, $fullname)) {
+	if ($gli) {
+	    print STDERR "<ProcessingError n='$file' r='Could not read $fullname'>\n";
+	}
+	print STDERR "FOXPlug::read - couldn't read $fullname\n";
+	return -1; # error in processing
+    }
+
+    # read in the database header
+    my ($temp, %dbf);
+    
+    # read in information about dbt file
+    if (read (FOXBASEIN, $temp, 32) < 32) {
+	if ($gli) {
+	    print STDERR "<ProcessingError n='$file' r='EOF while reading database header'>\n";
+	}
+	print STDERR "FOXPlug::read - eof while reading database header\n";
+	close (FOXBASEIN);
+	return -1;
+    }
+    
+    # unpack the header
+    ($dbf{'hasdbt'},
+     $dbf{'modyear'}, $dbf{'modmonth'}, $dbf{'modday'},
+     $dbf{'numrecords'}, $dbf{'headerlen'}, 
+     $dbf{'recordlen'}) = unpack ("CCCCVvv", $temp);
+    
+    # process hasdbt
+    if ($dbf{'hasdbt'} == 131) {
+	$dbf{'hasdbt'} = 1;
+    } elsif ($dbf{'hasdbt'} == 3 || $dbf{'hasdbt'} == 48) {
+	$dbf{'hasdbt'} = 0;
+    } else {
+	if ($gli) {
+	    print STDERR "<ProcessingError n='$file' r='Does not seem to be a Foxbase file'>\n";
+	}
+	print STDERR "FOXPlug:read - $fullname doesn't seem to be a Foxbase file\n";
+	return -1;
+    }
+
+    # read in the field description
+    $dbf{'numfields'} = 0;
+    $dbf{'fieldinfo'} = [];
+    while (read (FOXBASEIN, $temp, 1) > 0) {
+	last if ($temp eq "\x0d");
+	last if (read (FOXBASEIN, $temp, 31, 1) < 31);
+
+	my %field = ();
+	$field{'name'} = $self->extracttext($temp, 11);
+	($field{'type'}, $field{'pos'}, $field{'len'}, $field{'dp'}) 
+	    = unpack ("x11a1VCC", $temp);
+
+	push (@{$dbf{'fieldinfo'}}, \%field);
+
+	$dbf{'numfields'} ++;
+    }
+
+    # open the dbt file if we need to
+    my $dbtfullname = $fullname;
+    if ($fullname =~ /f$/) {
+	$dbtfullname =~ s/f$/t/;
+    } else {
+	$dbtfullname =~ s/F$/T/;
+    }
+    if ($dbf{'hasdbt'} && !open (DBTIN, $dbtfullname)) {
+	if ($gli) {
+	    print STDERR "<ProcessingError n='$file' r='Could not read $dbtfullname'>\n";
+	}
+	print STDERR "FOXPlug::read - couldn't read $dbtfullname\n";
+	close (FOXBASEIN);
+	return -1;
+    }
+
+    # read in and process each record in the database
+    my $numrecords = 0;
+    while (($numrecords < $dbf{'numrecords'}) && 
+	   (read (FOXBASEIN, $temp, $dbf{'recordlen'}) == $dbf{'recordlen'})) {
+
+	# create a new record
+	my $record = [];
+	
+	foreach my $field (@{$dbf{'fieldinfo'}}) {
+	    my $fieldvalue = "";
+	    
+	    if ($field->{'type'} eq "M" && $dbf{'hasdbt'}) {
+		# a memo field, look up this field in the dbt file
+		my $seekpos = substr ($temp, $field->{'pos'}, $field->{'len'});
+
+		$seekpos =~ s/^\s*//;
+		$seekpos = 0 unless $seekpos =~ /^\d+$/;
+		
+		$seekpos = $seekpos * 512;
+
+		if ($seekpos == 0) {
+		    # there is no memo field
+
+		} elsif (seek (DBTIN, $seekpos, 0)) {
+		    while (read (DBTIN, $fieldvalue, 512, length($fieldvalue)) > 0) {
+			last if ($fieldvalue =~ /\cZ/);
+		    }
+
+		    # remove everything after the control-Z
+		    substr($fieldvalue, index($fieldvalue, "\cZ")) = "";
+
+		} else {
+		    print STDERR "\nERROR - seek (to $seekpos) failed\n";
+		}
+
+	    } else {
+		# a normal field
+		$fieldvalue = substr ($temp, $field->{'pos'}, $field->{'len'});
+	    }
+
+	    push (@$record, {%$field, 'value'=>$fieldvalue});
+	}
+
+	# process this record
+	$self->process_record ($pluginfo, $base_dir, $file, $metadata, $processor, 
+			       $numrecords, $record);
+	
+	# finished another record...
+	$numrecords++;
+    }
+
+    # close the dbt file if we need to
+    if ($dbf{'hasdbt'}) {
+	close (DBTIN);
+    }
+
+    # close the dbf file
+    close (FOXBASEIN);
+
+    # finished processing
+    return 1;
+}
+
+
+# will extract a string from some larger string, making it
+# conform to a number of constraints
+sub extracttext {
+    my $self = shift (@_);
+    my ($text, $maxlen, $offset, $stopstr) = @_;
+    $offset = 0 unless defined $offset;
+    $stopstr = "\x00" unless defined $stopstr;
+    
+    # decide where the string finishes
+    my $end = index ($text, $stopstr, $offset);
+    $end = length ($text) if $end < 0;
+    $end = $offset+$maxlen if (defined $maxlen) && ($end-$offset > $maxlen);
+    
+    return "" if ($end <= $offset);
+    return substr ($text, $offset, $end-$offset);
+}
+
+
+# process_record should be overriden for a particular type
+# of database. This default version outputs an html document
+# containing all the fields in the record as a table.
+# It also assumes that the text is in utf-8.
+sub process_record {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $numrecords, $record) = @_;
+
+    # create a new document
+    my $doc_obj = new doc ($file, "indexed_doc");
+    $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
+    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
+    my $section = $doc_obj->get_top_section();
+
+    $doc_obj->add_metadata($section, "FileFormat", "FOX");
+    $doc_obj->add_metadata($section, "FileSize",   (-s $file));
+
+    # start of document
+    $doc_obj->add_utf8_text($section, "<table>\n");
+
+    # add each field
+    foreach my $field (@$record) {
+	if (defined ($field->{'name'}) && defined ($field->{'value'})) {
+	    $doc_obj->add_utf8_text($section, "  <tr>\n");
+	    $doc_obj->add_utf8_text($section, "    <td>$field->{'name'}</td>\n");
+	    $doc_obj->add_utf8_text($section, "    <td>$field->{'value'}</td>\n");
+	    $doc_obj->add_utf8_text($section, "  </tr>\n");
+	}
+    }
+
+    # end of document
+    $doc_obj->add_utf8_text($section, "</table>\n");
+
+    # add an object id
+    $doc_obj->set_OID();
+
+    # process the document
+    $processor->process($doc_obj);
+}
+
+
+1;
Index: dl/trunk/perllib/plugins/FavouritesPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/FavouritesPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,113 +1,0 @@
-###########################################################################
-#
-# FavouritesPlug.pm -- Plugin for Internet Explorer Favourites files
-#                      By Stephen De Gabrielle
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 2005 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.
-#
-###########################################################################
-# hacked together by Stephen De Gabrielle from various plugins 
-# especially SRCPlug by John McPherson Nov 2000
-
-package FavouritesPlug;
-
-use BasPlug;
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @FavouritesPlug::ISA = ('BasPlug');
-}
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" } ];
-
-my $options = { 'name'     => "FavouritesPlug",
-		'desc'     => "FavouritesPlug imports Internet Explorer style Favourites. Favourites are often found in the \"C:\\Documents and Settings\\[your username]\\Favorites\" folder on your computer, but can also be made by dragging a bookmark or location from your browser (any) to the desktop.",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-
-sub new {
-    my ($class) = shift(@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-
-sub get_default_process_exp
-{
-    # URL is extension for single bookmarks under windows.
-    return q^(?i)\.URL$^;
-}
-
-
-# do plugin specific processing of doc_obj
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    my $section = $doc_obj->get_top_section();
-    print STDERR "<Processing n='$file' p='FavouritesPlug'>\n" if ($gli);
-    print $outhandle "FavouritesPlug: processing $file\n" if $self->{'verbosity'} > 1;
-
-    # don't want mg to turn escape chars into actual values
-    $$textref =~ s/\\/\\\\/g;
-
-    # use filename (minus the .url extension) as the title
-    my $title = $file;
-    $title =~ s/.url$//i;
-    $doc_obj->add_utf8_metadata($section, "Title", $title);
-
-    # get the URL from the file
-    my ($url) = ($$textref =~ m/^URL=(http.+)/mg);
-    $doc_obj->add_metadata($section, "URL", $url);
-
-    # Add srclink metadata for an automatic link to the webpage
-    $doc_obj->add_utf8_metadata($section, "srclink", "<a href=\"$url\">");
-    $doc_obj->add_utf8_metadata($section, "srcicon", "_iconworld_");
-    $doc_obj->add_utf8_metadata($section, "/srclink", "</a>");
-
-    # Tidy up the favourite text to look a bit nicer
-    $$textref =~ s/^\\n/<p>/g;
-    $$textref =~ s/\[/<p><strong>/g;
-    $$textref =~ s/\]/<\/strong><p>/g;
-    $$textref =~ s/^Modified=(.+)$/<strong>Modified<\/strong>$1<p>/g;
-    $doc_obj->add_utf8_text($section, "$$textref");
-
-    $doc_obj->add_metadata($section, "FileFormat", "Favourite");
-    return 1;
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/FavouritesPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/FavouritesPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/FavouritesPlugin.pm	(revision 15865)
@@ -0,0 +1,113 @@
+###########################################################################
+#
+# FavouritesPlug.pm -- Plugin for Internet Explorer Favourites files
+#                      By Stephen De Gabrielle
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 2005 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.
+#
+###########################################################################
+# hacked together by Stephen De Gabrielle from various plugins 
+# especially SRCPlug by John McPherson Nov 2000
+
+package FavouritesPlug;
+
+use BasPlug;
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @FavouritesPlug::ISA = ('BasPlug');
+}
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" } ];
+
+my $options = { 'name'     => "FavouritesPlug",
+		'desc'     => "FavouritesPlug imports Internet Explorer style Favourites. Favourites are often found in the \"C:\\Documents and Settings\\[your username]\\Favorites\" folder on your computer, but can also be made by dragging a bookmark or location from your browser (any) to the desktop.",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+
+sub new {
+    my ($class) = shift(@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+
+sub get_default_process_exp
+{
+    # URL is extension for single bookmarks under windows.
+    return q^(?i)\.URL$^;
+}
+
+
+# do plugin specific processing of doc_obj
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    my $section = $doc_obj->get_top_section();
+    print STDERR "<Processing n='$file' p='FavouritesPlug'>\n" if ($gli);
+    print $outhandle "FavouritesPlug: processing $file\n" if $self->{'verbosity'} > 1;
+
+    # don't want mg to turn escape chars into actual values
+    $$textref =~ s/\\/\\\\/g;
+
+    # use filename (minus the .url extension) as the title
+    my $title = $file;
+    $title =~ s/.url$//i;
+    $doc_obj->add_utf8_metadata($section, "Title", $title);
+
+    # get the URL from the file
+    my ($url) = ($$textref =~ m/^URL=(http.+)/mg);
+    $doc_obj->add_metadata($section, "URL", $url);
+
+    # Add srclink metadata for an automatic link to the webpage
+    $doc_obj->add_utf8_metadata($section, "srclink", "<a href=\"$url\">");
+    $doc_obj->add_utf8_metadata($section, "srcicon", "_iconworld_");
+    $doc_obj->add_utf8_metadata($section, "/srclink", "</a>");
+
+    # Tidy up the favourite text to look a bit nicer
+    $$textref =~ s/^\\n/<p>/g;
+    $$textref =~ s/\[/<p><strong>/g;
+    $$textref =~ s/\]/<\/strong><p>/g;
+    $$textref =~ s/^Modified=(.+)$/<strong>Modified<\/strong>$1<p>/g;
+    $doc_obj->add_utf8_text($section, "$$textref");
+
+    $doc_obj->add_metadata($section, "FileFormat", "Favourite");
+    return 1;
+}
+
+1;
Index: dl/trunk/perllib/plugins/GAPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/GAPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,262 +1,0 @@
-###########################################################################
-#
-# 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.
-
-package GAPlug;
-
-use XMLPlug;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @GAPlug::ISA = ('XMLPlug');
-}
-
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)doc\.xml$^;
-}
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" } ];
-
-my $options = { 'name'     => "GAPlug",
-		'desc'     => "{GAPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-	        'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new XMLPlug($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 "GAPlug: processing $self->{'file'}\n" if $self->{'verbosity'} > 1;
-    print STDERR "<Processing n='$self->{'file'}' p='GAPlug'>\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;
-
-
Index: /gsdl/trunk/perllib/plugins/GAPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/GAPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/GAPlugin.pm	(revision 15865)
@@ -0,0 +1,262 @@
+###########################################################################
+#
+# 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.
+
+package GAPlug;
+
+use XMLPlug;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @GAPlug::ISA = ('XMLPlug');
+}
+
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)doc\.xml$^;
+}
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" } ];
+
+my $options = { 'name'     => "GAPlug",
+		'desc'     => "{GAPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+	        'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new XMLPlug($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 "GAPlug: processing $self->{'file'}\n" if $self->{'verbosity'} > 1;
+    print STDERR "<Processing n='$self->{'file'}' p='GAPlug'>\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;
+
+
Index: dl/trunk/perllib/plugins/GISBasPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/GISBasPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,315 +1,0 @@
-###########################################################################
-#
-# GISBasPlug.pm -- base class to enhance plugins with GIS capabilities
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999 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 GISBasPlug;
-
-use util;
-use locale;
-
-use gsprintf 'gsprintf';
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-no strict 'subs';
-#field categories in DataBase files
-#$LAT = 3;
-#$LONG = 4;
-my $FC = 9;
-my $DSG = 10;
-#$CC1 = 12;
-my $FULL_NAME = 22;
-
-BEGIN {
-    die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
-}
-
-
-use BasPlug; # uses BasPlug, but is not inherited
-
-
-my $options = { 'name'     => "GISBasPlug",
-		'desc'     => "{GISBasPlug.desc}",
-		'abstract' => "yes",
-		'inherits' => "no" };
-
-
-sub new {
-    my $class = shift (@_);
-    my $plugin_name = shift (@_);
-
-    my $self = {};
-    $self->{'plugin_type'} = "GISBasPlug";
-
-    $self->{'option_list'} = [ $options ];
-
-    return bless $self, $class;
-}
-
-sub init {
-}
-
-sub print_xml_usage
-{
-    BasPlug::print_xml_usage(@_);
-}
-
-sub print_xml
-{
-    BasPlug::print_xml(@_);
-}
-
-sub print_txt_usage
-{
-   BasPlug::print_txt_usage(@_);
-}
-
-sub determine_description_offset
-{
-    BasPlug::determine_description_offset(@_);
-}
-sub print_plugin_usage
-{
-    my $plugindesc = $options->{'desc'};
-
-    if (defined($plugindesc)) {
-	gsprintf(STDERR, "$plugindesc\n\n");
-    }
- 
-}
-
-sub set_incremental
-{
-    BasPlug::set_incremental(@_);
-}
-
-sub has_mapdata
-{
-    my $db_dir = &util::filename_cat($ENV{'GSDLHOME'}, "lamp", "data");
-    return ( -d $db_dir );
-}
-
-
-#returns a hash table of names from database files (specified in collect.cfg). 
-sub loadGISDatabase {
-    my ($outhandle,$datasets) = @_;
-    my @dbase = map{$_ = $_ . ".txt";} split(/,/, $datasets);
-    if(scalar(@dbase)==0) { #default is to include all databases
-	@dbase=("UK.txt", "NZ.txt", "NF.txt", "CA.txt", "AS.txt", "GM.txt", "BE.txt", "IN.txt", "JA.txt", "USA.txt");
-    }
-    my $counter=0;
-    my %places = ();
-    my @cats = ();	
-    while($counter <= $#dbase){ #loop through all the databases
-	my $folder = $dbase[$counter];
-	$folder =~ s/(.*?)\.txt/$1/;
-####		my $dbName = &util::filename_cat($ENV{'GSDLHOME'}, "etc", "mapdata", "data", $folder, $dbase[$counter]);
-	my $dbName = &util::filename_cat($ENV{'GSDLHOME'}, "lamp", "data", $folder, $dbase[$counter]);
-	if (!open(FILEIN, "<$dbName")) {
-	    print $outhandle "Unable to open database $dbName: $!\n";
-	    return undef;
-	}
-	
-	my $line = <FILEIN>; #database category details.
-	my @catdetails = split("\t", $line);
-	
-	while ( defined($line = <FILEIN>)){ #stores all place names in file as keys in hash array %places
-	    @cats = split("\t", $line);
-	    if( #eliminating "bad" place names without missing real ones
-		($cats[$FC] eq "A" && !($cats[$DSG] =~ /ADMD|ADM2|PRSH/))
-		||($cats[$FC] eq "P" && ($cats[$DSG] =~ /PPLA|PPLC|PPLS/)) 
-		||($cats[$FC] eq "H" && ($cats[$DSG] =~ /BAY|LK/)) 
-		||($cats[$FC] eq "L" && !($cats[$DSG] =~ /LCTY|RGN/)) 
-		||($cats[$FC] eq "T" && ($cats[$DSG] =~ /CAPE|ISL|GRGE/))
-		||($dbase[$counter] eq "USA.txt" && ($cats[$DSG] =~ /ppl|island/))
-		){$places{$cats[$FULL_NAME]} = [@cats];}
-			@cats = ();	
-	}	
-	close(FILEIN);
-	$counter++;	
-    }	
-    return \%places;
-}
-
-#returns a unique hash array of all the places found in a document, along with coordinates, description and country data
-sub getPlaces {
-    my $self = shift @_;
-
-    my ($textref, $places) = @_;
-	my %tempPlaces = ();	
-	
-	foreach my $plc (%$places){ #search for an occurrence of each place in the text
-		if($$textref =~ m/(\W)$plc(\W)/){
-			$tempPlaces{$plc} = $places->{$plc};
-		}
-	}
-	#make sure each place is only there once
-	my %uniquePlaces = ();
-	foreach my $p (keys %tempPlaces) {	
-		if(!defined($uniquePlaces{$p})){
-			$uniquePlaces{$p} = $tempPlaces{$p};
-		}
-	}
-	return \%uniquePlaces;
-}
-
-
-
-
-#returns a lowercase version of the place, with no spaces
-sub placename_to_anchorname {
-	my ($placename) = @_;
-	my $p_tag = lc($placename);
-	$p_tag =~ s/\s+//g;
-	return $p_tag;
-}
-
-#takes a place from the text and wraps an anchor tag, a hyperlink tag and an image tag around it
-sub anchor_wrapper {
-	my ($p, $p_counter_ref, $path) = @_;
-	my $image = "/gsdlgis/gisimages/nextplace.gif";
-	my $endTag = "</a>";
-	my $hrefTag = "<a href=";
-	$$p_counter_ref++;
-	my $next = $$p_counter_ref + 1;
-	my $p_tag = placename_to_anchorname($p);
-	my $place_anchor = "<a name=\"" . $p_tag . $$p_counter_ref . "\">" . $endTag; 
-	my $popup_anchor = $hrefTag . "'" . $path . "'>" . $p . $endTag;
-	my $image_anchor = $hrefTag . "#" . $p_tag . $next . "><img src=\"" . $image . "\" name=\"img" . $p_tag . $$p_counter_ref . "\" border=\"0\">" . $endTag;
-	return $place_anchor . $popup_anchor . $image_anchor;
-}
-
-#takes dangerous place names and checks if they are part of another placename or not.
-sub place_name_check {
-	my ($pre, $preSpace, $p, $postSpace, $post, $p_counter_ref, $path, $y) = @_;
-	if($pre =~ /$y/ || $post =~ /$y/) {return $pre . $preSpace . $p . $postSpace . $post;}
-	$pre = $pre . $preSpace;
-	$post = $postSpace . $post;
-	return $pre . &anchor_wrapper("", $p, "", $p_counter_ref, $path) . $post;
-}
-
-sub extract_placenames {
-    my $self = shift (@_);
-    my ($textref, $doc_obj, $thissection) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    my $GSDLHOME = $ENV{'GSDLHOME'};
-    #field categories in DataBase file for extract_placenames.
-    my $LAT = 3;
-    my $LONG = 4;
-    my $CC1 = 12;
-
-    
-    &gsprintf($outhandle, " {BasPlug.extracting_placenames}...\n")
-	if ($self->{'verbosity'} > 2);
-
-    #get all the places found in the document	
-    my $uniquePlaces = $self->getPlaces($textref, $self->{'places'});
-       
-    #finds 'dangerous' placenames (eg York and New York). Dangerous because program will find "York" within "New York"  
-    my %danger = ();    
-    foreach my $x (keys %$uniquePlaces){
-	foreach my $y (keys %$uniquePlaces){
-		if(($y =~ m/ /) && ($y =~ m/$x/) && ($y ne $x)){
-			$y =~ s/($x\s)|(\s$x)//;
-			$danger{$x} = $y;
-		}
-	}
-    }  
-      
-    #creates a list of clickable placenames at top of page, linked to first occurrence of name, and reads them into a file 
-    my $tempfname = $doc_obj;
-    $tempfname =~ s/.*\(0x(.*)\)/$1/;
-    my $names = "";
-    my $filename = "tmpfile" . $tempfname;
-    my $tempfile = &util::filename_cat($GSDLHOME, "tmp", $filename);
-    open(FOUT, ">$tempfile") || die "Unable to create a temp file: $!";	
-    foreach my $name (sort (keys %$uniquePlaces)){
-	if(!defined($danger{$name})){
-		my $name_tag = placename_to_anchorname($name);
-		print FOUT "$name\t" . $uniquePlaces->{$name}->[$LONG] . "\t" . $uniquePlaces->{$name}->[$LAT] . "\n";
-		if($self->{'place_list'}) {$names = $names . "<a href=\"#" . $name_tag . "1\">" . $name . "</a>" . "\n";}
-	}
-    }
-    close(FOUT);
-    $doc_obj->associate_file($tempfile, "places.txt", "text/plain");
-    $self->{'places_filename'} = $tempfile;
-    my %countries = ();
-    
-    foreach my $p (keys %$uniquePlaces){
-	my $place = $p;
-	$place =~ s/\s+|\n+|\r+|\t+/(\\s+)/g;
-	my $cap_place = uc($place);	
-	my $long = $uniquePlaces->{$p}->[$LONG];
-	my $lat = $uniquePlaces->{$p}->[$LAT];
-	my $country = $uniquePlaces->{$p}->[$CC1];
-	my $path = "javascript:popUp(\"$long\",\"$lat\",\"$p\",\"$country\")";
-	my $p_counter = 0;
-	
-	if(!defined($danger{$p})){	
-		#adds html tags to each place name
-		$$textref =~ s/\b($place|$cap_place)\b/&anchor_wrapper($1,\$p_counter,$path)/sge;
-	} 
-	#else {
-	#$y = $danger{$p};
-	#$$textref =~ s/(\w+)(\s+?)($place|$cap_place)(\s+?)(\w+)/&place_name_check($1,$2,$3,$4,$5,\$p_counter,$path, $y)/sge;  
-	#}
-	
-	#edits the last place's image, and removes image if place only occurres once.
-	my $p_tag = placename_to_anchorname($p);
-	$p_counter++;
-	$$textref =~ s/#$p_tag$p_counter(><img src="\/gsdl\/images\/)nextplace.gif/#${p_tag}1$1firstplace.gif/;
-	$$textref =~ s/<img src="\/gsdl\/images\/firstplace.gif" name="img$p_tag(1)" border="0">//;
-	
-	#this line removes apostrophes from placenames (they break the javascript function)
-	$$textref =~ s/(javascript:popUp.*?)(\w)'(\w)/$1$2$3/g;
-		
-	#for displaying map of document, count num of places from each country
-	if(defined($countries{$country})){$countries{$country}++;}
-	else{$countries{$country} = 1;}
-
-	#adds placename to metadata
-	$doc_obj->add_utf8_metadata ($thissection, "Placename", $p);	
-	&gsprintf($outhandle, "  {BasPlug.extracting} $p\n")
-		if ($self->{'verbosity'} > 3); 
-    }
-    #finding the country that most places are from, in order to display map of the document
-    my $max = 0;
-    my $CNTRY = "";
-    foreach my $c_key (keys %countries){
-	if($countries{$c_key} > $max){
-		$max = $countries{$c_key};
-		$CNTRY = $c_key;
-	}
-    }
-    #allows user to view map with all places from the document on it
-####    my $places_filename = &util::filename_cat($GSDLHOME, "collect", "_cgiargc_", "index", "assoc", "_thisOID_", "places.txt");
-    my $places_filename = &util::filename_cat("collect", "_cgiargc_", "index", "assoc", "_thisOID_", "places.txt");
-    my $docmap = "<a href='javascript:popUp(\"$CNTRY\",\"$places_filename\")'>View map for this document<\/a><br><br>\n";
-    $$textref = $docmap . $names . "<br>" . $$textref;
-    
-    $doc_obj->delete_text($thissection);
-    $doc_obj->add_utf8_text($thissection, $$textref);
-    &gsprintf($outhandle, " {BasPlug.done_places_extract}\n")
-	if ($self->{'verbosity'} > 2);
-}
Index: /gsdl/trunk/perllib/plugins/GISExtractor.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/GISExtractor.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/GISExtractor.pm	(revision 15865)
@@ -0,0 +1,315 @@
+###########################################################################
+#
+# GISBasPlug.pm -- base class to enhance plugins with GIS capabilities
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999 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 GISBasPlug;
+
+use util;
+use locale;
+
+use gsprintf 'gsprintf';
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+no strict 'subs';
+#field categories in DataBase files
+#$LAT = 3;
+#$LONG = 4;
+my $FC = 9;
+my $DSG = 10;
+#$CC1 = 12;
+my $FULL_NAME = 22;
+
+BEGIN {
+    die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
+}
+
+
+use BasPlug; # uses BasPlug, but is not inherited
+
+
+my $options = { 'name'     => "GISBasPlug",
+		'desc'     => "{GISBasPlug.desc}",
+		'abstract' => "yes",
+		'inherits' => "no" };
+
+
+sub new {
+    my $class = shift (@_);
+    my $plugin_name = shift (@_);
+
+    my $self = {};
+    $self->{'plugin_type'} = "GISBasPlug";
+
+    $self->{'option_list'} = [ $options ];
+
+    return bless $self, $class;
+}
+
+sub init {
+}
+
+sub print_xml_usage
+{
+    BasPlug::print_xml_usage(@_);
+}
+
+sub print_xml
+{
+    BasPlug::print_xml(@_);
+}
+
+sub print_txt_usage
+{
+   BasPlug::print_txt_usage(@_);
+}
+
+sub determine_description_offset
+{
+    BasPlug::determine_description_offset(@_);
+}
+sub print_plugin_usage
+{
+    my $plugindesc = $options->{'desc'};
+
+    if (defined($plugindesc)) {
+	gsprintf(STDERR, "$plugindesc\n\n");
+    }
+ 
+}
+
+sub set_incremental
+{
+    BasPlug::set_incremental(@_);
+}
+
+sub has_mapdata
+{
+    my $db_dir = &util::filename_cat($ENV{'GSDLHOME'}, "lamp", "data");
+    return ( -d $db_dir );
+}
+
+
+#returns a hash table of names from database files (specified in collect.cfg). 
+sub loadGISDatabase {
+    my ($outhandle,$datasets) = @_;
+    my @dbase = map{$_ = $_ . ".txt";} split(/,/, $datasets);
+    if(scalar(@dbase)==0) { #default is to include all databases
+	@dbase=("UK.txt", "NZ.txt", "NF.txt", "CA.txt", "AS.txt", "GM.txt", "BE.txt", "IN.txt", "JA.txt", "USA.txt");
+    }
+    my $counter=0;
+    my %places = ();
+    my @cats = ();	
+    while($counter <= $#dbase){ #loop through all the databases
+	my $folder = $dbase[$counter];
+	$folder =~ s/(.*?)\.txt/$1/;
+####		my $dbName = &util::filename_cat($ENV{'GSDLHOME'}, "etc", "mapdata", "data", $folder, $dbase[$counter]);
+	my $dbName = &util::filename_cat($ENV{'GSDLHOME'}, "lamp", "data", $folder, $dbase[$counter]);
+	if (!open(FILEIN, "<$dbName")) {
+	    print $outhandle "Unable to open database $dbName: $!\n";
+	    return undef;
+	}
+	
+	my $line = <FILEIN>; #database category details.
+	my @catdetails = split("\t", $line);
+	
+	while ( defined($line = <FILEIN>)){ #stores all place names in file as keys in hash array %places
+	    @cats = split("\t", $line);
+	    if( #eliminating "bad" place names without missing real ones
+		($cats[$FC] eq "A" && !($cats[$DSG] =~ /ADMD|ADM2|PRSH/))
+		||($cats[$FC] eq "P" && ($cats[$DSG] =~ /PPLA|PPLC|PPLS/)) 
+		||($cats[$FC] eq "H" && ($cats[$DSG] =~ /BAY|LK/)) 
+		||($cats[$FC] eq "L" && !($cats[$DSG] =~ /LCTY|RGN/)) 
+		||($cats[$FC] eq "T" && ($cats[$DSG] =~ /CAPE|ISL|GRGE/))
+		||($dbase[$counter] eq "USA.txt" && ($cats[$DSG] =~ /ppl|island/))
+		){$places{$cats[$FULL_NAME]} = [@cats];}
+			@cats = ();	
+	}	
+	close(FILEIN);
+	$counter++;	
+    }	
+    return \%places;
+}
+
+#returns a unique hash array of all the places found in a document, along with coordinates, description and country data
+sub getPlaces {
+    my $self = shift @_;
+
+    my ($textref, $places) = @_;
+	my %tempPlaces = ();	
+	
+	foreach my $plc (%$places){ #search for an occurrence of each place in the text
+		if($$textref =~ m/(\W)$plc(\W)/){
+			$tempPlaces{$plc} = $places->{$plc};
+		}
+	}
+	#make sure each place is only there once
+	my %uniquePlaces = ();
+	foreach my $p (keys %tempPlaces) {	
+		if(!defined($uniquePlaces{$p})){
+			$uniquePlaces{$p} = $tempPlaces{$p};
+		}
+	}
+	return \%uniquePlaces;
+}
+
+
+
+
+#returns a lowercase version of the place, with no spaces
+sub placename_to_anchorname {
+	my ($placename) = @_;
+	my $p_tag = lc($placename);
+	$p_tag =~ s/\s+//g;
+	return $p_tag;
+}
+
+#takes a place from the text and wraps an anchor tag, a hyperlink tag and an image tag around it
+sub anchor_wrapper {
+	my ($p, $p_counter_ref, $path) = @_;
+	my $image = "/gsdlgis/gisimages/nextplace.gif";
+	my $endTag = "</a>";
+	my $hrefTag = "<a href=";
+	$$p_counter_ref++;
+	my $next = $$p_counter_ref + 1;
+	my $p_tag = placename_to_anchorname($p);
+	my $place_anchor = "<a name=\"" . $p_tag . $$p_counter_ref . "\">" . $endTag; 
+	my $popup_anchor = $hrefTag . "'" . $path . "'>" . $p . $endTag;
+	my $image_anchor = $hrefTag . "#" . $p_tag . $next . "><img src=\"" . $image . "\" name=\"img" . $p_tag . $$p_counter_ref . "\" border=\"0\">" . $endTag;
+	return $place_anchor . $popup_anchor . $image_anchor;
+}
+
+#takes dangerous place names and checks if they are part of another placename or not.
+sub place_name_check {
+	my ($pre, $preSpace, $p, $postSpace, $post, $p_counter_ref, $path, $y) = @_;
+	if($pre =~ /$y/ || $post =~ /$y/) {return $pre . $preSpace . $p . $postSpace . $post;}
+	$pre = $pre . $preSpace;
+	$post = $postSpace . $post;
+	return $pre . &anchor_wrapper("", $p, "", $p_counter_ref, $path) . $post;
+}
+
+sub extract_placenames {
+    my $self = shift (@_);
+    my ($textref, $doc_obj, $thissection) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    my $GSDLHOME = $ENV{'GSDLHOME'};
+    #field categories in DataBase file for extract_placenames.
+    my $LAT = 3;
+    my $LONG = 4;
+    my $CC1 = 12;
+
+    
+    &gsprintf($outhandle, " {BasPlug.extracting_placenames}...\n")
+	if ($self->{'verbosity'} > 2);
+
+    #get all the places found in the document	
+    my $uniquePlaces = $self->getPlaces($textref, $self->{'places'});
+       
+    #finds 'dangerous' placenames (eg York and New York). Dangerous because program will find "York" within "New York"  
+    my %danger = ();    
+    foreach my $x (keys %$uniquePlaces){
+	foreach my $y (keys %$uniquePlaces){
+		if(($y =~ m/ /) && ($y =~ m/$x/) && ($y ne $x)){
+			$y =~ s/($x\s)|(\s$x)//;
+			$danger{$x} = $y;
+		}
+	}
+    }  
+      
+    #creates a list of clickable placenames at top of page, linked to first occurrence of name, and reads them into a file 
+    my $tempfname = $doc_obj;
+    $tempfname =~ s/.*\(0x(.*)\)/$1/;
+    my $names = "";
+    my $filename = "tmpfile" . $tempfname;
+    my $tempfile = &util::filename_cat($GSDLHOME, "tmp", $filename);
+    open(FOUT, ">$tempfile") || die "Unable to create a temp file: $!";	
+    foreach my $name (sort (keys %$uniquePlaces)){
+	if(!defined($danger{$name})){
+		my $name_tag = placename_to_anchorname($name);
+		print FOUT "$name\t" . $uniquePlaces->{$name}->[$LONG] . "\t" . $uniquePlaces->{$name}->[$LAT] . "\n";
+		if($self->{'place_list'}) {$names = $names . "<a href=\"#" . $name_tag . "1\">" . $name . "</a>" . "\n";}
+	}
+    }
+    close(FOUT);
+    $doc_obj->associate_file($tempfile, "places.txt", "text/plain");
+    $self->{'places_filename'} = $tempfile;
+    my %countries = ();
+    
+    foreach my $p (keys %$uniquePlaces){
+	my $place = $p;
+	$place =~ s/\s+|\n+|\r+|\t+/(\\s+)/g;
+	my $cap_place = uc($place);	
+	my $long = $uniquePlaces->{$p}->[$LONG];
+	my $lat = $uniquePlaces->{$p}->[$LAT];
+	my $country = $uniquePlaces->{$p}->[$CC1];
+	my $path = "javascript:popUp(\"$long\",\"$lat\",\"$p\",\"$country\")";
+	my $p_counter = 0;
+	
+	if(!defined($danger{$p})){	
+		#adds html tags to each place name
+		$$textref =~ s/\b($place|$cap_place)\b/&anchor_wrapper($1,\$p_counter,$path)/sge;
+	} 
+	#else {
+	#$y = $danger{$p};
+	#$$textref =~ s/(\w+)(\s+?)($place|$cap_place)(\s+?)(\w+)/&place_name_check($1,$2,$3,$4,$5,\$p_counter,$path, $y)/sge;  
+	#}
+	
+	#edits the last place's image, and removes image if place only occurres once.
+	my $p_tag = placename_to_anchorname($p);
+	$p_counter++;
+	$$textref =~ s/#$p_tag$p_counter(><img src="\/gsdl\/images\/)nextplace.gif/#${p_tag}1$1firstplace.gif/;
+	$$textref =~ s/<img src="\/gsdl\/images\/firstplace.gif" name="img$p_tag(1)" border="0">//;
+	
+	#this line removes apostrophes from placenames (they break the javascript function)
+	$$textref =~ s/(javascript:popUp.*?)(\w)'(\w)/$1$2$3/g;
+		
+	#for displaying map of document, count num of places from each country
+	if(defined($countries{$country})){$countries{$country}++;}
+	else{$countries{$country} = 1;}
+
+	#adds placename to metadata
+	$doc_obj->add_utf8_metadata ($thissection, "Placename", $p);	
+	&gsprintf($outhandle, "  {BasPlug.extracting} $p\n")
+		if ($self->{'verbosity'} > 3); 
+    }
+    #finding the country that most places are from, in order to display map of the document
+    my $max = 0;
+    my $CNTRY = "";
+    foreach my $c_key (keys %countries){
+	if($countries{$c_key} > $max){
+		$max = $countries{$c_key};
+		$CNTRY = $c_key;
+	}
+    }
+    #allows user to view map with all places from the document on it
+####    my $places_filename = &util::filename_cat($GSDLHOME, "collect", "_cgiargc_", "index", "assoc", "_thisOID_", "places.txt");
+    my $places_filename = &util::filename_cat("collect", "_cgiargc_", "index", "assoc", "_thisOID_", "places.txt");
+    my $docmap = "<a href='javascript:popUp(\"$CNTRY\",\"$places_filename\")'>View map for this document<\/a><br><br>\n";
+    $$textref = $docmap . $names . "<br>" . $$textref;
+    
+    $doc_obj->delete_text($thissection);
+    $doc_obj->add_utf8_text($thissection, $$textref);
+    &gsprintf($outhandle, " {BasPlug.done_places_extract}\n")
+	if ($self->{'verbosity'} > 2);
+}
Index: dl/trunk/perllib/plugins/GMLPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/GMLPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,251 +1,0 @@
-###########################################################################
-#
-# GMLPlug.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) 1999 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.
-#
-###########################################################################
-
-# plugin which processes a GML format document
-# assumes that gml tags are all in lower-case.
-
-# 12/05/02 Added usage datastructure - John Thompson
-
-package GMLPlug;
-
-use BasPlug;
-use util;
-use doc;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @GMLPlug::ISA = ('BasPlug');
-}
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' =>  &get_default_process_exp() } 
-    ];
-
-my $options = { 'name'     => "GMLPlug",
-		'desc'     => "{GMLPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args' => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)\.gml?$^;
-}
-
-# return number of files processed, undef if can't process
-# Note that $base_dir might be "" and that $file might 
-# include directories
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    #check process and block exps, smart block, etc
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-
-    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
-
-    print STDERR "<Processing n='$file' p='GMLPlug'>\n" if ($gli);
-    print $outhandle "GMLPlug: processing $file\n";
-
-    my $parent_dir = $file;
-    $parent_dir =~ s/[^\\\/]*$//;
-    $parent_dir = &util::filename_cat ($base_dir, $parent_dir);
-
-    if (!open (INFILE, $filename)) {
-	if ($gli) {
-	    print STDERR "<ProcessingError n='$file' r='Could not read $filename'>\n";
-	}
-	print $outhandle "GMLPlug::read - couldn't read $filename\n";
-	return -1;
-    }
-
-    undef $/;
-    my $gml = <INFILE>;
-    $/ = "\n";
-    close (INFILE);
-    
-    my @gml_sections = split("</gsdlsection>",$gml);
-    $gml = shift(@gml_sections);
-
-    my $no_docs = 0;
-
-    while (1) {
-	# create a new document
-	my $doc_obj = new doc ();
-	my $section = $doc_obj->get_top_section();
-
-	# process the document
-	my $firstsection = 1;
-	while (1) {
-	    my ($tags, $text) = ("", "");
-
-	    my @indenting_sections = split("<gsdlsection", $gml);
-	    shift(@indenting_sections); # skips over xml header if present
-
-	    foreach $gml (@indenting_sections) {
-
-		if ($gml =~ /^\s*([^>]*)>(.*)$/so) {
-		    $tags = $1 if defined $1;
-		    $text = &GMLPlug::_unescape_text($2);
-
-		} else {
-		    print $outhandle "GMLPlug::read - error in file $filename\n";
-		    print $outhandle "text: \"$gml\"\n";
-		    last;
-		}
-
-		# create the section (unless this is the first section)
-		if ($firstsection) {
- 		    $firstsection = 0;
-#		    $tags =~ /gsdlsourcefilename\s*=\s*(?:\"([^\"]*)\")/o;
-#		    $src_filename = $2 || $3;
-
-		} else {
-
-		    $tags =~ s/gsdlnum\s*=\s*\"?(\d+)\"?//o;
-		    if (defined $1) {
-			$section .= ".$1";
-			$doc_obj->create_named_section($section);
-		    } else {
-			$section = $doc_obj->insert_section($doc_obj->get_end_child($section));
-		    }
-		}
-	    
-		# add the metadata
-		# could be stored as either attributes or ....
-		while ((defined $tags) && ($tags =~ s/^\s*(\S+)=\"([^\"]*)\"//o)) {
-		    $doc_obj->add_utf8_metadata($section, $1, &GMLPlug::_unescape_text($2)) 
-			if (defined $1 and defined $2);
-
-		}
-		
-		# ... or tags (xml compliant)
-		if ($text =~ m/^\s*<metadata>/)
-		{
-		    my ($metadata, $tagname, $tagvalue);
-		    ($metadata,$text) 
-			= ($text =~ m/\s*<metadata>\s*(<.*)\s*<\/metadata>(.*)$/s);
-
-		    # note: \1 refers to 1st match within regexp, so we can
-		    # handle the unescaped text here...
-		    while ((defined $metadata) 
-			   && ($metadata =~ s/<(.*?)>(.*?)<\/\1>//s))
-		    {
-			if (defined $1 && defined $2) 
-			{
-			    $tagname = $1;
-			    $tagvalue = $2;
-			    
-			    # if tagname begins with '/' it will be escaped
-			    $tagname =~ s/^&\#47;/\//;
-			    
-			    $doc_obj->add_utf8_metadata($section, $tagname, &GMLPlug::_unescape_text($tagvalue)); 
-			}
-		    }
-		}
-
-		# add the text
-
-		$doc_obj->add_utf8_text($section, $text) 
-		    if ((defined $text) && ($text ne ""));		
-	    }
-
-	    $gml = shift(@gml_sections); # get next bit of data
-	    last unless defined $gml;
- 	    last if $section eq ""; # back to top level again (more than one document in gml file)
-	    $section = $doc_obj->get_parent_section ($section);
-	} # while (1) section level
-	
-	# add the FileFormat as the metadata
-	$doc_obj->add_metadata($doc_obj->get_top_section(), "FileFormat", "GML");
-
-	# add the associated files
-	my $assoc_files = $doc_obj->get_metadata($doc_obj->get_top_section(), "gsdlassocfile");
-	my ($assoc_file_info);
-	
-	foreach $assoc_file_info (@$assoc_files) 
-	{
-	    my ($assoc_file, $mime_type, $dir) = split (":", $assoc_file_info);
-	    my $real_dir = &util::filename_cat($parent_dir, $assoc_file),
-	    my $assoc_dir = (defined $dir && $dir ne "") 
-		? &util::filename_cat($dir, $assoc_file) : $assoc_file;
-	    $doc_obj->associate_file($real_dir, $assoc_dir, $mime_type);
-	    
-	}
-	$doc_obj->delete_metadata($doc_obj->get_top_section(), "gsdlassocfile");
-
-	# add metadata passed in from elsewhere
-	$self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
-	
-	# do any automatic metadata extraction
-	$self->auto_extract_metadata ($doc_obj);
-
-	# assume the document has an OID already
-
-	# process the document
-	$processor->process($doc_obj, $file);
-	
-	$no_docs++;
-	last if ($maxdocs > -1 && ($total_count+$no_docs) >= $maxdocs);
-	last unless defined $gml && $gml =~ /\w/;
-    } # while(1) document level
-    
-    return $no_docs; # no of docs processed
-}
-
-sub _unescape_text {
-    my ($text) = @_;
-
-    # special characters in the gml encoding
-    $text =~ s/&lt;/</g;
-    $text =~ s/&gt;/>/g;
-    $text =~ s/&quot;/\"/g;
-    $text =~ s/&amp;/&/g; # this has to be last...
-
-    return $text;
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/GMLPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/GMLPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/GMLPlugin.pm	(revision 15865)
@@ -0,0 +1,251 @@
+###########################################################################
+#
+# GMLPlug.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) 1999 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.
+#
+###########################################################################
+
+# plugin which processes a GML format document
+# assumes that gml tags are all in lower-case.
+
+# 12/05/02 Added usage datastructure - John Thompson
+
+package GMLPlug;
+
+use BasPlug;
+use util;
+use doc;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @GMLPlug::ISA = ('BasPlug');
+}
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' =>  &get_default_process_exp() } 
+    ];
+
+my $options = { 'name'     => "GMLPlug",
+		'desc'     => "{GMLPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args' => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)\.gml?$^;
+}
+
+# return number of files processed, undef if can't process
+# Note that $base_dir might be "" and that $file might 
+# include directories
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    #check process and block exps, smart block, etc
+    my ($block_status,$filename) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+
+    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
+
+    print STDERR "<Processing n='$file' p='GMLPlug'>\n" if ($gli);
+    print $outhandle "GMLPlug: processing $file\n";
+
+    my $parent_dir = $file;
+    $parent_dir =~ s/[^\\\/]*$//;
+    $parent_dir = &util::filename_cat ($base_dir, $parent_dir);
+
+    if (!open (INFILE, $filename)) {
+	if ($gli) {
+	    print STDERR "<ProcessingError n='$file' r='Could not read $filename'>\n";
+	}
+	print $outhandle "GMLPlug::read - couldn't read $filename\n";
+	return -1;
+    }
+
+    undef $/;
+    my $gml = <INFILE>;
+    $/ = "\n";
+    close (INFILE);
+    
+    my @gml_sections = split("</gsdlsection>",$gml);
+    $gml = shift(@gml_sections);
+
+    my $no_docs = 0;
+
+    while (1) {
+	# create a new document
+	my $doc_obj = new doc ();
+	my $section = $doc_obj->get_top_section();
+
+	# process the document
+	my $firstsection = 1;
+	while (1) {
+	    my ($tags, $text) = ("", "");
+
+	    my @indenting_sections = split("<gsdlsection", $gml);
+	    shift(@indenting_sections); # skips over xml header if present
+
+	    foreach $gml (@indenting_sections) {
+
+		if ($gml =~ /^\s*([^>]*)>(.*)$/so) {
+		    $tags = $1 if defined $1;
+		    $text = &GMLPlug::_unescape_text($2);
+
+		} else {
+		    print $outhandle "GMLPlug::read - error in file $filename\n";
+		    print $outhandle "text: \"$gml\"\n";
+		    last;
+		}
+
+		# create the section (unless this is the first section)
+		if ($firstsection) {
+ 		    $firstsection = 0;
+#		    $tags =~ /gsdlsourcefilename\s*=\s*(?:\"([^\"]*)\")/o;
+#		    $src_filename = $2 || $3;
+
+		} else {
+
+		    $tags =~ s/gsdlnum\s*=\s*\"?(\d+)\"?//o;
+		    if (defined $1) {
+			$section .= ".$1";
+			$doc_obj->create_named_section($section);
+		    } else {
+			$section = $doc_obj->insert_section($doc_obj->get_end_child($section));
+		    }
+		}
+	    
+		# add the metadata
+		# could be stored as either attributes or ....
+		while ((defined $tags) && ($tags =~ s/^\s*(\S+)=\"([^\"]*)\"//o)) {
+		    $doc_obj->add_utf8_metadata($section, $1, &GMLPlug::_unescape_text($2)) 
+			if (defined $1 and defined $2);
+
+		}
+		
+		# ... or tags (xml compliant)
+		if ($text =~ m/^\s*<metadata>/)
+		{
+		    my ($metadata, $tagname, $tagvalue);
+		    ($metadata,$text) 
+			= ($text =~ m/\s*<metadata>\s*(<.*)\s*<\/metadata>(.*)$/s);
+
+		    # note: \1 refers to 1st match within regexp, so we can
+		    # handle the unescaped text here...
+		    while ((defined $metadata) 
+			   && ($metadata =~ s/<(.*?)>(.*?)<\/\1>//s))
+		    {
+			if (defined $1 && defined $2) 
+			{
+			    $tagname = $1;
+			    $tagvalue = $2;
+			    
+			    # if tagname begins with '/' it will be escaped
+			    $tagname =~ s/^&\#47;/\//;
+			    
+			    $doc_obj->add_utf8_metadata($section, $tagname, &GMLPlug::_unescape_text($tagvalue)); 
+			}
+		    }
+		}
+
+		# add the text
+
+		$doc_obj->add_utf8_text($section, $text) 
+		    if ((defined $text) && ($text ne ""));		
+	    }
+
+	    $gml = shift(@gml_sections); # get next bit of data
+	    last unless defined $gml;
+ 	    last if $section eq ""; # back to top level again (more than one document in gml file)
+	    $section = $doc_obj->get_parent_section ($section);
+	} # while (1) section level
+	
+	# add the FileFormat as the metadata
+	$doc_obj->add_metadata($doc_obj->get_top_section(), "FileFormat", "GML");
+
+	# add the associated files
+	my $assoc_files = $doc_obj->get_metadata($doc_obj->get_top_section(), "gsdlassocfile");
+	my ($assoc_file_info);
+	
+	foreach $assoc_file_info (@$assoc_files) 
+	{
+	    my ($assoc_file, $mime_type, $dir) = split (":", $assoc_file_info);
+	    my $real_dir = &util::filename_cat($parent_dir, $assoc_file),
+	    my $assoc_dir = (defined $dir && $dir ne "") 
+		? &util::filename_cat($dir, $assoc_file) : $assoc_file;
+	    $doc_obj->associate_file($real_dir, $assoc_dir, $mime_type);
+	    
+	}
+	$doc_obj->delete_metadata($doc_obj->get_top_section(), "gsdlassocfile");
+
+	# add metadata passed in from elsewhere
+	$self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
+	
+	# do any automatic metadata extraction
+	$self->auto_extract_metadata ($doc_obj);
+
+	# assume the document has an OID already
+
+	# process the document
+	$processor->process($doc_obj, $file);
+	
+	$no_docs++;
+	last if ($maxdocs > -1 && ($total_count+$no_docs) >= $maxdocs);
+	last unless defined $gml && $gml =~ /\w/;
+    } # while(1) document level
+    
+    return $no_docs; # no of docs processed
+}
+
+sub _unescape_text {
+    my ($text) = @_;
+
+    # special characters in the gml encoding
+    $text =~ s/&lt;/</g;
+    $text =~ s/&gt;/>/g;
+    $text =~ s/&quot;/\"/g;
+    $text =~ s/&amp;/&/g; # this has to be last...
+
+    return $text;
+}
+
+1;
Index: dl/trunk/perllib/plugins/HBPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/HBPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,358 +1,0 @@
-###########################################################################
-#
-# HBPlug.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) 1999 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.
-#
-###########################################################################
-
-# plugin which processes an HTML book directory
-
-# This plugin is used by the Humanity Library collections and does not handle
-# input encodings other than ascii or extended ascii
-
-# this code is kind of ugly and could no doubt be made to run faster, by leaving
-# it in this state I hope to encourage people to make their collections use
-# HBSPlug instead ;-)
-
-# Use HBSPlug if creating a new collection and marking up files like the
-# Humanity Library collections. HBSPlug accepts all input encodings but
-# expects the marked up files to be cleaner than those used by the
-# Humanity Library collections
-
-package HBPlug;
-
-use ghtml;
-use BasPlug;
-use unicode;
-use util;
-use doc;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @HBPlug::ISA = ('BasPlug');
-}
-
-my $arguments = 
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_process_exp() }
-      ];
-
-my $options = { 'name'     => "HBPlug",
-		'desc'     => "{HBPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-sub init {
-    my $self = shift (@_);
-    my ($verbosity, $outhandle) = @_;
-
-    $self->BasPlug::init($verbosity, $outhandle);
-    $self->{'input_encoding'} = "iso_8859_1";
-
-    # this plugin only handles ascii encodings
-    if ($self->{'input_encoding'} !~ /^(iso_8859_1|ascii)$/) {
-	die "ERROR: HBPlug can handle only iso_8859_1 or ascii encodings.\n" .
-	    $self->{'input_encoding'} . " is not an acceptable input_encoding value\n";
-    } 
-}
-
-# this is included only to prevent warnings being printed out 
-# from BasPlug::init. The process_exp is not used by this plugin
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return "This plugin does not use a process_exp\n";
-}
-
-
-sub HB_read_html_file {
-    my $self = shift (@_);
-    my ($htmlfile, $text) = @_;
-
-    # load in the file
-    if (!open (FILE, $htmlfile)) {
-	my $outhandle = $self->{'outhandle'};
-	print $outhandle "ERROR - could not open $htmlfile\n";
-	return;
-    }
-
-    my $foundbody = 0;
-    $self->HB_gettext (\$foundbody, $text, "FILE");
-    close FILE;
-
-    # just in case there was no <body> tag
-    if (!$foundbody) {
-	$foundbody = 1;
-	open (FILE, $htmlfile) || return;
-	$self->HB_gettext (\$foundbody, $text, "FILE");	
-	close FILE;
-    }
-    # text is in utf8
-}
-
-# converts the text to utf8, as ghtml does that for &eacute; etc.
-sub HB_gettext {
-    my $self = shift (@_);
-    my ($foundbody, $text, $handle) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    my $line = "";
-    while (defined ($line = <$handle>)) {
-	# look for body tag
-	if (!$$foundbody) {
-	    if ($line =~ s/^.*<body[^>]*>//i) {
-		$$foundbody = 1;
-	    } else {
-		next;
-	    }
-	}
-	
-	# check for symbol fonts
-	if ($line =~ /<font [^>]*?face\s*=\s*\"?(\w+)\"?/i) {
-	    my $font = $1;
-	    print $outhandle "HBPlug::HB_gettext - warning removed font $font\n" 
-		if ($font !~ /^arial$/i);
-	}
-
-	$line =~ s/<\/p>//ig;   # remove </p> tags
-	$line =~ s/<\/?(body|html|font)\b[^>]*>//ig; # remove any unwanted tags
-
-	$$text .= $line;
-    }
-    #
-    if ($self->{'input_encoding'} eq "iso_8859_1") {
-	# convert to utf-8
-	$$text=&unicode::unicode2utf8(&unicode::convert2unicode("iso_8859_1", $text));
-    }
-    # convert any alphanumeric character entities to their utf-8
-    # equivalent for indexing purposes
-    &ghtml::convertcharentities ($$text);
-
-    $$text =~ s/\s+/ /g; # remove \n's
-}
-
-sub HB_clean_section {
-    my $self = shift (@_);
-    my ($section) = @_;
-
-    # remove tags without a starting tag from the section
-    my ($tag, $tagstart);
-    while ($section =~ /<\/([^>]{1,10})>/) {
-	$tag = $1;
-	$tagstart = index($section, "<$tag");
-	last if (($tagstart >= 0) && ($tagstart < index($section, "<\/$tag")));
-	$section =~ s/<\/$tag>//;
-    }
-    
-    # remove extra paragraph tags
-    while ($section =~ s/<p\b[^>]*>\s*<p\b/<p/ig) {}
-    
-    # remove extra stuff at the end of the section
-    while ($section =~ s/(<u>|<i>|<b>|<p\b[^>]*>|&nbsp;|\s)$//i) {}
-    
-    # add a newline at the beginning of each paragraph
-    $section =~ s/(.)\s*<p\b/$1\n\n<p/gi;
-    
-    # add a newline every 80 characters at a word boundary
-    # Note: this regular expression puts a line feed before
-    # the last word in each section, even when it is not
-    # needed.
-    $section =~ s/(.{1,80})\s/$1\n/g;
-    
-    # fix up the image links
-    $section =~ s/<img[^>]*?src=\"?([^\">]+)\"?[^>]*>/
-	<center><img src=\"_httpdocimg_\/$1\"><\/center><br>/ig;
-    $section =~ s/&lt;&lt;I&gt;&gt;\s*([^\.]+\.(png|jpg|gif))/
-	<center><img src=\"_httpdocimg_\/$1\"><\/center><br>/ig;
-
-    return $section;
-}
-
-
-sub shorten {
-    my $self = shift (@_);
-    my ($text) = @_;
-
-    return "\"$text\"" if (length($text) < 100);
-
-    return "\"" . substr ($text, 0, 50) . "\" ... \"" . 
-	substr ($text, length($text)-50) . "\"";
-}
-
-# if input_encoding is ascii we can call add_utf8_metadata
-# directly but if it's iso_8859_1 (the default) we need to call
-# add_metadata so that the ascii2utf8 conversion is done first
-# this should speed things up a little if processing an ascii only
-# document with input_encoding set to ascii
-sub HB_add_metadata {
-    my $self = shift (@_);
-    my ($doc_obj, $cursection, $field, $value) = @_;
-
-# All text should now be in utf-8
-#    if ($self->{'input_encoding'} eq "ascii") {
-    $doc_obj->add_utf8_metadata ($cursection, $field, $value);
-#    } else {
-#	$doc_obj->add_metadata ($cursection, $field, $value);
-#    }
-}
-
-# return number of files processed, undef if can't process
-# Note that $base_dir might be "" and that $file might 
-# include directories
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    # get the html filename and see if this is an HTML Book...
-    my $jobnumber = $file;
-    if ($file =~ /[\\\/]/) {
-	($jobnumber) = $file =~ /[\\\/]([^\\\/]+)$/;
-    }
-    return undef unless defined $jobnumber;
-    my $htmlfile = &util::filename_cat($base_dir, $file, "$jobnumber.htm");
-    return undef unless -e $htmlfile;
-
-    print STDERR "<Processing n='$file' p='HBPlug'>\n" if ($gli);
-    print $outhandle "HBPlug: processing $file\n";
-
-    # read in the file and do basic html cleaning (removing header etc)
-    my $html = "";
-    $self->HB_read_html_file ($htmlfile, \$html);
-    # html is in utf8
-
-    # create a new document
-    my $doc_obj = new doc ($file, "indexed_doc");
-    $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
-
-    # copy the book cover if it exists
-    my $bookcover = &util::filename_cat($base_dir, $file, "$jobnumber.jpg");
-    $doc_obj->associate_file($bookcover, "cover.jpg", "image/jpeg");
-    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
-    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "FileFormat", "HB");
-    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "FileSize", (-s $htmlfile));
-
-    my $cursection = $doc_obj->get_top_section();
-    
-    # add metadata for top level of document
-    foreach my $field (keys(%$metadata)) {
-	# $metadata->{$field} may be an array reference
-	if (ref ($metadata->{$field}) eq "ARRAY") {
-	    map { 
-		$self->HB_add_metadata ($doc_obj, $cursection, $field, $_); 
-	    } @{$metadata->{$field}};
-	} else {
-	    $self->HB_add_metadata ($doc_obj, $cursection, $field, $metadata->{$field}); 
-	}
-    }
-
-    # process the file one section at a time
-    my $curtoclevel = 1;
-    my $firstsection = 1;
-    while (length ($html) > 0) {
-	if ($html =~ s/^.*?(?:<p\b[^>]*>)?((<b>|<i>|<u>|\s)*)&lt;&lt;TOC(\d+)&gt;&gt;\s*(.*?)<p\b/<p/i) {
-	    my $toclevel = $3;
-	    my $title = $4;
-	    my $sectiontext = "";
-	    if ($html =~ s/^(.*?)((?:<p\b[^>]*>)?((<b>|<i>|<u>|\s)*)&lt;&lt;TOC\d+&gt;&gt;)/$2/i) {
-		$sectiontext = $1;
-	    } else {
-		$sectiontext = $html;
-		$html = "";
-	    }
-
-	    # remove tags and extra spaces from the title
-	    $title =~ s/<\/?[^>]+>//g;
-	    $title =~ s/^\s+|\s+$//g;
-
-	    # close any sections below the current level and
-	    # create a new section (special case for the firstsection)
-	    while (($curtoclevel > $toclevel) ||
-		   (!$firstsection && $curtoclevel == $toclevel)) {
-		$cursection = $doc_obj->get_parent_section ($cursection);
-		$curtoclevel--;
-	    }
-	    if ($curtoclevel+1 < $toclevel) {
-		print $outhandle "WARNING - jump in toc levels in $htmlfile " . 
-		    "from $curtoclevel to $toclevel\n";
-	    }
-	    while ($curtoclevel < $toclevel) {
-		$curtoclevel++;
-		$cursection = 
-		    $doc_obj->insert_section($doc_obj->get_end_child($cursection));
-	    }
-
-	    # add the metadata to this section
-	    $self->HB_add_metadata ($doc_obj, $cursection, "Title", $title);
-
-	    # clean up the section html
-	    $sectiontext = $self->HB_clean_section($sectiontext);
-
-	    # associate any files
-	    map { $doc_obj->associate_file(&util::filename_cat ($base_dir, $file, $1), $1)
-		      if /_httpdocimg_\/([^\"]+)\"/; 0; }
-	         split (/(_httpdocimg_\/[^\"]+\")/, $sectiontext);
-
-	    # add the text for this section
-# All read text should now be in utf-8
-#	    if ($self->{'input_encoding'} eq "ascii") {
-	    $doc_obj->add_utf8_text ($cursection, $sectiontext);
-#	    } else {
-#		$doc_obj->add_text ($cursection, $sectiontext);
-#	    }
-	} else {
-	    print $outhandle "WARNING - leftover text\n" , $self->shorten($html), 
-	    "\nin $htmlfile\n";
-	    last;
-	}
-	$firstsection = 0;
-    }
-
-    # add a OID
-    $doc_obj->set_OID ();
-
-    # process the document
-    $processor->process($doc_obj, &util::filename_cat($file, "$jobnumber.htm"));
-        
-    return 1; # processed the file
-}
-
-
-1;
Index: /gsdl/trunk/perllib/plugins/HBPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/HBPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/HBPlugin.pm	(revision 15865)
@@ -0,0 +1,358 @@
+###########################################################################
+#
+# HBPlug.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) 1999 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.
+#
+###########################################################################
+
+# plugin which processes an HTML book directory
+
+# This plugin is used by the Humanity Library collections and does not handle
+# input encodings other than ascii or extended ascii
+
+# this code is kind of ugly and could no doubt be made to run faster, by leaving
+# it in this state I hope to encourage people to make their collections use
+# HBSPlug instead ;-)
+
+# Use HBSPlug if creating a new collection and marking up files like the
+# Humanity Library collections. HBSPlug accepts all input encodings but
+# expects the marked up files to be cleaner than those used by the
+# Humanity Library collections
+
+package HBPlug;
+
+use ghtml;
+use BasPlug;
+use unicode;
+use util;
+use doc;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @HBPlug::ISA = ('BasPlug');
+}
+
+my $arguments = 
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_process_exp() }
+      ];
+
+my $options = { 'name'     => "HBPlug",
+		'desc'     => "{HBPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+sub init {
+    my $self = shift (@_);
+    my ($verbosity, $outhandle) = @_;
+
+    $self->BasPlug::init($verbosity, $outhandle);
+    $self->{'input_encoding'} = "iso_8859_1";
+
+    # this plugin only handles ascii encodings
+    if ($self->{'input_encoding'} !~ /^(iso_8859_1|ascii)$/) {
+	die "ERROR: HBPlug can handle only iso_8859_1 or ascii encodings.\n" .
+	    $self->{'input_encoding'} . " is not an acceptable input_encoding value\n";
+    } 
+}
+
+# this is included only to prevent warnings being printed out 
+# from BasPlug::init. The process_exp is not used by this plugin
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return "This plugin does not use a process_exp\n";
+}
+
+
+sub HB_read_html_file {
+    my $self = shift (@_);
+    my ($htmlfile, $text) = @_;
+
+    # load in the file
+    if (!open (FILE, $htmlfile)) {
+	my $outhandle = $self->{'outhandle'};
+	print $outhandle "ERROR - could not open $htmlfile\n";
+	return;
+    }
+
+    my $foundbody = 0;
+    $self->HB_gettext (\$foundbody, $text, "FILE");
+    close FILE;
+
+    # just in case there was no <body> tag
+    if (!$foundbody) {
+	$foundbody = 1;
+	open (FILE, $htmlfile) || return;
+	$self->HB_gettext (\$foundbody, $text, "FILE");	
+	close FILE;
+    }
+    # text is in utf8
+}
+
+# converts the text to utf8, as ghtml does that for &eacute; etc.
+sub HB_gettext {
+    my $self = shift (@_);
+    my ($foundbody, $text, $handle) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    my $line = "";
+    while (defined ($line = <$handle>)) {
+	# look for body tag
+	if (!$$foundbody) {
+	    if ($line =~ s/^.*<body[^>]*>//i) {
+		$$foundbody = 1;
+	    } else {
+		next;
+	    }
+	}
+	
+	# check for symbol fonts
+	if ($line =~ /<font [^>]*?face\s*=\s*\"?(\w+)\"?/i) {
+	    my $font = $1;
+	    print $outhandle "HBPlug::HB_gettext - warning removed font $font\n" 
+		if ($font !~ /^arial$/i);
+	}
+
+	$line =~ s/<\/p>//ig;   # remove </p> tags
+	$line =~ s/<\/?(body|html|font)\b[^>]*>//ig; # remove any unwanted tags
+
+	$$text .= $line;
+    }
+    #
+    if ($self->{'input_encoding'} eq "iso_8859_1") {
+	# convert to utf-8
+	$$text=&unicode::unicode2utf8(&unicode::convert2unicode("iso_8859_1", $text));
+    }
+    # convert any alphanumeric character entities to their utf-8
+    # equivalent for indexing purposes
+    &ghtml::convertcharentities ($$text);
+
+    $$text =~ s/\s+/ /g; # remove \n's
+}
+
+sub HB_clean_section {
+    my $self = shift (@_);
+    my ($section) = @_;
+
+    # remove tags without a starting tag from the section
+    my ($tag, $tagstart);
+    while ($section =~ /<\/([^>]{1,10})>/) {
+	$tag = $1;
+	$tagstart = index($section, "<$tag");
+	last if (($tagstart >= 0) && ($tagstart < index($section, "<\/$tag")));
+	$section =~ s/<\/$tag>//;
+    }
+    
+    # remove extra paragraph tags
+    while ($section =~ s/<p\b[^>]*>\s*<p\b/<p/ig) {}
+    
+    # remove extra stuff at the end of the section
+    while ($section =~ s/(<u>|<i>|<b>|<p\b[^>]*>|&nbsp;|\s)$//i) {}
+    
+    # add a newline at the beginning of each paragraph
+    $section =~ s/(.)\s*<p\b/$1\n\n<p/gi;
+    
+    # add a newline every 80 characters at a word boundary
+    # Note: this regular expression puts a line feed before
+    # the last word in each section, even when it is not
+    # needed.
+    $section =~ s/(.{1,80})\s/$1\n/g;
+    
+    # fix up the image links
+    $section =~ s/<img[^>]*?src=\"?([^\">]+)\"?[^>]*>/
+	<center><img src=\"_httpdocimg_\/$1\"><\/center><br>/ig;
+    $section =~ s/&lt;&lt;I&gt;&gt;\s*([^\.]+\.(png|jpg|gif))/
+	<center><img src=\"_httpdocimg_\/$1\"><\/center><br>/ig;
+
+    return $section;
+}
+
+
+sub shorten {
+    my $self = shift (@_);
+    my ($text) = @_;
+
+    return "\"$text\"" if (length($text) < 100);
+
+    return "\"" . substr ($text, 0, 50) . "\" ... \"" . 
+	substr ($text, length($text)-50) . "\"";
+}
+
+# if input_encoding is ascii we can call add_utf8_metadata
+# directly but if it's iso_8859_1 (the default) we need to call
+# add_metadata so that the ascii2utf8 conversion is done first
+# this should speed things up a little if processing an ascii only
+# document with input_encoding set to ascii
+sub HB_add_metadata {
+    my $self = shift (@_);
+    my ($doc_obj, $cursection, $field, $value) = @_;
+
+# All text should now be in utf-8
+#    if ($self->{'input_encoding'} eq "ascii") {
+    $doc_obj->add_utf8_metadata ($cursection, $field, $value);
+#    } else {
+#	$doc_obj->add_metadata ($cursection, $field, $value);
+#    }
+}
+
+# return number of files processed, undef if can't process
+# Note that $base_dir might be "" and that $file might 
+# include directories
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    # get the html filename and see if this is an HTML Book...
+    my $jobnumber = $file;
+    if ($file =~ /[\\\/]/) {
+	($jobnumber) = $file =~ /[\\\/]([^\\\/]+)$/;
+    }
+    return undef unless defined $jobnumber;
+    my $htmlfile = &util::filename_cat($base_dir, $file, "$jobnumber.htm");
+    return undef unless -e $htmlfile;
+
+    print STDERR "<Processing n='$file' p='HBPlug'>\n" if ($gli);
+    print $outhandle "HBPlug: processing $file\n";
+
+    # read in the file and do basic html cleaning (removing header etc)
+    my $html = "";
+    $self->HB_read_html_file ($htmlfile, \$html);
+    # html is in utf8
+
+    # create a new document
+    my $doc_obj = new doc ($file, "indexed_doc");
+    $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
+
+    # copy the book cover if it exists
+    my $bookcover = &util::filename_cat($base_dir, $file, "$jobnumber.jpg");
+    $doc_obj->associate_file($bookcover, "cover.jpg", "image/jpeg");
+    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
+    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "FileFormat", "HB");
+    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "FileSize", (-s $htmlfile));
+
+    my $cursection = $doc_obj->get_top_section();
+    
+    # add metadata for top level of document
+    foreach my $field (keys(%$metadata)) {
+	# $metadata->{$field} may be an array reference
+	if (ref ($metadata->{$field}) eq "ARRAY") {
+	    map { 
+		$self->HB_add_metadata ($doc_obj, $cursection, $field, $_); 
+	    } @{$metadata->{$field}};
+	} else {
+	    $self->HB_add_metadata ($doc_obj, $cursection, $field, $metadata->{$field}); 
+	}
+    }
+
+    # process the file one section at a time
+    my $curtoclevel = 1;
+    my $firstsection = 1;
+    while (length ($html) > 0) {
+	if ($html =~ s/^.*?(?:<p\b[^>]*>)?((<b>|<i>|<u>|\s)*)&lt;&lt;TOC(\d+)&gt;&gt;\s*(.*?)<p\b/<p/i) {
+	    my $toclevel = $3;
+	    my $title = $4;
+	    my $sectiontext = "";
+	    if ($html =~ s/^(.*?)((?:<p\b[^>]*>)?((<b>|<i>|<u>|\s)*)&lt;&lt;TOC\d+&gt;&gt;)/$2/i) {
+		$sectiontext = $1;
+	    } else {
+		$sectiontext = $html;
+		$html = "";
+	    }
+
+	    # remove tags and extra spaces from the title
+	    $title =~ s/<\/?[^>]+>//g;
+	    $title =~ s/^\s+|\s+$//g;
+
+	    # close any sections below the current level and
+	    # create a new section (special case for the firstsection)
+	    while (($curtoclevel > $toclevel) ||
+		   (!$firstsection && $curtoclevel == $toclevel)) {
+		$cursection = $doc_obj->get_parent_section ($cursection);
+		$curtoclevel--;
+	    }
+	    if ($curtoclevel+1 < $toclevel) {
+		print $outhandle "WARNING - jump in toc levels in $htmlfile " . 
+		    "from $curtoclevel to $toclevel\n";
+	    }
+	    while ($curtoclevel < $toclevel) {
+		$curtoclevel++;
+		$cursection = 
+		    $doc_obj->insert_section($doc_obj->get_end_child($cursection));
+	    }
+
+	    # add the metadata to this section
+	    $self->HB_add_metadata ($doc_obj, $cursection, "Title", $title);
+
+	    # clean up the section html
+	    $sectiontext = $self->HB_clean_section($sectiontext);
+
+	    # associate any files
+	    map { $doc_obj->associate_file(&util::filename_cat ($base_dir, $file, $1), $1)
+		      if /_httpdocimg_\/([^\"]+)\"/; 0; }
+	         split (/(_httpdocimg_\/[^\"]+\")/, $sectiontext);
+
+	    # add the text for this section
+# All read text should now be in utf-8
+#	    if ($self->{'input_encoding'} eq "ascii") {
+	    $doc_obj->add_utf8_text ($cursection, $sectiontext);
+#	    } else {
+#		$doc_obj->add_text ($cursection, $sectiontext);
+#	    }
+	} else {
+	    print $outhandle "WARNING - leftover text\n" , $self->shorten($html), 
+	    "\nin $htmlfile\n";
+	    last;
+	}
+	$firstsection = 0;
+    }
+
+    # add a OID
+    $doc_obj->set_OID ();
+
+    # process the document
+    $processor->process($doc_obj, &util::filename_cat($file, "$jobnumber.htm"));
+        
+    return 1; # processed the file
+}
+
+
+1;
Index: dl/trunk/perllib/plugins/HTMLPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/HTMLPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,1444 +1,0 @@
-###########################################################################
-#
-# HTMLPlug.pm -- basic html plugin
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999 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.
-#
-###########################################################################
-
-# 
-# Note that this plugin handles frames only in a very simple way
-# i.e. each frame is treated as a separate document. This means
-# search results will contain links to individual frames rather
-# than linking to the top level frameset.
-# There may also be some problems caused by the _parent target
-# (it's removed by this plugin)
-#
-
-package HTMLPlug;
-
-use BasPlug;
-use ghtml;
-use unicode;
-use util;
-use XMLParser;
-
-use Image::Size;
-use File::Copy;
-
-sub BEGIN {
-    @HTMLPlug::ISA = ('BasPlug');
-}
-
-use strict; # every perl program should have this!
-no strict 'refs'; # make an exception so we can use variables as filehandles
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' =>  &get_default_process_exp() },
-      { 'name' => "block_exp",
-	'desc' => "{BasPlug.block_exp}",
-	'type' => 'regexp',
-	'deft' =>  &get_default_block_exp() },
-      { 'name' => "nolinks",
-	'desc' => "{HTMLPlug.nolinks}",
-	'type' => "flag" },
-      { 'name' => "keep_head",
-	'desc' => "{HTMLPlug.keep_head}",
-	'type' => "flag" },
-      { 'name' => "no_metadata",
-	'desc' => "{HTMLPlug.no_metadata}",
-	'type' => "flag" },
-      { 'name' => "metadata_fields",
-	'desc' => "{HTMLPlug.metadata_fields}",
-	'type' => "string",
-	'deft' => "Title" },
-      { 'name' => "hunt_creator_metadata",
-	'desc' => "{HTMLPlug.hunt_creator_metadata}",
-	'type' => "flag" },
-      { 'name' => "file_is_url",
-	'desc' => "{HTMLPlug.file_is_url}",
-	'type' => "flag" },
-      { 'name' => "assoc_files",
-	'desc' => "{HTMLPlug.assoc_files}",
-	'type' => "regexp",
-	'deft' => &get_default_block_exp() },
-      { 'name' => "rename_assoc_files",
-	'desc' => "{HTMLPlug.rename_assoc_files}",
-	'type' => "flag" },
-      { 'name' => "title_sub",
-	'desc' => "{HTMLPlug.title_sub}",
-	'type' => "string", 
-	'deft' => "" },
-      { 'name' => "description_tags",
-	'desc' => "{HTMLPlug.description_tags}",
-	'type' => "flag" },
-      # retain this for backward compatibility (w3mir option was replaced by
-      # file_is_url)
-      { 'name' => "w3mir",
-#	'desc' => "{HTMLPlug.w3mir}",
-	'type' => "flag",
-	'hiddengli' => "yes"},
-      { 'name' => "no_strip_metadata_html",
-	'desc' => "{HTMLPlug.no_strip_metadata_html}",
-	'type' => "string",
-	'deft' => "",
-	'reqd' => "no"},
-      { 'name' => "sectionalise_using_h_tags",
-	'desc' => "{HTMLPlug.sectionalise_using_h_tags}",
-	'type' => "flag" },
-      { 'name' => "use_realistic_book",
-        'desc' => "{HTMLPlug.tidy_html}",
-	'type' => "flag"},
-      { 'name' => "is_old_HDL_tags",
-        'desc' => "{HTMLPlug.old_style_HDL}",
-	'type' => "flag"},
-      { 'name' => "no_image_links",            # in future think about removing this option,
-        'desc' => "{HTMLPlug.no_image_links}", # since it has become the default behaviour
-	'type' => "flag"},	
-      ];
-
-my $options = { 'name'     => "HTMLPlug",
-		'desc'     => "{HTMLPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-
-sub HB_read_html_file {
-    my $self = shift (@_);
-    my ($htmlfile, $text) = @_;
-        
-    # load in the file
-    if (!open (FILE, $htmlfile)) {
-	print STDERR "ERROR - could not open $htmlfile\n";
-	return;
-    }
-
-    my $foundbody = 0;
-    $self->HB_gettext (\$foundbody, $text, "FILE");
-    close FILE;
-    
-    # just in case there was no <body> tag
-    if (!$foundbody) {
-	$foundbody = 1;
-	open (FILE, $htmlfile) || return;
-	$self->HB_gettext (\$foundbody, $text, "FILE");	
-	close FILE;
-    }
-    # text is in utf8
-}		
-
-# converts the text to utf8, as ghtml does that for &eacute; etc.
-sub HB_gettext {
-    my $self = shift (@_);
-    my ($foundbody, $text, $handle) = @_;
-   
-    my $line = "";
-    while (defined ($line = <$handle>)) {
-	# look for body tag
-	if (!$$foundbody) {
-	    if ($line =~ s/^.*<body[^>]*>//i) {
-		$$foundbody = 1;
-	    } else {
-		next;
-	    }
-	}
-	
-	# check for symbol fonts
-	if ($line =~ /<font [^>]*?face\s*=\s*\"?(\w+)\"?/i) {
-	    my $font = $1;
-	    print STDERR "HBPlug::HB_gettext - warning removed font $font\n" 
-		if ($font !~ /^arial$/i);
-	}
-
-	$$text .= $line;
-    }
-
-   if ($self->{'input_encoding'} eq "iso_8859_1") {
-	# convert to utf-8
-	$$text=&unicode::unicode2utf8(&unicode::convert2unicode("iso_8859_1", $text));
-    }
-    # convert any alphanumeric character entities to their utf-8
-    # equivalent for indexing purposes
-    #&ghtml::convertcharentities ($$text);
-
-    $$text =~ s/\s+/ /g; # remove \n's
-}
-
-sub HB_clean_section {
-    my $self = shift (@_);
-    my ($section) = @_;
-
-    # remove tags without a starting tag from the section
-    my ($tag, $tagstart);
-    while ($section =~ /<\/([^>]{1,10})>/) {
-	$tag = $1;
-	$tagstart = index($section, "<$tag");
-	last if (($tagstart >= 0) && ($tagstart < index($section, "<\/$tag")));
-	$section =~ s/<\/$tag>//;
-    }
-    
-    # remove extra paragraph tags
-    while ($section =~ s/<p\b[^>]*>\s*<p\b/<p/ig) {}
-    
-    # remove extra stuff at the end of the section
-    while ($section =~ s/(<u>|<i>|<b>|<p\b[^>]*>|&nbsp;|\s)$//i) {}
-    
-    # add a newline at the beginning of each paragraph
-    $section =~ s/(.)\s*<p\b/$1\n\n<p/gi;
-    
-    # add a newline every 80 characters at a word boundary
-    # Note: this regular expression puts a line feed before
-    # the last word in each section, even when it is not
-    # needed.
-    $section =~ s/(.{1,80})\s/$1\n/g;
-    
-    # fix up the image links
-    $section =~ s/<img[^>]*?src=\"?([^\">]+)\"?[^>]*>/
-	<center><img src=\"$1\" \/><\/center><br\/>/ig;
-    $section =~ s/&lt;&lt;I&gt;&gt;\s*([^\.]+\.(png|jpg|gif))/
-	<center><img src=\"$1\" \/><\/center><br\/>/ig;
-
-    return $section;
-}
-		
-# Will convert the oldHDL format to the new HDL format (using the Section tag)	
-sub convert_to_newHDLformat
-{
-   my $self = shift (@_);
-   my ($file,$cnfile) = @_;
-   my $input_filename = $file;
-   my $tmp_filename = $cnfile;
-   
-   # write HTML tmp file with new HDL format
-   open (PROD, ">$tmp_filename") || die("Error Writing to File: $tmp_filename $!");
-   
-   # read in the file and do basic html cleaning (removing header etc)
-   my $html = "";
-   $self->HB_read_html_file ($input_filename, \$html);
-   
-    # process the file one section at a time
-    my $curtoclevel = 1;
-    my $firstsection = 1;
-    my $toclevel = 0;
-    while (length ($html) > 0) {
-	if ($html =~ s/^.*?(?:<p\b[^>]*>)?((<b>|<i>|<u>|\s)*)&lt;&lt;TOC(\d+)&gt;&gt;\s*(.*?)<p\b/<p/i) {
-	    $toclevel = $3;
-	    my $title = $4;
-	    my $sectiontext = "";
-	    if ($html =~ s/^(.*?)((?:<p\b[^>]*>)?((<b>|<i>|<u>|\s)*)&lt;&lt;TOC\d+&gt;&gt;)/$2/i) {
-		$sectiontext = $1;
-	    } else {
-		$sectiontext = $html;
-		$html = "";
-	    }
-
-	    # remove tags and extra spaces from the title
-	    $title =~ s/<\/?[^>]+>//g;
-	    $title =~ s/^\s+|\s+$//g;
-
-	    # close any sections below the current level and
-	    # create a new section (special case for the firstsection)
-	    print PROD "<!--\n";
-	    while (($curtoclevel > $toclevel) ||
-		   (!$firstsection && $curtoclevel == $toclevel)) {
-		$curtoclevel--;
-		print PROD "</Section>\n";
-	    }
-	    if ($curtoclevel+1 < $toclevel) {
-		print STDERR "WARNING - jump in toc levels in $input_filename " . 
-		    "from $curtoclevel to $toclevel\n";
-	    }
-	    while ($curtoclevel < $toclevel) {
-		$curtoclevel++;
-	    }
-
-	    if ($curtoclevel == 1) {
-	    	# add the header tag
-		print PROD "-->\n";
-    		print PROD "<HTML>\n<HEAD>\n<TITLE>$title</TITLE>\n</HEAD>\n<BODY>\n";
-		print PROD "<!--\n";
-	    }
-	    
-	    print PROD "<Section>\n\t<Description>\n\t\t<Metadata name=\"Title\">$title</Metadata>\n\t</Description>\n";
-	   
-	    print PROD "-->\n";
-	     
-	    # clean up the section html
-	    $sectiontext = $self->HB_clean_section($sectiontext);
-
-	    print PROD "$sectiontext\n";	 
-
-	} else {
-	    print STDERR "WARNING - leftover text\n" , $self->shorten($html), 
-	    "\nin $input_filename\n";
-	    last;
-	}
-	$firstsection = 0;
-    }
-    
-    print PROD "<!--\n";
-    while ($curtoclevel > 0) {
-	$curtoclevel--;
-	print PROD "</Section>\n";
-    }
-    print PROD "-->\n";
-    
-    close (PROD) || die("Error Closing File: $tmp_filename $!");
-    
-    return $tmp_filename;
-}		
-
-sub shorten {
-    my $self = shift (@_);
-    my ($text) = @_;
-
-    return "\"$text\"" if (length($text) < 100);
-
-    return "\"" . substr ($text, 0, 50) . "\" ... \"" . 
-	substr ($text, length($text)-50) . "\"";
-}
-
-sub convert_tidy_or_oldHDL_file
-{
-    my $self = shift (@_);
-    my ($file) = @_;
-    my $input_filename = $file;
- 
-    if (-d $input_filename)
-    {
-    	return $input_filename;
-    }
-    
-    # get the input filename
-    my ($tailname, $dirname, $suffix) = &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
-    my $base_dirname = $dirname;
-    $suffix = lc($suffix);   
-    
-    # derive tmp filename from input filename
-    # Remove any white space from filename -- no risk of name collision, and
-    # makes later conversion by utils simpler. Leave spaces in path...
-    # tidy up the filename with space, dot, hyphen between
-    $tailname =~ s/\s+//g; 
-    $tailname =~ s/\.+//g;
-    $tailname =~ s/\-+//g;
-    # convert to utf-8 otherwise we have problems with the doc.xml file
-    # later on
-    &unicode::ensure_utf8(\$tailname);
-    
-    # softlink to collection tmp dir
-    my $tmp_dirname = &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, "tidytmp");
-    &util::mk_dir($tmp_dirname) if (!-e $tmp_dirname);
-    
-    my $test_dirname = "";
-    my $f_separator = &util::get_os_dirsep();
-    
-   if ($dirname =~ /import$f_separator/)
-    {
-    	$test_dirname = $';
-	
-	#print STDERR "init $'\n";
-	
-	while ($test_dirname =~ /[$f_separator]/)
-	{
-		my $folderdirname = $`;
-		$tmp_dirname = &util::filename_cat($tmp_dirname,$folderdirname);
-       		&util::mk_dir($tmp_dirname) if (!-e $tmp_dirname);
-		$test_dirname = $';
-	}
-    }
-    
-    my $tmp_filename = &util::filename_cat($tmp_dirname, "$tailname$suffix");
-    
-    # tidy or convert the input file if it is a HTML-like file or it is accepted by the process_exp
-    if (($suffix eq ".htm") || ($suffix eq ".html") || ($suffix eq ".shtml"))
-    {   
-    	#convert the input file to a new style HDL
-    	my $hdl_output_filename = $input_filename;
-    	if ($self->{'old_style_HDL'})
-    	{
-		$hdl_output_filename = &util::filename_cat($tmp_dirname, "$tailname$suffix");
-		$hdl_output_filename = $self->convert_to_newHDLformat($input_filename,$hdl_output_filename);
-    	}
-	
-	#just for checking copy all other file from the base dir to tmp dir if it is not exists
-	opendir(DIR,$base_dirname) or die "Can't open base directory : $base_dirname!";
-	my @files = grep {!/^\.+$/} readdir(DIR);
-	close(DIR);
-
-	foreach my $file (@files) 
-	{
-		my $src_file = &util::filename_cat($base_dirname,$file);
-		my $dest_file = &util::filename_cat($tmp_dirname,$file);
-		if ((!-e $dest_file) && (!-d $src_file))
-		{
-			# just copy the original file back to the tmp directory
-			copy($src_file,$dest_file) or die "Can't copy file $src_file to $dest_file $!";
-		}
-	}
-	
-	# tidy the input file
-	my $tidy_output_filename = $hdl_output_filename;
-	if ($self->{'tidy_html'})
-	{
-		$tidy_output_filename = &util::filename_cat($tmp_dirname, "$tailname$suffix");
-		$tidy_output_filename = $self->tmp_tidy_file($hdl_output_filename,$tidy_output_filename);
-	}
-	$tmp_filename = $tidy_output_filename;
-    }
-    else
-    {
-    	if (!-e $tmp_filename)
-	{
-    		# just copy the original file back to the tmp directory
-		copy($input_filename,$tmp_filename) or die "Can't copy file $input_filename to $tmp_filename $!";
-	}
-    }
-    
-    return $tmp_filename;
-}
-
-	
-# Will make the html input file as a proper XML file with removed font tag and
-# image size added to the img tag.
-# The tidying process takes place in a collection specific 'tmp' directory so 
-# that we don't accidentally damage the input.
-sub tmp_tidy_file 
-{
-    my $self = shift (@_);
-    my ($file,$cnfile) = @_;
-    my $input_filename = $file;
-    my $tmp_filename = $cnfile;
- 
-    # get the input filename
-    my ($tailname, $dirname, $suffix) = &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
-
-    require HTML::TokeParser::Simple;
-	
-    	# create HTML parser to decode the input file
-    	my $parser = HTML::TokeParser::Simple->new($input_filename);
-
-    	# write HTML tmp file without the font tag and image size are added to the img tag
-    	open (PROD, ">$tmp_filename") || die("Error Writing to File: $tmp_filename $!");
-    	while (my $token = $parser->get_token())
-    	{
-		# is it an img tag
-		if ($token->is_start_tag('img'))
-		{
-	    		# get the attributes
-	    		my $attr = $token->return_attr;
-
-	    		# get the full path to the image
-	    		my $img_file = &util::filename_cat($dirname,$attr->{src});
-	    
-	    		# set the width and height attribute
-	    		($attr->{width}, $attr->{height}) = imgsize($img_file);
-
-	    		# recreate the tag
-	    		print PROD "<img";
-	    		print PROD map { qq { $_="$attr->{$_}"} } keys %$attr;
-	    		print PROD ">";
-		}
-		# is it a font tag
-		else 
-		{
-	   		if (($token->is_start_tag('font')) || ($token->is_end_tag('font')))
-	   		{
-				# remove font tag
-				print PROD "";
-	   		}
-	   		else
-	  		{
-				# print without changes
-				print PROD $token->as_is;
-	   		}
-		}
-    	}
-    	close (PROD) || die("Error Closing File: $tmp_filename $!");
-
-    	# run html-tidy on the tmp file to make it a proper XML file
-    	my $tidyfile = `tidy -utf8 -wrap 0 -asxml $tmp_filename`;
-
-    	# write result back to the tmp file
-    	open (PROD, ">$tmp_filename") || die("Error Writing to File: $tmp_filename $!");
-    	print PROD $tidyfile;
-    	close (PROD) || die("Error Closing File: $tmp_filename $!");
-    
-    # return the output filename
-    return $tmp_filename;
-} 
-
-sub read_into_doc_obj 
-{
-    my $self = shift (@_);  
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-    
-    # check the process_exp and block_exp thing
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-    
-    # get the input file
-    my $input_filename = $file;
-    my ($tailname, $dirname, $suffix) = &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
-    $suffix = lc($suffix);   
-    
-    if (($self->{'tidy_html'}) || ($self->{'old_style_HDL'}))
-    {
-		# because the document has to be sectionalized set the description tags 
-		$self->{'description_tags'} = 1;
-
-		# set the file to be tidied
-    		$input_filename = &util::filename_cat($base_dir,$file) if $base_dir =~ /\w/;
-		
-    		# get the tidied file
-    		#my $tidy_filename = $self->tmp_tidy_file($input_filename);
-		my $tidy_filename = $self->convert_tidy_or_oldHDL_file($input_filename);
-		
-    		# derive tmp filename from input filename
-    		my ($tailname, $dirname, $suffix) = &File::Basename::fileparse($tidy_filename, "\\.[^\\.]+\$");
-	
-		# set the new input file and base_dir to be from the tidied file
-		$file = "$tailname$suffix";
-		$base_dir = $dirname;
-    }
-    
-    # call the parent read_into_doc_obj
-    my ($process_status,$doc_obj) = &BasPlug::read_into_doc_obj($self,$pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli);
-    
-    return ($process_status,$doc_obj);
-}
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-    
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-   
-
-    my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs);
-    
-    if ($self->{'w3mir'}) {
-	$self->{'file_is_url'} = 1;
-    }
-    $self->{'aux_files'} = {};
-    $self->{'dir_num'} = 0;
-    $self->{'file_num'} = 0;
-    
-    return bless $self, $class;
-}
-
-# may want to use (?i)\.(gif|jpe?g|jpe|png|css|js(?:@.*)?)$
-# if have eg <script language="javascript" src="img/lib.js@123">
-sub get_default_block_exp {
-    my $self = shift (@_);
-    
-    return q^(?i)\.(gif|jpe?g|jpe|jpg|png|css)$^;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-    
-    # the last option is an attempt to encode the concept of an html query ...
-    return q^(?i)(\.html?|\.shtml|\.shm|\.asp|\.php\d?|\.cgi|.+\?.+=.*)$^;
-}
-
-sub store_block_files
-{
-    my $self =shift (@_);
-    my ($filename) = @_;
-    my $html_fname = $filename;
-    my @file_blocks;
-    
-    my ($language, $encoding) = $self->textcat_get_language_encoding ($filename);
-
-    # read in file ($text will be in utf8)
-    my $text = "";
-    $self->read_file ($filename, $encoding, $language, \$text);
-    my $textref = \$text;
-    my $opencom = '(?:<!--|&lt;!(?:&mdash;|&#151;|--))';
-    my $closecom = '(?:-->|(?:&mdash;|&#151;|--)&gt;)';
-    $$textref =~ s/$opencom(.*?)$closecom//gs;
-
-    my $attval = "\\\"[^\\\"]+\\\"|[^\\s>]+";
-    my @img_matches = ($$textref =~ m/<img[^>]*?src\s*=\s*($attval)[^>]*>/igs);
-    my @usemap_matches = ($$textref =~ m/<img[^>]*?usemap\s*=\s*($attval)[^>]*>/igs);
-    my @link_matches = ($$textref =~ m/<link[^>]*?href\s*=\s*($attval)[^>]*>/igs);
-    my @embed_matches = ($$textref =~ m/<embed[^>]*?src\s*=\s*($attval)[^>]*>/igs);
-    my @tabbg_matches = ($$textref =~ m/<(?:table|tr|td)[^>]*?background\s*=\s*($attval)[^>]*>/igs);
-
-    foreach my $link (@img_matches, @usemap_matches, @link_matches, @embed_matches, @tabbg_matches) {
-
-	# remove quotes from link at start and end if necessary
-	if ($link=~/^\"/) {
-	    $link=~s/^\"//;
-	    $link=~s/\"$//;
-	}
-
-	$link =~ s/\#.*$//s; # remove any anchor names, e.g. foo.html#name becomes foo.html
-
-	if ($link !~ m@^/@ && $link !~ m/^([A-Z]:?)\\/) {
-	    # Turn relative file path into full path
-	    my $dirname = &File::Basename::dirname($filename);
-	    $link = &util::filename_cat($dirname, $link);
-	}
-	$link = $self->eval_dir_dots($link);
-	
-	$self->{'file_blocks'}->{$link} = 1;
-    }
-}
-
-  
-# do plugin specific processing of doc_obj
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    print STDERR "<Processing n='$file' p='HTMLPlug'>\n" if ($gli);
-
-    print $outhandle "HTMLPlug: processing $file\n"
-	if $self->{'verbosity'} > 1;
-
-    if ($ENV{'GSDLOS'} =~ /^windows/i) {
-      # this makes life so much easier... perl can cope with unix-style '/'s.
-      $base_dir =~ s@(\\)+@/@g;
-      $file =~ s@(\\)+@/@g; 
-    }
-    
-    # reset per-doc stuff...
-    $self->{'aux_files'} = {};
-    $self->{'dir_num'} = 0;
-    $self->{'file_num'} = 0;
-
-    # process an HTML file where sections are divided by headings tags (H1, H2 ...)
-    # you can also include metadata in the format (X can be any number)
-    # <hX>Title<!--gsdl-metadata
-    #	<Metadata name="name1">value1</Metadata>
-    #	...
-    #	<Metadata name="nameN">valueN</Metadata>
-    #--></hX>
-    if ($self->{'sectionalise_using_h_tags'}) {
-	# description_tags should allways be activated because we convert headings to description tags
-	$self->{'description_tags'} = 1;
-
-	my $arrSections = [];
-	$$textref =~ s/<h([0-9]+)[^>]*>(.*?)<\/h[0-9]+>/$self->process_heading($1, $2, $arrSections, $file)/isge;
-
-	if (scalar(@$arrSections)) {
-	    my $strMetadata = $self->update_section_data($arrSections, -1);
-	    if (length($strMetadata)) {
-		$strMetadata = '<!--' . $strMetadata . "\n-->\n</body>";
-		$$textref =~ s/<\/body>/$strMetadata/ig;
-	    }
-	}
-    }
-
-    my $cursection = $doc_obj->get_top_section();
-
-    $self->extract_metadata ($textref, $metadata, $doc_obj, $cursection)
-	unless $self->{'no_metadata'} || $self->{'description_tags'};
-
-    # Store URL for page as metadata - this can be used for an
-    # altavista style search interface. The URL won't be valid
-    # unless the file structure contains the domain name (i.e.
-    # like when w3mir is used to download a website).
-
-    # URL metadata (even invalid ones) are used to support internal
-    # links, so even if 'file_is_url' is off, still need to store info
-    
-    $file = &BasPlug::filename_to_metadata($self, $file); # ensures filename is in UTF8 character encoding
-    my $web_url = "http://$file";
-    $doc_obj->add_utf8_metadata($cursection, "URL", $web_url); # will eventually ensure it is utf8 anyway
-
-    if ($self->{'file_is_url'}) {
-	$doc_obj->add_metadata($cursection, "weblink", "<a href=\"$web_url\">");
-	$doc_obj->add_metadata($cursection, "webicon", "_iconworld_");
-	$doc_obj->add_metadata($cursection, "/weblink", "</a>");
-    }
-
-    if ($self->{'description_tags'}) {
-	# remove the html header - note that doing this here means any
-	# sections defined within the header will be lost (so all <Section>
-	# tags must appear within the body of the HTML)
-	my ($head_keep) = ($$textref =~ m/^(.*?)<body[^>]*>/is);
-
-	$$textref =~ s/^.*?<body[^>]*>//is;
-	$$textref =~ s/(<\/body[^>]*>|<\/html[^>]*>)//isg;
-
-	my $opencom = '(?:<!--|&lt;!(?:&mdash;|&#151;|--))';
-	my $closecom = '(?:-->|(?:&mdash;|&#151;|--)&gt;)';
-
-	my $lt = '(?:<|&lt;)';
-	my $gt = '(?:>|&gt;)';
-	my $quot = '(?:"|&quot;|&rdquo;|&ldquo;)';
-
-	my $dont_strip = '';
-	if ($self->{'no_strip_metadata_html'}) {
-	    ($dont_strip = $self->{'no_strip_metadata_html'}) =~ s{,}{|}g;
-	}
-
-	my $found_something = 0; my $top = 1;
-	while ($$textref =~ s/^(.*?)$opencom(.*?)$closecom//s) {
-	    my $text = $1;
-	    my $comment = $2;
-	    if (defined $text) {
-		# text before a comment - note that getting to here
-		# doesn't necessarily mean there are Section tags in
-		# the document
-		$self->process_section(\$text, $base_dir, $file, $doc_obj, $cursection);
-	    }
-	    while ($comment =~ s/$lt(.*?)$gt//s) {
-		my $tag = $1;
-		if ($tag eq "Section") {
-		    $found_something = 1;
-		    $cursection = $doc_obj->insert_section($doc_obj->get_end_child($cursection)) unless $top;
-		    $top = 0;
-		} elsif ($tag eq "/Section") {
-		    $found_something = 1;
-		    $cursection = $doc_obj->get_parent_section ($cursection);
-		} elsif ($tag =~ /^Metadata name=$quot(.*?)$quot/s) {
-		    my $metaname = $1;
-		    my $accumulate = $tag =~ /mode=${quot}accumulate${quot}/ ? 1 : 0;
-		    $comment =~ s/^(.*?)$lt\/Metadata$gt//s;
-		    my $metavalue = $1;
-		    $metavalue =~ s/^\s+//;
-		    $metavalue =~ s/\s+$//;
-                    # assume that no metadata value intentionally includes
-                    # carriage returns or HTML tags (if they're there they
-                    # were probably introduced when converting to HTML from
-                    # some other format).
-		    # actually some people want to have html tags in their
-		    # metadata.
-		    $metavalue =~ s/[\cJ\cM]/ /sg;
-		    $metavalue =~ s/<[^>]+>//sg
-			unless $dont_strip && ($dont_strip eq 'all' || $metaname =~ /^($dont_strip)$/);
-		    $metavalue =~ s/\s+/ /sg;
-		    if ($accumulate) {
-			$doc_obj->add_utf8_metadata($cursection, $metaname, $metavalue);
-		    } else {
-			$doc_obj->set_utf8_metadata_element($cursection, $metaname, $metavalue);	
-		    }
-		} elsif ($tag eq "Description" || $tag eq "/Description") {
-		    # do nothing with containing Description tags
-		} else {
-		    # simple HTML tag (probably created by the conversion
-		    # to HTML from some other format) - we'll ignore it and
-		    # hope for the best ;-)
-		}
-	    }
-	}
-	if ($cursection ne "") {
-	    print $outhandle "HTMLPlug: WARNING: $file contains unmatched <Section></Section> tags\n";
-	}
-
-	$$textref =~ s/^.*?<body[^>]*>//is;
-	$$textref =~ s/(<\/body[^>]*>|<\/html[^>]*>)//isg;
-	if ($$textref =~ /\S/) {
-	    if (!$found_something) {
-		if ($self->{'verbosity'} > 2) {
-		    print $outhandle "HTMLPlug: WARNING: $file appears to contain no Section tags so\n";
-		    print $outhandle "          will be processed as a single section document\n";
-		}
-
-		# go ahead and process single-section document
-		$self->process_section($textref, $base_dir, $file, $doc_obj, $cursection);
-
-		# if document contains no Section tags we'll go ahead
-		# and extract metadata (this won't have been done
-		# above as the -description_tags option prevents it)
-		my $complete_text = $head_keep.$doc_obj->get_text($cursection);
-		$self->extract_metadata (\$complete_text, $metadata, $doc_obj, $cursection) 
-		    unless $self->{'no_metadata'};
-
-	    } else {
-		print $outhandle "HTMLPlug: WARNING: $file contains the following text outside\n";
-		print $outhandle "          of the final closing </Section> tag. This text will\n";
-		print $outhandle "          be ignored.";
-
-		my ($text);
-		if (length($$textref) > 30) {
-		    $text = substr($$textref, 0, 30) . "...";
-		} else {
-		    $text = $$textref;
-		}
-		$text =~ s/\n/ /isg;
-		print $outhandle " ($text)\n";
-	    }
-	} elsif (!$found_something) {
-
-	    if ($self->{'verbosity'} > 2) {
-		# may get to here if document contained no valid Section
-		# tags but did contain some comments. The text will have
-		# been processed already but we should print the warning
-		# as above and extract metadata
-		print $outhandle "HTMLPlug: WARNING: $file appears to contain no Section tags and\n";
-		print $outhandle "          is blank or empty.  Metadata will be assigned if present.\n";
-	    }
-
-	    my $complete_text = $head_keep.$doc_obj->get_text($cursection);
-	    $self->extract_metadata (\$complete_text, $metadata, $doc_obj, $cursection) 
-		unless $self->{'no_metadata'};
-	}
-	
-    } else {
-
-	# remove header and footer
-	if (!$self->{'keep_head'} || $self->{'description_tags'}) {
-	    $$textref =~ s/^.*?<body[^>]*>//is;
-	    $$textref =~ s/(<\/body[^>]*>|<\/html[^>]*>)//isg;
-	}
-
-	# single section document
-	$self->process_section($textref, $base_dir, $file, $doc_obj, $cursection);
-    }
-    return 1;
-}
-
-
-sub process_heading
-{
-    my ($self, $nHeadNo, $strHeadingText, $arrSections, $file) = @_;
-    $strHeadingText = '' if (!defined($strHeadingText));
-
-    my $strMetadata = $self->update_section_data($arrSections, int($nHeadNo));
-
-    my $strSecMetadata = '';
-    while ($strHeadingText =~ s/<!--gsdl-metadata(.*?)-->//is)
-    {
-	$strSecMetadata .= $1;
-    }
-
-    $strHeadingText =~ s/^\s+//g;
-    $strHeadingText =~ s/\s+$//g;
-    $strSecMetadata =~ s/^\s+//g;
-    $strSecMetadata =~ s/\s+$//g;
-
-    $strMetadata .= "\n<Section>\n\t<Description>\n\t\t<Metadata name=\"Title\">" . $strHeadingText . "</Metadata>\n";
-
-    if (length($strSecMetadata)) {
-	$strMetadata .= "\t\t" . $strSecMetadata . "\n";
-    }
-
-    $strMetadata .= "\t</Description>\n";
-
-    return "<!--" . $strMetadata . "-->";
-}
-
-
-sub update_section_data
-{
-    my ($self, $arrSections, $nCurTocNo) = @_;
-    my ($strBuffer, $nLast, $nSections) = ('', 0, scalar(@$arrSections));
-
-    if ($nSections == 0) {
-	push @$arrSections, $nCurTocNo;
-	return $strBuffer;
-    }
-    $nLast = $arrSections->[$nSections - 1];
-    if ($nCurTocNo > $nLast) {
-	push @$arrSections, $nCurTocNo;
-	return $strBuffer;
-    }
-    for(my $i = $nSections - 1; $i >= 0; $i--) {
-	if ($nCurTocNo <= $arrSections->[$i]) {
-	    $strBuffer .= "\n</Section>";
-	    pop @$arrSections;
-	}
-    }
-    push @$arrSections, $nCurTocNo;
-    return $strBuffer;
-}
-
-
-# note that process_section may be called multiple times for a single
-# section (relying on the fact that add_utf8_text appends the text to any
-# that may exist already).
-sub process_section {
-    my $self = shift (@_);
-    my ($textref, $base_dir, $file, $doc_obj, $cursection) = @_;
-    # trap links
-    if (!$self->{'nolinks'}) {
-	# usemap="./#index" not handled correctly => change to "#index"
-	$$textref =~ s/(<img[^>]*?usemap\s*=\s*[\"\']?)([^\"\'>\s]+)([\"\']?[^>]*>)/
-	    $self->replace_usemap_links($1, $2, $3)/isge;
-
-	$$textref =~ s/(<(?:a|area|frame|link|script)\s+[^>]*?\s*(?:href|src)\s*=\s*[\"\']?)([^\"\'>\s]+)([\"\']?[^>]*>)/
-	    $self->replace_href_links ($1, $2, $3, $base_dir, $file, $doc_obj, $cursection)/isge;
-    }
-
-    # trap images
-
-    # Previously, by default, HTMLPlug would embed <img> tags inside anchor tags
-    # i.e. <a href="image><img src="image"></a> in order to overcome a problem that
-    # turned regular text succeeding images into links. That is, by embedding <imgs>
-    # inside <a href=""></a>, the text following images were no longer misbehaving.
-    # However, there would be many occasions whereby images were not meant to link
-    # to their source images but where the images would link to another web page.
-    # To allow this, the no_image_links option was introduced: it would prevent
-    # the behaviour of embedding images into links that referenced the source images.
-
-    # Somewhere along the line, the problem of normal text turning into links when 
-    # such text followed images which were not embedded in <a href=""></a> ceased 
-    # to occur. This is why the following lines have been commented out (as well as 
-    # two lines in replace_images). They appear to no longer apply.
-
-    # If at any time, there is a need for having images embedded in <a> anchor tags,
-    # then it might be better to turn that into an HTMLPlug option rather than make
-    # it the default behaviour. Also, eventually, no_image_links needs to become
-    # a deprecated option for HTMLPlug as it has now become the default behaviour.
-
-    #if(!$self->{'no_image_links'}){
-    $$textref =~ s/(<(?:img|embed|table|tr|td)[^>]*?(?:src|background)\s*=\s*)([\"][^\"]+[\"]|[\'][^\']+[\']|[^\s\/>]+)([^>]*>)/
-    	$self->replace_images ($1, $2, $3, $base_dir, $file, $doc_obj, $cursection)/isge;
-    #}
-
-    # add text to document object
-    # turn \ into \\ so that the rest of greenstone doesn't think there
-    # is an escape code following. (Macro parsing loses them...)
-    $$textref =~ s/\\/\\\\/go;
-    
-    $doc_obj->add_utf8_text($cursection, $$textref);
-}
-
-sub replace_images {
-    my $self = shift (@_);
-    my ($front, $link, $back, $base_dir, 
-	$file, $doc_obj, $section) = @_;
-
-    # remove quotes from link at start and end if necessary
-    if ($link=~/^[\"\']/) {
-	$link=~s/^[\"\']//;
-	$link=~s/[\"\']$//;
-	$front.='"';
-	$back="\"$back";
-    }
-    $link =~ s/\n/ /g;
-
-    # Hack to overcome Windows wv 0.7.1 bug that causes embedded images to be broken
-    # If the Word file path has spaces in it, wv messes up and you end up with
-    #   absolute paths for the images, and without the "file://" prefix
-    # So check for this special case and massage the data to be correct
-    if ($ENV{'GSDLOS'} =~ /^windows/i && $self->{'plugin_type'} eq "WordPlug" && $link =~ /^[A-Za-z]\:\\/) {
-	$link =~ s/^.*\\([^\\]+)$/$1/;
-    }
-
-    my ($href, $hash_part, $rl) = $self->format_link ($link, $base_dir, $file);
-
-    my $img_file =  $self->add_file ($href, $rl, $hash_part, $base_dir, $doc_obj, $section);
-
-    my $anchor_name = $img_file;
-    #$anchor_name =~ s/^.*\///;
-    #$anchor_name = "<a name=\"$anchor_name\" ></a>";
-
-    my $image_link = $front . $img_file .$back;
-    return $image_link;
-
-    # The reasons for why the following two lines are no longer necessary can be 
-    # found in subroutine process_section
-    #my $anchor_link = "<a href=\"$img_file\" >".$image_link."</a>";  
-    #return $anchor_link;	
-    
-    #return $front . $img_file . $back . $anchor_name;
-}
-
-sub replace_href_links {
-    my $self = shift (@_);
-    my ($front, $link, $back, $base_dir, $file, $doc_obj, $section) = @_;
-
-    # attempt to sort out targets - frames are not handled 
-    # well in this plugin and some cases will screw things
-    # up - e.g. the _parent target (so we'll just remove 
-    # them all ;-)
-    $front =~ s/(target=\"?)_top(\"?)/$1_gsdltop_$2/is;
-    $back =~ s/(target=\"?)_top(\"?)/$1_gsdltop_$2/is;
-    $front =~ s/target=\"?_parent\"?//is;
-    $back =~ s/target=\"?_parent\"?//is;
-
-    return $front . $link . $back if $link =~ /^\#/s;
-    $link =~ s/\n/ /g;
-
-    my ($href, $hash_part, $rl) = $self->format_link ($link, $base_dir, $file);
-    # href may use '\'s where '/'s should be on Windows
-    $href =~ s/\\/\//g;
-
-    my ($filename) = $href =~ /^(?:.*?):(?:\/\/)?(.*)/;
-    
-
-    ##### leave all these links alone (they won't be picked up by intermediate 
-    ##### pages). I think that's safest when dealing with frames, targets etc.
-    ##### (at least until I think of a better way to do it). Problems occur with
-    ##### mailto links from within small frames, the intermediate page is displayed
-    ##### within that frame and can't be seen. There is still potential for this to
-    ##### happen even with html pages - the solution seems to be to somehow tell
-    ##### the browser from the server side to display the page being sent (i.e. 
-    ##### the intermediate page) in the top level window - I'm not sure if that's 
-    ##### possible - the following line should probably be deleted if that can be done
-    return $front . $link . $back if $href =~ /^(mailto|news|gopher|nntp|telnet|javascript):/is;
-
-
-    if (($rl == 0) || ($filename =~ /$self->{'process_exp'}/) || 
-	($href =~ /\/$/) || ($href =~ /^(mailto|news|gopher|nntp|telnet|javascript):/i)) {
-	&ghtml::urlsafe ($href);
-	return $front . "_httpextlink_&rl=" . $rl . "&href=" . $href . $hash_part . $back;
-    } else {
-	# link is to some other type of file (eg image) so we'll
-	# need to associate that file
-	return $front . $self->add_file ($href, $rl, $hash_part, $base_dir, $doc_obj, $section) . $back;
-    }
-}
-
-sub add_file {
-    my $self = shift (@_);
-    my ($href, $rl, $hash_part, $base_dir, $doc_obj, $section) = @_;
-    my ($newname);
-
-    my $filename = $href;
-    if ($base_dir eq "") {
-	# remove http:/ thereby leaving one slash at the start
-	$filename =~ s/^[^:]*:\///;
-    }
-    else {
-	# remove http://
-	$filename =~ s/^[^:]*:\/\///;
-    }
-
-    $filename = &util::filename_cat($base_dir, $filename);
-       
-    # Replace %20's in URL with a space if required. Note that the filename
-    # may include the %20 in some situations
-    if ($filename =~ /\%20/) {
-	if (!-e $filename) {
-	    $filename =~ s/\%20/ /g;
-	}
-    }
-
-    my ($ext) = $filename =~ /(\.[^\.]*)$/;
-
-    if ($rl == 0) {
-	if ((!defined $ext) || ($ext !~ /$self->{'assoc_files'}/)) {
-	    return "_httpextlink_&rl=0&el=prompt&href=" . $href . $hash_part;
-	}
-	else {
-	    return "_httpextlink_&rl=0&el=direct&href=" . $href . $hash_part;
-	}
-    }
-
-    if ((!defined $ext) || ($ext !~ /$self->{'assoc_files'}/)) {
-	return "_httpextlink_&rl=" . $rl . "&href=" . $href . $hash_part;
-    }
-    if ($self->{'rename_assoc_files'}) {
-	if (defined $self->{'aux_files'}->{$href}) {
-	    $newname = $self->{'aux_files'}->{$href}->{'dir_num'} . "/" .
-		$self->{'aux_files'}->{$href}->{'file_num'} . $ext;
-	} else {
-	    $newname = $self->{'dir_num'} . "/" . $self->{'file_num'} . $ext;
-	    $self->{'aux_files'}->{$href} = {'dir_num' => $self->{'dir_num'}, 'file_num' => $self->{'file_num'}};
-	    $self->inc_filecount ();
-	}
-	$doc_obj->associate_file($filename, $newname, undef, $section);
-	return "_httpdocimg_/$newname";
-    } else {
-	($newname) = $filename =~ /([^\/\\]*)$/;
-	$doc_obj->associate_file($filename, $newname, undef, $section);
-	return "_httpdocimg_/$newname";
-    }
-}
-
-
-sub format_link {
-    my $self = shift (@_);
-    my ($link, $base_dir, $file) = @_;
-
-    my ($before_hash, $hash_part) = $link =~ /^([^\#]*)(\#?.*)$/;
-
-    $hash_part = "" if !defined $hash_part;
-    if (!defined $before_hash || $before_hash !~ /[\w\.\/]/) {
-	my $outhandle = $self->{'outhandle'};
-	print $outhandle "HTMLPlug: ERROR - badly formatted tag ignored ($link)\n"
-	    if $self->{'verbosity'};
-	return ($link, "", 0);
-    }
-
-    if ($before_hash =~ s@^((?:http|ftp|file)://)@@i) {
-	my $type = $1;
-
-	if ($link =~ /^(http|ftp):/i) {
-	    # Turn url (using /) into file name (possibly using \ on windows)
-	    my @http_dir_split = split('/', $before_hash);
-	    $before_hash = &util::filename_cat(@http_dir_split);
-	}
-
-	$before_hash = $self->eval_dir_dots($before_hash);
-					 
-	my $linkfilename = &util::filename_cat ($base_dir, $before_hash);
-	
-	my $rl = 0;
-	$rl = 1 if (-e $linkfilename);
-
-	# make sure there's a slash on the end if it's a directory
-	if ($before_hash !~ /\/$/) {
-	    $before_hash .= "/" if (-d $linkfilename);
-	}
-
-	return ($type . $before_hash, $hash_part, $rl);
-    
-    } elsif ($link !~ /^(mailto|news|gopher|nntp|telnet|javascript):/i && $link !~ /^\//) {
-	if ($before_hash =~ s@^/@@ || $before_hash =~ /\\/) {
-
-	    # the first directory will be the domain name if file_is_url
-	    # to generate archives, otherwise we'll assume all files are
-	    # from the same site and base_dir is the root
-
-	    if ($self->{'file_is_url'}) {
-		my @dirs = split /[\/\\]/, $file;
-		my $domname = shift (@dirs);
-		$before_hash = &util::filename_cat($domname, $before_hash);
-		$before_hash =~ s@\\@/@g; # for windows
-	    }
-	    else
-	    {
-		# see if link shares directory with source document
-		# => turn into relative link if this is so!
-		
-		if ($ENV{'GSDLOS'} =~ /^windows/i) {
-		    # too difficult doing a pattern match with embedded '\'s...
-		    my $win_before_hash=$before_hash;
-		    $win_before_hash =~ s@(\\)+@/@g;
-		    # $base_dir is already similarly "converted" on windows.
-		    if ($win_before_hash =~ s@^$base_dir/@@o) {
-		      # if this is true, we removed a prefix
-		      $before_hash=$win_before_hash;
-		    }
-		}
-		else {
-		    # before_hash has lost leading slash by this point,
-		    # -> add back in prior to substitution with $base_dir
-		    $before_hash = "/$before_hash"; 
-
-		    $before_hash = &util::filename_cat("",$before_hash);
-		    $before_hash =~ s@^$base_dir/@@;
-		}
-	    }
-	} else {
-	    # Turn relative file path into full path
-	    my $dirname = &File::Basename::dirname($file);
-	    $before_hash = &util::filename_cat($dirname, $before_hash);
-	    $before_hash = $self->eval_dir_dots($before_hash);
-	}
-
-	my $linkfilename = &util::filename_cat ($base_dir, $before_hash); 
-	# make sure there's a slash on the end if it's a directory
-	if ($before_hash !~ /\/$/) {
-	    $before_hash .= "/" if (-d $linkfilename);
-	}
-	return ("http://" . $before_hash, $hash_part, 1);
-    } else {
-	# mailto, news, nntp, telnet, javascript or gopher link
-	return ($before_hash, "", 0);
-    }
-}
-
-sub extract_first_NNNN_characters {
-    my $self = shift (@_);
-    my ($textref, $doc_obj, $thissection) = @_;
-    
-    foreach my $size (split /,/, $self->{'first'}) {
-	my $tmptext =  $$textref;
-	# skip to the body
-	$tmptext =~ s/.*<body[^>]*>//i;
-	# remove javascript
-	$tmptext =~ s@<script.*?</script>@ @sig;
-	$tmptext =~ s/<[^>]*>/ /g;
-	$tmptext =~ s/&nbsp;/ /g;
-	$tmptext =~ s/^\s+//;
-	$tmptext =~ s/\s+$//;
-	$tmptext =~ s/\s+/ /gs;
-	$tmptext = &unicode::substr ($tmptext, 0, $size);
-	$tmptext =~ s/\s\S*$/&#8230;/; # adds an ellipse (...)
-	$doc_obj->add_utf8_metadata ($thissection, "First$size", $tmptext);
-    }
-}
-
-
-sub extract_metadata {
-    my $self = shift (@_);
-    my ($textref, $metadata, $doc_obj, $section) = @_;
-    my $outhandle = $self->{'outhandle'};
-    # if we don't want metadata, we may as well not be here ...
-    return if (!defined $self->{'metadata_fields'});
-
-    # metadata fields to extract/save. 'key' is the (lowercase) name of the
-    # html meta, 'value' is the metadata name for greenstone to use
-    my %find_fields = ();
-
-    my %creator_fields = (); # short-cut for lookups
-
-
-    foreach my $field (split /,/, $self->{'metadata_fields'}) {
-        $field =~ s/^\s+//; # remove leading whitespace
-        $field =~ s/\s+$//; # remove trailing whitespace
-
-	# support tag<tagname>
-	if ($field =~ /^(.*?)<(.*?)>$/) {
-	    # "$2" is the user's preferred gs metadata name
-	    $find_fields{lc($1)}=$2; # lc = lowercase
-	} else { # no <tagname> for mapping
-	    # "$field" is the user's preferred gs metadata name
-	    $find_fields{lc($field)}=$field; # lc = lowercase
-	}
-    }
-
-    if (defined $self->{'hunt_creator_metadata'} &&
-	$self->{'hunt_creator_metadata'} == 1 ) {
-	my @extra_fields =
-	    (
-	     'author',
-	     'author.email',
-	     'creator',
-	     'dc.creator',
-	     'dc.creator.corporatename',
-	     );
-
-	# add the creator_metadata fields to search for
-	foreach my $field (@extra_fields) {
-	    $creator_fields{$field}=0; # add to lookup hash
-	}
-    }
-
-
-    # find the header in the html file, which has the meta tags
-    $$textref =~ m@<head>(.*?)</head>@si;
-
-    my $html_header=$1;
-
-    # go through every <meta... tag defined in the html and see if it is
-    # one of the tags we want to match.
-    
-    # special case for title - we want to remember if its been found
-    my $found_title = 0;
-    # this assumes that ">" won't appear. (I don't think it's allowed to...)
-    $html_header =~ /^/; # match the start of the string, for \G assertion
- 
-    while ($html_header =~ m/\G.*?<meta(.*?)>/sig) {
-	my $metatag=$1;
-	my ($tag, $value);
-
-	# find the tag name
-	$metatag =~ /(?:name|http-equiv)\s*=\s*([\"\'])?(.*?)\1/is;
-	$tag=$2;
-	# in case they're not using " or ', but they should...
-	if (! $tag) {
-	    $metatag =~ /(?:name|http-equiv)\s*=\s*([^\s\>]+)/is;
-	    $tag=$1;
-	}
-
-	if (!defined $tag) {
-	    print $outhandle "HTMLPlug: can't find NAME in \"$metatag\"\n";
-	    next;
-	}
-	
-	# don't need to assign this field if it was passed in from a previous 
-	# (recursive) plugin
-	if (defined $metadata->{$tag}) {next}
-
-	# find the tag content
-	$metatag =~ /content\s*=\s*([\"\'])?(.*?)\1/is;
-	$value=$2;
-
-	if (! $value) {
-	    $metatag =~ /(?:name|http-equiv)\s*=\s*([^\s\>]+)/is;
-	    $value=$1;
-	}
-	if (!defined $value) {
-	    print $outhandle "HTMLPlug: can't find VALUE in \"$metatag\"\n";
-	    next;
-	}
-
-	# clean up and add
-	$value =~ s/\s+/ /gs;
-	chomp($value); # remove trailing \n, if any
-	if (exists $creator_fields{lc($tag)}) {
-	    # map this value onto greenstone's "Creator" metadata
-	    $tag='Creator';
-	} elsif (!exists $find_fields{lc($tag)}) {
-	     next; # don't want this tag
-	} else {
-	    # get the user's preferred capitalisation
-	    $tag = $find_fields{lc($tag)};
-	}
-	if (lc($tag) eq "title") {
-	    $found_title = 1;
-	}
-	print $outhandle " extracted \"$tag\" metadata \"$value\"\n" 
-	    if ($self->{'verbosity'} > 2);
-	if ($tag =~ /date.*/i){
-	    $tag = lc($tag);
-	}
-	$doc_obj->add_utf8_metadata($section, $tag, $value);
-
-    }
-    
-    # TITLE: extract the document title
-    if (exists $find_fields{'title'} && !$found_title) {
-	# we want a title, and didn't find one in the meta tags
-	# see if there's a <title> tag
-	my $title;
-	my $from = ""; # for debugging output only
-	if ($html_header =~ /<title[^>]*>([^<]+)<\/title[^>]*>/is) {
-	    $title = $1;
-	    $from = "<title> tags";
-	}
-
-	if (!defined $title) {
-	    $from = "first 100 chars";
-	    # if no title use first 100 or so characters
-	    $title = $$textref;
-	    $title =~ s/^\xFE\xFF//; # Remove unicode byte order mark	    
-	    $title =~ s/^.*?<body>//si;
-	    # ignore javascript!
-	    $title =~ s@<script.*?</script>@ @sig;
-	    $title =~ s/<\/([^>]+)><\1>//g; # (eg) </b><b> - no space
-	    $title =~ s/<[^>]*>/ /g; # remove all HTML tags
-	    $title = substr ($title, 0, 100);
-	    $title =~ s/\s\S*$/.../;
-	}
-	$title =~ s/<[^>]*>/ /g; # remove html tags
-	$title =~ s/&nbsp;/ /g;
-	$title =~ s/(?:&nbsp;|\xc2\xa0)/ /g; # utf-8 for nbsp...
-	$title =~ s/\s+/ /gs; # collapse multiple spaces
-	$title =~ s/^\s*//;   # remove leading spaces
-	$title =~ s/\s*$//;   # remove trailing spaces
-
-	$title =~ s/^$self->{'title_sub'}// if ($self->{'title_sub'});
-	$title =~ s/^\s+//s; # in case title_sub introduced any...
-	$doc_obj->add_utf8_metadata ($section, 'Title', $title);
-	print $outhandle " extracted Title metadata \"$title\" from $from\n" 
-	    if ($self->{'verbosity'} > 2);
-    } 
-    
-    # add FileFormat metadata
-    $doc_obj->add_metadata($section,"FileFormat", "HTML");
-
-    # Special, for metadata names such as tagH1 - extracts
-    # the text between the first <H1> and </H1> tags into "H1" metadata.
-
-    foreach my $field (keys %find_fields) {
-	if ($field !~ /^tag([a-z0-9]+)$/i) {next}
-	my $tag = $1;
-	if ($$textref =~ m@<$tag[^>]*>(.*?)</$tag[^>]*>@g) {
-	    my $content = $1;
-	    $content =~ s/&nbsp;/ /g;
-	    $content =~ s/<[^>]*>/ /g;
-	    $content =~ s/^\s+//;
-	    $content =~ s/\s+$//;
-	    $content =~ s/\s+/ /gs;
-	    if ($content) {
-		$tag=$find_fields{"tag$tag"}; # get the user's capitalisation
-		$tag =~ s/^tag//i;
-		$doc_obj->add_utf8_metadata ($section, $tag, $content);
-		print $outhandle " extracted \"$tag\" metadata \"$content\"\n" 
-		    if ($self->{'verbosity'} > 2);
-	    }
-	}
-    }    
-}
-
-
-# evaluate any "../" to next directory up
-# evaluate any "./" as here
-sub eval_dir_dots {
-    my $self = shift (@_);
-    my ($filename) = @_;
-    my $dirsep_os = &util::get_os_dirsep();
-    my @dirsep = split(/$dirsep_os/,$filename);
-
-    my @eval_dirs = ();
-    foreach my $d (@dirsep) {
-	if ($d eq "..") {
-	    pop(@eval_dirs);
-	    
-	} elsif ($d eq ".") {
-	    # do nothing!
-
-	} else {
-	    push(@eval_dirs,$d);
-	}
-    }
-
-    # Need to fiddle with number of elements in @eval_dirs if the
-    # first one is the empty string.  This is because of a
-    # modification to util::filename_cat that supresses the addition
-    # of a leading '/' character (or \ if windows) (intended to help
-    # filename cat with relative paths) if the first entry in the
-    # array is the empty string.  Making the array start with *two*
-    # empty strings is a way to defeat this "smart" option.
-    #
-    if (scalar(@eval_dirs) > 0) {
-	if ($eval_dirs[0] eq ""){
-	    unshift(@eval_dirs,"");
-	}
-    }
-    return &util::filename_cat(@eval_dirs);
-}
-
-sub replace_usemap_links {
-    my $self = shift (@_);
-    my ($front, $link, $back) = @_;
-
-    $link =~ s/^\.\///;
-    return $front . $link . $back;
-}
-
-sub inc_filecount {
-    my $self = shift (@_);
-
-    if ($self->{'file_num'} == 1000) {
-	$self->{'dir_num'} ++;
-	$self->{'file_num'} = 0;
-    } else {
-	$self->{'file_num'} ++;
-    }
-}
-
-
-# Extend the BasPlug read_file so that strings like &eacute; are
-# converted to UTF8 internally.  
-#
-# We don't convert &lt; or &gt; or &amp; or &quot; in case
-# they interfere with the GML files
-
-sub read_file {
-    my ($self, $filename, $encoding, $language, $textref) = @_;
-
-    &BasPlug::read_file($self, $filename, $encoding, $language, $textref);
-
-    # Convert entities to their UTF8 equivalents
-    $$textref =~ s/&(lt|gt|amp|quot|nbsp);/&z$1;/go;
-    $$textref =~ s/&([^;]+);/&ghtml::getcharequiv($1,1)/gseo;
-    $$textref =~ s/&z(lt|gt|amp|quot|nbsp);/&$1;/go;
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/HTMLPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/HTMLPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/HTMLPlugin.pm	(revision 15865)
@@ -0,0 +1,1444 @@
+###########################################################################
+#
+# HTMLPlug.pm -- basic html plugin
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999 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.
+#
+###########################################################################
+
+# 
+# Note that this plugin handles frames only in a very simple way
+# i.e. each frame is treated as a separate document. This means
+# search results will contain links to individual frames rather
+# than linking to the top level frameset.
+# There may also be some problems caused by the _parent target
+# (it's removed by this plugin)
+#
+
+package HTMLPlug;
+
+use BasPlug;
+use ghtml;
+use unicode;
+use util;
+use XMLParser;
+
+use Image::Size;
+use File::Copy;
+
+sub BEGIN {
+    @HTMLPlug::ISA = ('BasPlug');
+}
+
+use strict; # every perl program should have this!
+no strict 'refs'; # make an exception so we can use variables as filehandles
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' =>  &get_default_process_exp() },
+      { 'name' => "block_exp",
+	'desc' => "{BasPlug.block_exp}",
+	'type' => 'regexp',
+	'deft' =>  &get_default_block_exp() },
+      { 'name' => "nolinks",
+	'desc' => "{HTMLPlug.nolinks}",
+	'type' => "flag" },
+      { 'name' => "keep_head",
+	'desc' => "{HTMLPlug.keep_head}",
+	'type' => "flag" },
+      { 'name' => "no_metadata",
+	'desc' => "{HTMLPlug.no_metadata}",
+	'type' => "flag" },
+      { 'name' => "metadata_fields",
+	'desc' => "{HTMLPlug.metadata_fields}",
+	'type' => "string",
+	'deft' => "Title" },
+      { 'name' => "hunt_creator_metadata",
+	'desc' => "{HTMLPlug.hunt_creator_metadata}",
+	'type' => "flag" },
+      { 'name' => "file_is_url",
+	'desc' => "{HTMLPlug.file_is_url}",
+	'type' => "flag" },
+      { 'name' => "assoc_files",
+	'desc' => "{HTMLPlug.assoc_files}",
+	'type' => "regexp",
+	'deft' => &get_default_block_exp() },
+      { 'name' => "rename_assoc_files",
+	'desc' => "{HTMLPlug.rename_assoc_files}",
+	'type' => "flag" },
+      { 'name' => "title_sub",
+	'desc' => "{HTMLPlug.title_sub}",
+	'type' => "string", 
+	'deft' => "" },
+      { 'name' => "description_tags",
+	'desc' => "{HTMLPlug.description_tags}",
+	'type' => "flag" },
+      # retain this for backward compatibility (w3mir option was replaced by
+      # file_is_url)
+      { 'name' => "w3mir",
+#	'desc' => "{HTMLPlug.w3mir}",
+	'type' => "flag",
+	'hiddengli' => "yes"},
+      { 'name' => "no_strip_metadata_html",
+	'desc' => "{HTMLPlug.no_strip_metadata_html}",
+	'type' => "string",
+	'deft' => "",
+	'reqd' => "no"},
+      { 'name' => "sectionalise_using_h_tags",
+	'desc' => "{HTMLPlug.sectionalise_using_h_tags}",
+	'type' => "flag" },
+      { 'name' => "use_realistic_book",
+        'desc' => "{HTMLPlug.tidy_html}",
+	'type' => "flag"},
+      { 'name' => "is_old_HDL_tags",
+        'desc' => "{HTMLPlug.old_style_HDL}",
+	'type' => "flag"},
+      { 'name' => "no_image_links",            # in future think about removing this option,
+        'desc' => "{HTMLPlug.no_image_links}", # since it has become the default behaviour
+	'type' => "flag"},	
+      ];
+
+my $options = { 'name'     => "HTMLPlug",
+		'desc'     => "{HTMLPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+
+sub HB_read_html_file {
+    my $self = shift (@_);
+    my ($htmlfile, $text) = @_;
+        
+    # load in the file
+    if (!open (FILE, $htmlfile)) {
+	print STDERR "ERROR - could not open $htmlfile\n";
+	return;
+    }
+
+    my $foundbody = 0;
+    $self->HB_gettext (\$foundbody, $text, "FILE");
+    close FILE;
+    
+    # just in case there was no <body> tag
+    if (!$foundbody) {
+	$foundbody = 1;
+	open (FILE, $htmlfile) || return;
+	$self->HB_gettext (\$foundbody, $text, "FILE");	
+	close FILE;
+    }
+    # text is in utf8
+}		
+
+# converts the text to utf8, as ghtml does that for &eacute; etc.
+sub HB_gettext {
+    my $self = shift (@_);
+    my ($foundbody, $text, $handle) = @_;
+   
+    my $line = "";
+    while (defined ($line = <$handle>)) {
+	# look for body tag
+	if (!$$foundbody) {
+	    if ($line =~ s/^.*<body[^>]*>//i) {
+		$$foundbody = 1;
+	    } else {
+		next;
+	    }
+	}
+	
+	# check for symbol fonts
+	if ($line =~ /<font [^>]*?face\s*=\s*\"?(\w+)\"?/i) {
+	    my $font = $1;
+	    print STDERR "HBPlug::HB_gettext - warning removed font $font\n" 
+		if ($font !~ /^arial$/i);
+	}
+
+	$$text .= $line;
+    }
+
+   if ($self->{'input_encoding'} eq "iso_8859_1") {
+	# convert to utf-8
+	$$text=&unicode::unicode2utf8(&unicode::convert2unicode("iso_8859_1", $text));
+    }
+    # convert any alphanumeric character entities to their utf-8
+    # equivalent for indexing purposes
+    #&ghtml::convertcharentities ($$text);
+
+    $$text =~ s/\s+/ /g; # remove \n's
+}
+
+sub HB_clean_section {
+    my $self = shift (@_);
+    my ($section) = @_;
+
+    # remove tags without a starting tag from the section
+    my ($tag, $tagstart);
+    while ($section =~ /<\/([^>]{1,10})>/) {
+	$tag = $1;
+	$tagstart = index($section, "<$tag");
+	last if (($tagstart >= 0) && ($tagstart < index($section, "<\/$tag")));
+	$section =~ s/<\/$tag>//;
+    }
+    
+    # remove extra paragraph tags
+    while ($section =~ s/<p\b[^>]*>\s*<p\b/<p/ig) {}
+    
+    # remove extra stuff at the end of the section
+    while ($section =~ s/(<u>|<i>|<b>|<p\b[^>]*>|&nbsp;|\s)$//i) {}
+    
+    # add a newline at the beginning of each paragraph
+    $section =~ s/(.)\s*<p\b/$1\n\n<p/gi;
+    
+    # add a newline every 80 characters at a word boundary
+    # Note: this regular expression puts a line feed before
+    # the last word in each section, even when it is not
+    # needed.
+    $section =~ s/(.{1,80})\s/$1\n/g;
+    
+    # fix up the image links
+    $section =~ s/<img[^>]*?src=\"?([^\">]+)\"?[^>]*>/
+	<center><img src=\"$1\" \/><\/center><br\/>/ig;
+    $section =~ s/&lt;&lt;I&gt;&gt;\s*([^\.]+\.(png|jpg|gif))/
+	<center><img src=\"$1\" \/><\/center><br\/>/ig;
+
+    return $section;
+}
+		
+# Will convert the oldHDL format to the new HDL format (using the Section tag)	
+sub convert_to_newHDLformat
+{
+   my $self = shift (@_);
+   my ($file,$cnfile) = @_;
+   my $input_filename = $file;
+   my $tmp_filename = $cnfile;
+   
+   # write HTML tmp file with new HDL format
+   open (PROD, ">$tmp_filename") || die("Error Writing to File: $tmp_filename $!");
+   
+   # read in the file and do basic html cleaning (removing header etc)
+   my $html = "";
+   $self->HB_read_html_file ($input_filename, \$html);
+   
+    # process the file one section at a time
+    my $curtoclevel = 1;
+    my $firstsection = 1;
+    my $toclevel = 0;
+    while (length ($html) > 0) {
+	if ($html =~ s/^.*?(?:<p\b[^>]*>)?((<b>|<i>|<u>|\s)*)&lt;&lt;TOC(\d+)&gt;&gt;\s*(.*?)<p\b/<p/i) {
+	    $toclevel = $3;
+	    my $title = $4;
+	    my $sectiontext = "";
+	    if ($html =~ s/^(.*?)((?:<p\b[^>]*>)?((<b>|<i>|<u>|\s)*)&lt;&lt;TOC\d+&gt;&gt;)/$2/i) {
+		$sectiontext = $1;
+	    } else {
+		$sectiontext = $html;
+		$html = "";
+	    }
+
+	    # remove tags and extra spaces from the title
+	    $title =~ s/<\/?[^>]+>//g;
+	    $title =~ s/^\s+|\s+$//g;
+
+	    # close any sections below the current level and
+	    # create a new section (special case for the firstsection)
+	    print PROD "<!--\n";
+	    while (($curtoclevel > $toclevel) ||
+		   (!$firstsection && $curtoclevel == $toclevel)) {
+		$curtoclevel--;
+		print PROD "</Section>\n";
+	    }
+	    if ($curtoclevel+1 < $toclevel) {
+		print STDERR "WARNING - jump in toc levels in $input_filename " . 
+		    "from $curtoclevel to $toclevel\n";
+	    }
+	    while ($curtoclevel < $toclevel) {
+		$curtoclevel++;
+	    }
+
+	    if ($curtoclevel == 1) {
+	    	# add the header tag
+		print PROD "-->\n";
+    		print PROD "<HTML>\n<HEAD>\n<TITLE>$title</TITLE>\n</HEAD>\n<BODY>\n";
+		print PROD "<!--\n";
+	    }
+	    
+	    print PROD "<Section>\n\t<Description>\n\t\t<Metadata name=\"Title\">$title</Metadata>\n\t</Description>\n";
+	   
+	    print PROD "-->\n";
+	     
+	    # clean up the section html
+	    $sectiontext = $self->HB_clean_section($sectiontext);
+
+	    print PROD "$sectiontext\n";	 
+
+	} else {
+	    print STDERR "WARNING - leftover text\n" , $self->shorten($html), 
+	    "\nin $input_filename\n";
+	    last;
+	}
+	$firstsection = 0;
+    }
+    
+    print PROD "<!--\n";
+    while ($curtoclevel > 0) {
+	$curtoclevel--;
+	print PROD "</Section>\n";
+    }
+    print PROD "-->\n";
+    
+    close (PROD) || die("Error Closing File: $tmp_filename $!");
+    
+    return $tmp_filename;
+}		
+
+sub shorten {
+    my $self = shift (@_);
+    my ($text) = @_;
+
+    return "\"$text\"" if (length($text) < 100);
+
+    return "\"" . substr ($text, 0, 50) . "\" ... \"" . 
+	substr ($text, length($text)-50) . "\"";
+}
+
+sub convert_tidy_or_oldHDL_file
+{
+    my $self = shift (@_);
+    my ($file) = @_;
+    my $input_filename = $file;
+ 
+    if (-d $input_filename)
+    {
+    	return $input_filename;
+    }
+    
+    # get the input filename
+    my ($tailname, $dirname, $suffix) = &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
+    my $base_dirname = $dirname;
+    $suffix = lc($suffix);   
+    
+    # derive tmp filename from input filename
+    # Remove any white space from filename -- no risk of name collision, and
+    # makes later conversion by utils simpler. Leave spaces in path...
+    # tidy up the filename with space, dot, hyphen between
+    $tailname =~ s/\s+//g; 
+    $tailname =~ s/\.+//g;
+    $tailname =~ s/\-+//g;
+    # convert to utf-8 otherwise we have problems with the doc.xml file
+    # later on
+    &unicode::ensure_utf8(\$tailname);
+    
+    # softlink to collection tmp dir
+    my $tmp_dirname = &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, "tidytmp");
+    &util::mk_dir($tmp_dirname) if (!-e $tmp_dirname);
+    
+    my $test_dirname = "";
+    my $f_separator = &util::get_os_dirsep();
+    
+   if ($dirname =~ /import$f_separator/)
+    {
+    	$test_dirname = $';
+	
+	#print STDERR "init $'\n";
+	
+	while ($test_dirname =~ /[$f_separator]/)
+	{
+		my $folderdirname = $`;
+		$tmp_dirname = &util::filename_cat($tmp_dirname,$folderdirname);
+       		&util::mk_dir($tmp_dirname) if (!-e $tmp_dirname);
+		$test_dirname = $';
+	}
+    }
+    
+    my $tmp_filename = &util::filename_cat($tmp_dirname, "$tailname$suffix");
+    
+    # tidy or convert the input file if it is a HTML-like file or it is accepted by the process_exp
+    if (($suffix eq ".htm") || ($suffix eq ".html") || ($suffix eq ".shtml"))
+    {   
+    	#convert the input file to a new style HDL
+    	my $hdl_output_filename = $input_filename;
+    	if ($self->{'old_style_HDL'})
+    	{
+		$hdl_output_filename = &util::filename_cat($tmp_dirname, "$tailname$suffix");
+		$hdl_output_filename = $self->convert_to_newHDLformat($input_filename,$hdl_output_filename);
+    	}
+	
+	#just for checking copy all other file from the base dir to tmp dir if it is not exists
+	opendir(DIR,$base_dirname) or die "Can't open base directory : $base_dirname!";
+	my @files = grep {!/^\.+$/} readdir(DIR);
+	close(DIR);
+
+	foreach my $file (@files) 
+	{
+		my $src_file = &util::filename_cat($base_dirname,$file);
+		my $dest_file = &util::filename_cat($tmp_dirname,$file);
+		if ((!-e $dest_file) && (!-d $src_file))
+		{
+			# just copy the original file back to the tmp directory
+			copy($src_file,$dest_file) or die "Can't copy file $src_file to $dest_file $!";
+		}
+	}
+	
+	# tidy the input file
+	my $tidy_output_filename = $hdl_output_filename;
+	if ($self->{'tidy_html'})
+	{
+		$tidy_output_filename = &util::filename_cat($tmp_dirname, "$tailname$suffix");
+		$tidy_output_filename = $self->tmp_tidy_file($hdl_output_filename,$tidy_output_filename);
+	}
+	$tmp_filename = $tidy_output_filename;
+    }
+    else
+    {
+    	if (!-e $tmp_filename)
+	{
+    		# just copy the original file back to the tmp directory
+		copy($input_filename,$tmp_filename) or die "Can't copy file $input_filename to $tmp_filename $!";
+	}
+    }
+    
+    return $tmp_filename;
+}
+
+	
+# Will make the html input file as a proper XML file with removed font tag and
+# image size added to the img tag.
+# The tidying process takes place in a collection specific 'tmp' directory so 
+# that we don't accidentally damage the input.
+sub tmp_tidy_file 
+{
+    my $self = shift (@_);
+    my ($file,$cnfile) = @_;
+    my $input_filename = $file;
+    my $tmp_filename = $cnfile;
+ 
+    # get the input filename
+    my ($tailname, $dirname, $suffix) = &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
+
+    require HTML::TokeParser::Simple;
+	
+    	# create HTML parser to decode the input file
+    	my $parser = HTML::TokeParser::Simple->new($input_filename);
+
+    	# write HTML tmp file without the font tag and image size are added to the img tag
+    	open (PROD, ">$tmp_filename") || die("Error Writing to File: $tmp_filename $!");
+    	while (my $token = $parser->get_token())
+    	{
+		# is it an img tag
+		if ($token->is_start_tag('img'))
+		{
+	    		# get the attributes
+	    		my $attr = $token->return_attr;
+
+	    		# get the full path to the image
+	    		my $img_file = &util::filename_cat($dirname,$attr->{src});
+	    
+	    		# set the width and height attribute
+	    		($attr->{width}, $attr->{height}) = imgsize($img_file);
+
+	    		# recreate the tag
+	    		print PROD "<img";
+	    		print PROD map { qq { $_="$attr->{$_}"} } keys %$attr;
+	    		print PROD ">";
+		}
+		# is it a font tag
+		else 
+		{
+	   		if (($token->is_start_tag('font')) || ($token->is_end_tag('font')))
+	   		{
+				# remove font tag
+				print PROD "";
+	   		}
+	   		else
+	  		{
+				# print without changes
+				print PROD $token->as_is;
+	   		}
+		}
+    	}
+    	close (PROD) || die("Error Closing File: $tmp_filename $!");
+
+    	# run html-tidy on the tmp file to make it a proper XML file
+    	my $tidyfile = `tidy -utf8 -wrap 0 -asxml $tmp_filename`;
+
+    	# write result back to the tmp file
+    	open (PROD, ">$tmp_filename") || die("Error Writing to File: $tmp_filename $!");
+    	print PROD $tidyfile;
+    	close (PROD) || die("Error Closing File: $tmp_filename $!");
+    
+    # return the output filename
+    return $tmp_filename;
+} 
+
+sub read_into_doc_obj 
+{
+    my $self = shift (@_);  
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+    
+    # check the process_exp and block_exp thing
+    my ($block_status,$filename) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+    
+    # get the input file
+    my $input_filename = $file;
+    my ($tailname, $dirname, $suffix) = &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
+    $suffix = lc($suffix);   
+    
+    if (($self->{'tidy_html'}) || ($self->{'old_style_HDL'}))
+    {
+		# because the document has to be sectionalized set the description tags 
+		$self->{'description_tags'} = 1;
+
+		# set the file to be tidied
+    		$input_filename = &util::filename_cat($base_dir,$file) if $base_dir =~ /\w/;
+		
+    		# get the tidied file
+    		#my $tidy_filename = $self->tmp_tidy_file($input_filename);
+		my $tidy_filename = $self->convert_tidy_or_oldHDL_file($input_filename);
+		
+    		# derive tmp filename from input filename
+    		my ($tailname, $dirname, $suffix) = &File::Basename::fileparse($tidy_filename, "\\.[^\\.]+\$");
+	
+		# set the new input file and base_dir to be from the tidied file
+		$file = "$tailname$suffix";
+		$base_dir = $dirname;
+    }
+    
+    # call the parent read_into_doc_obj
+    my ($process_status,$doc_obj) = &BasPlug::read_into_doc_obj($self,$pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli);
+    
+    return ($process_status,$doc_obj);
+}
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+    
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+   
+
+    my $self = (defined $hashArgOptLists)? new BasPlug($pluginlist,$inputargs,$hashArgOptLists): new BasPlug($pluginlist,$inputargs);
+    
+    if ($self->{'w3mir'}) {
+	$self->{'file_is_url'} = 1;
+    }
+    $self->{'aux_files'} = {};
+    $self->{'dir_num'} = 0;
+    $self->{'file_num'} = 0;
+    
+    return bless $self, $class;
+}
+
+# may want to use (?i)\.(gif|jpe?g|jpe|png|css|js(?:@.*)?)$
+# if have eg <script language="javascript" src="img/lib.js@123">
+sub get_default_block_exp {
+    my $self = shift (@_);
+    
+    return q^(?i)\.(gif|jpe?g|jpe|jpg|png|css)$^;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+    
+    # the last option is an attempt to encode the concept of an html query ...
+    return q^(?i)(\.html?|\.shtml|\.shm|\.asp|\.php\d?|\.cgi|.+\?.+=.*)$^;
+}
+
+sub store_block_files
+{
+    my $self =shift (@_);
+    my ($filename) = @_;
+    my $html_fname = $filename;
+    my @file_blocks;
+    
+    my ($language, $encoding) = $self->textcat_get_language_encoding ($filename);
+
+    # read in file ($text will be in utf8)
+    my $text = "";
+    $self->read_file ($filename, $encoding, $language, \$text);
+    my $textref = \$text;
+    my $opencom = '(?:<!--|&lt;!(?:&mdash;|&#151;|--))';
+    my $closecom = '(?:-->|(?:&mdash;|&#151;|--)&gt;)';
+    $$textref =~ s/$opencom(.*?)$closecom//gs;
+
+    my $attval = "\\\"[^\\\"]+\\\"|[^\\s>]+";
+    my @img_matches = ($$textref =~ m/<img[^>]*?src\s*=\s*($attval)[^>]*>/igs);
+    my @usemap_matches = ($$textref =~ m/<img[^>]*?usemap\s*=\s*($attval)[^>]*>/igs);
+    my @link_matches = ($$textref =~ m/<link[^>]*?href\s*=\s*($attval)[^>]*>/igs);
+    my @embed_matches = ($$textref =~ m/<embed[^>]*?src\s*=\s*($attval)[^>]*>/igs);
+    my @tabbg_matches = ($$textref =~ m/<(?:table|tr|td)[^>]*?background\s*=\s*($attval)[^>]*>/igs);
+
+    foreach my $link (@img_matches, @usemap_matches, @link_matches, @embed_matches, @tabbg_matches) {
+
+	# remove quotes from link at start and end if necessary
+	if ($link=~/^\"/) {
+	    $link=~s/^\"//;
+	    $link=~s/\"$//;
+	}
+
+	$link =~ s/\#.*$//s; # remove any anchor names, e.g. foo.html#name becomes foo.html
+
+	if ($link !~ m@^/@ && $link !~ m/^([A-Z]:?)\\/) {
+	    # Turn relative file path into full path
+	    my $dirname = &File::Basename::dirname($filename);
+	    $link = &util::filename_cat($dirname, $link);
+	}
+	$link = $self->eval_dir_dots($link);
+	
+	$self->{'file_blocks'}->{$link} = 1;
+    }
+}
+
+  
+# do plugin specific processing of doc_obj
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    print STDERR "<Processing n='$file' p='HTMLPlug'>\n" if ($gli);
+
+    print $outhandle "HTMLPlug: processing $file\n"
+	if $self->{'verbosity'} > 1;
+
+    if ($ENV{'GSDLOS'} =~ /^windows/i) {
+      # this makes life so much easier... perl can cope with unix-style '/'s.
+      $base_dir =~ s@(\\)+@/@g;
+      $file =~ s@(\\)+@/@g; 
+    }
+    
+    # reset per-doc stuff...
+    $self->{'aux_files'} = {};
+    $self->{'dir_num'} = 0;
+    $self->{'file_num'} = 0;
+
+    # process an HTML file where sections are divided by headings tags (H1, H2 ...)
+    # you can also include metadata in the format (X can be any number)
+    # <hX>Title<!--gsdl-metadata
+    #	<Metadata name="name1">value1</Metadata>
+    #	...
+    #	<Metadata name="nameN">valueN</Metadata>
+    #--></hX>
+    if ($self->{'sectionalise_using_h_tags'}) {
+	# description_tags should allways be activated because we convert headings to description tags
+	$self->{'description_tags'} = 1;
+
+	my $arrSections = [];
+	$$textref =~ s/<h([0-9]+)[^>]*>(.*?)<\/h[0-9]+>/$self->process_heading($1, $2, $arrSections, $file)/isge;
+
+	if (scalar(@$arrSections)) {
+	    my $strMetadata = $self->update_section_data($arrSections, -1);
+	    if (length($strMetadata)) {
+		$strMetadata = '<!--' . $strMetadata . "\n-->\n</body>";
+		$$textref =~ s/<\/body>/$strMetadata/ig;
+	    }
+	}
+    }
+
+    my $cursection = $doc_obj->get_top_section();
+
+    $self->extract_metadata ($textref, $metadata, $doc_obj, $cursection)
+	unless $self->{'no_metadata'} || $self->{'description_tags'};
+
+    # Store URL for page as metadata - this can be used for an
+    # altavista style search interface. The URL won't be valid
+    # unless the file structure contains the domain name (i.e.
+    # like when w3mir is used to download a website).
+
+    # URL metadata (even invalid ones) are used to support internal
+    # links, so even if 'file_is_url' is off, still need to store info
+    
+    $file = &BasPlug::filename_to_metadata($self, $file); # ensures filename is in UTF8 character encoding
+    my $web_url = "http://$file";
+    $doc_obj->add_utf8_metadata($cursection, "URL", $web_url); # will eventually ensure it is utf8 anyway
+
+    if ($self->{'file_is_url'}) {
+	$doc_obj->add_metadata($cursection, "weblink", "<a href=\"$web_url\">");
+	$doc_obj->add_metadata($cursection, "webicon", "_iconworld_");
+	$doc_obj->add_metadata($cursection, "/weblink", "</a>");
+    }
+
+    if ($self->{'description_tags'}) {
+	# remove the html header - note that doing this here means any
+	# sections defined within the header will be lost (so all <Section>
+	# tags must appear within the body of the HTML)
+	my ($head_keep) = ($$textref =~ m/^(.*?)<body[^>]*>/is);
+
+	$$textref =~ s/^.*?<body[^>]*>//is;
+	$$textref =~ s/(<\/body[^>]*>|<\/html[^>]*>)//isg;
+
+	my $opencom = '(?:<!--|&lt;!(?:&mdash;|&#151;|--))';
+	my $closecom = '(?:-->|(?:&mdash;|&#151;|--)&gt;)';
+
+	my $lt = '(?:<|&lt;)';
+	my $gt = '(?:>|&gt;)';
+	my $quot = '(?:"|&quot;|&rdquo;|&ldquo;)';
+
+	my $dont_strip = '';
+	if ($self->{'no_strip_metadata_html'}) {
+	    ($dont_strip = $self->{'no_strip_metadata_html'}) =~ s{,}{|}g;
+	}
+
+	my $found_something = 0; my $top = 1;
+	while ($$textref =~ s/^(.*?)$opencom(.*?)$closecom//s) {
+	    my $text = $1;
+	    my $comment = $2;
+	    if (defined $text) {
+		# text before a comment - note that getting to here
+		# doesn't necessarily mean there are Section tags in
+		# the document
+		$self->process_section(\$text, $base_dir, $file, $doc_obj, $cursection);
+	    }
+	    while ($comment =~ s/$lt(.*?)$gt//s) {
+		my $tag = $1;
+		if ($tag eq "Section") {
+		    $found_something = 1;
+		    $cursection = $doc_obj->insert_section($doc_obj->get_end_child($cursection)) unless $top;
+		    $top = 0;
+		} elsif ($tag eq "/Section") {
+		    $found_something = 1;
+		    $cursection = $doc_obj->get_parent_section ($cursection);
+		} elsif ($tag =~ /^Metadata name=$quot(.*?)$quot/s) {
+		    my $metaname = $1;
+		    my $accumulate = $tag =~ /mode=${quot}accumulate${quot}/ ? 1 : 0;
+		    $comment =~ s/^(.*?)$lt\/Metadata$gt//s;
+		    my $metavalue = $1;
+		    $metavalue =~ s/^\s+//;
+		    $metavalue =~ s/\s+$//;
+                    # assume that no metadata value intentionally includes
+                    # carriage returns or HTML tags (if they're there they
+                    # were probably introduced when converting to HTML from
+                    # some other format).
+		    # actually some people want to have html tags in their
+		    # metadata.
+		    $metavalue =~ s/[\cJ\cM]/ /sg;
+		    $metavalue =~ s/<[^>]+>//sg
+			unless $dont_strip && ($dont_strip eq 'all' || $metaname =~ /^($dont_strip)$/);
+		    $metavalue =~ s/\s+/ /sg;
+		    if ($accumulate) {
+			$doc_obj->add_utf8_metadata($cursection, $metaname, $metavalue);
+		    } else {
+			$doc_obj->set_utf8_metadata_element($cursection, $metaname, $metavalue);	
+		    }
+		} elsif ($tag eq "Description" || $tag eq "/Description") {
+		    # do nothing with containing Description tags
+		} else {
+		    # simple HTML tag (probably created by the conversion
+		    # to HTML from some other format) - we'll ignore it and
+		    # hope for the best ;-)
+		}
+	    }
+	}
+	if ($cursection ne "") {
+	    print $outhandle "HTMLPlug: WARNING: $file contains unmatched <Section></Section> tags\n";
+	}
+
+	$$textref =~ s/^.*?<body[^>]*>//is;
+	$$textref =~ s/(<\/body[^>]*>|<\/html[^>]*>)//isg;
+	if ($$textref =~ /\S/) {
+	    if (!$found_something) {
+		if ($self->{'verbosity'} > 2) {
+		    print $outhandle "HTMLPlug: WARNING: $file appears to contain no Section tags so\n";
+		    print $outhandle "          will be processed as a single section document\n";
+		}
+
+		# go ahead and process single-section document
+		$self->process_section($textref, $base_dir, $file, $doc_obj, $cursection);
+
+		# if document contains no Section tags we'll go ahead
+		# and extract metadata (this won't have been done
+		# above as the -description_tags option prevents it)
+		my $complete_text = $head_keep.$doc_obj->get_text($cursection);
+		$self->extract_metadata (\$complete_text, $metadata, $doc_obj, $cursection) 
+		    unless $self->{'no_metadata'};
+
+	    } else {
+		print $outhandle "HTMLPlug: WARNING: $file contains the following text outside\n";
+		print $outhandle "          of the final closing </Section> tag. This text will\n";
+		print $outhandle "          be ignored.";
+
+		my ($text);
+		if (length($$textref) > 30) {
+		    $text = substr($$textref, 0, 30) . "...";
+		} else {
+		    $text = $$textref;
+		}
+		$text =~ s/\n/ /isg;
+		print $outhandle " ($text)\n";
+	    }
+	} elsif (!$found_something) {
+
+	    if ($self->{'verbosity'} > 2) {
+		# may get to here if document contained no valid Section
+		# tags but did contain some comments. The text will have
+		# been processed already but we should print the warning
+		# as above and extract metadata
+		print $outhandle "HTMLPlug: WARNING: $file appears to contain no Section tags and\n";
+		print $outhandle "          is blank or empty.  Metadata will be assigned if present.\n";
+	    }
+
+	    my $complete_text = $head_keep.$doc_obj->get_text($cursection);
+	    $self->extract_metadata (\$complete_text, $metadata, $doc_obj, $cursection) 
+		unless $self->{'no_metadata'};
+	}
+	
+    } else {
+
+	# remove header and footer
+	if (!$self->{'keep_head'} || $self->{'description_tags'}) {
+	    $$textref =~ s/^.*?<body[^>]*>//is;
+	    $$textref =~ s/(<\/body[^>]*>|<\/html[^>]*>)//isg;
+	}
+
+	# single section document
+	$self->process_section($textref, $base_dir, $file, $doc_obj, $cursection);
+    }
+    return 1;
+}
+
+
+sub process_heading
+{
+    my ($self, $nHeadNo, $strHeadingText, $arrSections, $file) = @_;
+    $strHeadingText = '' if (!defined($strHeadingText));
+
+    my $strMetadata = $self->update_section_data($arrSections, int($nHeadNo));
+
+    my $strSecMetadata = '';
+    while ($strHeadingText =~ s/<!--gsdl-metadata(.*?)-->//is)
+    {
+	$strSecMetadata .= $1;
+    }
+
+    $strHeadingText =~ s/^\s+//g;
+    $strHeadingText =~ s/\s+$//g;
+    $strSecMetadata =~ s/^\s+//g;
+    $strSecMetadata =~ s/\s+$//g;
+
+    $strMetadata .= "\n<Section>\n\t<Description>\n\t\t<Metadata name=\"Title\">" . $strHeadingText . "</Metadata>\n";
+
+    if (length($strSecMetadata)) {
+	$strMetadata .= "\t\t" . $strSecMetadata . "\n";
+    }
+
+    $strMetadata .= "\t</Description>\n";
+
+    return "<!--" . $strMetadata . "-->";
+}
+
+
+sub update_section_data
+{
+    my ($self, $arrSections, $nCurTocNo) = @_;
+    my ($strBuffer, $nLast, $nSections) = ('', 0, scalar(@$arrSections));
+
+    if ($nSections == 0) {
+	push @$arrSections, $nCurTocNo;
+	return $strBuffer;
+    }
+    $nLast = $arrSections->[$nSections - 1];
+    if ($nCurTocNo > $nLast) {
+	push @$arrSections, $nCurTocNo;
+	return $strBuffer;
+    }
+    for(my $i = $nSections - 1; $i >= 0; $i--) {
+	if ($nCurTocNo <= $arrSections->[$i]) {
+	    $strBuffer .= "\n</Section>";
+	    pop @$arrSections;
+	}
+    }
+    push @$arrSections, $nCurTocNo;
+    return $strBuffer;
+}
+
+
+# note that process_section may be called multiple times for a single
+# section (relying on the fact that add_utf8_text appends the text to any
+# that may exist already).
+sub process_section {
+    my $self = shift (@_);
+    my ($textref, $base_dir, $file, $doc_obj, $cursection) = @_;
+    # trap links
+    if (!$self->{'nolinks'}) {
+	# usemap="./#index" not handled correctly => change to "#index"
+	$$textref =~ s/(<img[^>]*?usemap\s*=\s*[\"\']?)([^\"\'>\s]+)([\"\']?[^>]*>)/
+	    $self->replace_usemap_links($1, $2, $3)/isge;
+
+	$$textref =~ s/(<(?:a|area|frame|link|script)\s+[^>]*?\s*(?:href|src)\s*=\s*[\"\']?)([^\"\'>\s]+)([\"\']?[^>]*>)/
+	    $self->replace_href_links ($1, $2, $3, $base_dir, $file, $doc_obj, $cursection)/isge;
+    }
+
+    # trap images
+
+    # Previously, by default, HTMLPlug would embed <img> tags inside anchor tags
+    # i.e. <a href="image><img src="image"></a> in order to overcome a problem that
+    # turned regular text succeeding images into links. That is, by embedding <imgs>
+    # inside <a href=""></a>, the text following images were no longer misbehaving.
+    # However, there would be many occasions whereby images were not meant to link
+    # to their source images but where the images would link to another web page.
+    # To allow this, the no_image_links option was introduced: it would prevent
+    # the behaviour of embedding images into links that referenced the source images.
+
+    # Somewhere along the line, the problem of normal text turning into links when 
+    # such text followed images which were not embedded in <a href=""></a> ceased 
+    # to occur. This is why the following lines have been commented out (as well as 
+    # two lines in replace_images). They appear to no longer apply.
+
+    # If at any time, there is a need for having images embedded in <a> anchor tags,
+    # then it might be better to turn that into an HTMLPlug option rather than make
+    # it the default behaviour. Also, eventually, no_image_links needs to become
+    # a deprecated option for HTMLPlug as it has now become the default behaviour.
+
+    #if(!$self->{'no_image_links'}){
+    $$textref =~ s/(<(?:img|embed|table|tr|td)[^>]*?(?:src|background)\s*=\s*)([\"][^\"]+[\"]|[\'][^\']+[\']|[^\s\/>]+)([^>]*>)/
+    	$self->replace_images ($1, $2, $3, $base_dir, $file, $doc_obj, $cursection)/isge;
+    #}
+
+    # add text to document object
+    # turn \ into \\ so that the rest of greenstone doesn't think there
+    # is an escape code following. (Macro parsing loses them...)
+    $$textref =~ s/\\/\\\\/go;
+    
+    $doc_obj->add_utf8_text($cursection, $$textref);
+}
+
+sub replace_images {
+    my $self = shift (@_);
+    my ($front, $link, $back, $base_dir, 
+	$file, $doc_obj, $section) = @_;
+
+    # remove quotes from link at start and end if necessary
+    if ($link=~/^[\"\']/) {
+	$link=~s/^[\"\']//;
+	$link=~s/[\"\']$//;
+	$front.='"';
+	$back="\"$back";
+    }
+    $link =~ s/\n/ /g;
+
+    # Hack to overcome Windows wv 0.7.1 bug that causes embedded images to be broken
+    # If the Word file path has spaces in it, wv messes up and you end up with
+    #   absolute paths for the images, and without the "file://" prefix
+    # So check for this special case and massage the data to be correct
+    if ($ENV{'GSDLOS'} =~ /^windows/i && $self->{'plugin_type'} eq "WordPlug" && $link =~ /^[A-Za-z]\:\\/) {
+	$link =~ s/^.*\\([^\\]+)$/$1/;
+    }
+
+    my ($href, $hash_part, $rl) = $self->format_link ($link, $base_dir, $file);
+
+    my $img_file =  $self->add_file ($href, $rl, $hash_part, $base_dir, $doc_obj, $section);
+
+    my $anchor_name = $img_file;
+    #$anchor_name =~ s/^.*\///;
+    #$anchor_name = "<a name=\"$anchor_name\" ></a>";
+
+    my $image_link = $front . $img_file .$back;
+    return $image_link;
+
+    # The reasons for why the following two lines are no longer necessary can be 
+    # found in subroutine process_section
+    #my $anchor_link = "<a href=\"$img_file\" >".$image_link."</a>";  
+    #return $anchor_link;	
+    
+    #return $front . $img_file . $back . $anchor_name;
+}
+
+sub replace_href_links {
+    my $self = shift (@_);
+    my ($front, $link, $back, $base_dir, $file, $doc_obj, $section) = @_;
+
+    # attempt to sort out targets - frames are not handled 
+    # well in this plugin and some cases will screw things
+    # up - e.g. the _parent target (so we'll just remove 
+    # them all ;-)
+    $front =~ s/(target=\"?)_top(\"?)/$1_gsdltop_$2/is;
+    $back =~ s/(target=\"?)_top(\"?)/$1_gsdltop_$2/is;
+    $front =~ s/target=\"?_parent\"?//is;
+    $back =~ s/target=\"?_parent\"?//is;
+
+    return $front . $link . $back if $link =~ /^\#/s;
+    $link =~ s/\n/ /g;
+
+    my ($href, $hash_part, $rl) = $self->format_link ($link, $base_dir, $file);
+    # href may use '\'s where '/'s should be on Windows
+    $href =~ s/\\/\//g;
+
+    my ($filename) = $href =~ /^(?:.*?):(?:\/\/)?(.*)/;
+    
+
+    ##### leave all these links alone (they won't be picked up by intermediate 
+    ##### pages). I think that's safest when dealing with frames, targets etc.
+    ##### (at least until I think of a better way to do it). Problems occur with
+    ##### mailto links from within small frames, the intermediate page is displayed
+    ##### within that frame and can't be seen. There is still potential for this to
+    ##### happen even with html pages - the solution seems to be to somehow tell
+    ##### the browser from the server side to display the page being sent (i.e. 
+    ##### the intermediate page) in the top level window - I'm not sure if that's 
+    ##### possible - the following line should probably be deleted if that can be done
+    return $front . $link . $back if $href =~ /^(mailto|news|gopher|nntp|telnet|javascript):/is;
+
+
+    if (($rl == 0) || ($filename =~ /$self->{'process_exp'}/) || 
+	($href =~ /\/$/) || ($href =~ /^(mailto|news|gopher|nntp|telnet|javascript):/i)) {
+	&ghtml::urlsafe ($href);
+	return $front . "_httpextlink_&rl=" . $rl . "&href=" . $href . $hash_part . $back;
+    } else {
+	# link is to some other type of file (eg image) so we'll
+	# need to associate that file
+	return $front . $self->add_file ($href, $rl, $hash_part, $base_dir, $doc_obj, $section) . $back;
+    }
+}
+
+sub add_file {
+    my $self = shift (@_);
+    my ($href, $rl, $hash_part, $base_dir, $doc_obj, $section) = @_;
+    my ($newname);
+
+    my $filename = $href;
+    if ($base_dir eq "") {
+	# remove http:/ thereby leaving one slash at the start
+	$filename =~ s/^[^:]*:\///;
+    }
+    else {
+	# remove http://
+	$filename =~ s/^[^:]*:\/\///;
+    }
+
+    $filename = &util::filename_cat($base_dir, $filename);
+       
+    # Replace %20's in URL with a space if required. Note that the filename
+    # may include the %20 in some situations
+    if ($filename =~ /\%20/) {
+	if (!-e $filename) {
+	    $filename =~ s/\%20/ /g;
+	}
+    }
+
+    my ($ext) = $filename =~ /(\.[^\.]*)$/;
+
+    if ($rl == 0) {
+	if ((!defined $ext) || ($ext !~ /$self->{'assoc_files'}/)) {
+	    return "_httpextlink_&rl=0&el=prompt&href=" . $href . $hash_part;
+	}
+	else {
+	    return "_httpextlink_&rl=0&el=direct&href=" . $href . $hash_part;
+	}
+    }
+
+    if ((!defined $ext) || ($ext !~ /$self->{'assoc_files'}/)) {
+	return "_httpextlink_&rl=" . $rl . "&href=" . $href . $hash_part;
+    }
+    if ($self->{'rename_assoc_files'}) {
+	if (defined $self->{'aux_files'}->{$href}) {
+	    $newname = $self->{'aux_files'}->{$href}->{'dir_num'} . "/" .
+		$self->{'aux_files'}->{$href}->{'file_num'} . $ext;
+	} else {
+	    $newname = $self->{'dir_num'} . "/" . $self->{'file_num'} . $ext;
+	    $self->{'aux_files'}->{$href} = {'dir_num' => $self->{'dir_num'}, 'file_num' => $self->{'file_num'}};
+	    $self->inc_filecount ();
+	}
+	$doc_obj->associate_file($filename, $newname, undef, $section);
+	return "_httpdocimg_/$newname";
+    } else {
+	($newname) = $filename =~ /([^\/\\]*)$/;
+	$doc_obj->associate_file($filename, $newname, undef, $section);
+	return "_httpdocimg_/$newname";
+    }
+}
+
+
+sub format_link {
+    my $self = shift (@_);
+    my ($link, $base_dir, $file) = @_;
+
+    my ($before_hash, $hash_part) = $link =~ /^([^\#]*)(\#?.*)$/;
+
+    $hash_part = "" if !defined $hash_part;
+    if (!defined $before_hash || $before_hash !~ /[\w\.\/]/) {
+	my $outhandle = $self->{'outhandle'};
+	print $outhandle "HTMLPlug: ERROR - badly formatted tag ignored ($link)\n"
+	    if $self->{'verbosity'};
+	return ($link, "", 0);
+    }
+
+    if ($before_hash =~ s@^((?:http|ftp|file)://)@@i) {
+	my $type = $1;
+
+	if ($link =~ /^(http|ftp):/i) {
+	    # Turn url (using /) into file name (possibly using \ on windows)
+	    my @http_dir_split = split('/', $before_hash);
+	    $before_hash = &util::filename_cat(@http_dir_split);
+	}
+
+	$before_hash = $self->eval_dir_dots($before_hash);
+					 
+	my $linkfilename = &util::filename_cat ($base_dir, $before_hash);
+	
+	my $rl = 0;
+	$rl = 1 if (-e $linkfilename);
+
+	# make sure there's a slash on the end if it's a directory
+	if ($before_hash !~ /\/$/) {
+	    $before_hash .= "/" if (-d $linkfilename);
+	}
+
+	return ($type . $before_hash, $hash_part, $rl);
+    
+    } elsif ($link !~ /^(mailto|news|gopher|nntp|telnet|javascript):/i && $link !~ /^\//) {
+	if ($before_hash =~ s@^/@@ || $before_hash =~ /\\/) {
+
+	    # the first directory will be the domain name if file_is_url
+	    # to generate archives, otherwise we'll assume all files are
+	    # from the same site and base_dir is the root
+
+	    if ($self->{'file_is_url'}) {
+		my @dirs = split /[\/\\]/, $file;
+		my $domname = shift (@dirs);
+		$before_hash = &util::filename_cat($domname, $before_hash);
+		$before_hash =~ s@\\@/@g; # for windows
+	    }
+	    else
+	    {
+		# see if link shares directory with source document
+		# => turn into relative link if this is so!
+		
+		if ($ENV{'GSDLOS'} =~ /^windows/i) {
+		    # too difficult doing a pattern match with embedded '\'s...
+		    my $win_before_hash=$before_hash;
+		    $win_before_hash =~ s@(\\)+@/@g;
+		    # $base_dir is already similarly "converted" on windows.
+		    if ($win_before_hash =~ s@^$base_dir/@@o) {
+		      # if this is true, we removed a prefix
+		      $before_hash=$win_before_hash;
+		    }
+		}
+		else {
+		    # before_hash has lost leading slash by this point,
+		    # -> add back in prior to substitution with $base_dir
+		    $before_hash = "/$before_hash"; 
+
+		    $before_hash = &util::filename_cat("",$before_hash);
+		    $before_hash =~ s@^$base_dir/@@;
+		}
+	    }
+	} else {
+	    # Turn relative file path into full path
+	    my $dirname = &File::Basename::dirname($file);
+	    $before_hash = &util::filename_cat($dirname, $before_hash);
+	    $before_hash = $self->eval_dir_dots($before_hash);
+	}
+
+	my $linkfilename = &util::filename_cat ($base_dir, $before_hash); 
+	# make sure there's a slash on the end if it's a directory
+	if ($before_hash !~ /\/$/) {
+	    $before_hash .= "/" if (-d $linkfilename);
+	}
+	return ("http://" . $before_hash, $hash_part, 1);
+    } else {
+	# mailto, news, nntp, telnet, javascript or gopher link
+	return ($before_hash, "", 0);
+    }
+}
+
+sub extract_first_NNNN_characters {
+    my $self = shift (@_);
+    my ($textref, $doc_obj, $thissection) = @_;
+    
+    foreach my $size (split /,/, $self->{'first'}) {
+	my $tmptext =  $$textref;
+	# skip to the body
+	$tmptext =~ s/.*<body[^>]*>//i;
+	# remove javascript
+	$tmptext =~ s@<script.*?</script>@ @sig;
+	$tmptext =~ s/<[^>]*>/ /g;
+	$tmptext =~ s/&nbsp;/ /g;
+	$tmptext =~ s/^\s+//;
+	$tmptext =~ s/\s+$//;
+	$tmptext =~ s/\s+/ /gs;
+	$tmptext = &unicode::substr ($tmptext, 0, $size);
+	$tmptext =~ s/\s\S*$/&#8230;/; # adds an ellipse (...)
+	$doc_obj->add_utf8_metadata ($thissection, "First$size", $tmptext);
+    }
+}
+
+
+sub extract_metadata {
+    my $self = shift (@_);
+    my ($textref, $metadata, $doc_obj, $section) = @_;
+    my $outhandle = $self->{'outhandle'};
+    # if we don't want metadata, we may as well not be here ...
+    return if (!defined $self->{'metadata_fields'});
+
+    # metadata fields to extract/save. 'key' is the (lowercase) name of the
+    # html meta, 'value' is the metadata name for greenstone to use
+    my %find_fields = ();
+
+    my %creator_fields = (); # short-cut for lookups
+
+
+    foreach my $field (split /,/, $self->{'metadata_fields'}) {
+        $field =~ s/^\s+//; # remove leading whitespace
+        $field =~ s/\s+$//; # remove trailing whitespace
+
+	# support tag<tagname>
+	if ($field =~ /^(.*?)<(.*?)>$/) {
+	    # "$2" is the user's preferred gs metadata name
+	    $find_fields{lc($1)}=$2; # lc = lowercase
+	} else { # no <tagname> for mapping
+	    # "$field" is the user's preferred gs metadata name
+	    $find_fields{lc($field)}=$field; # lc = lowercase
+	}
+    }
+
+    if (defined $self->{'hunt_creator_metadata'} &&
+	$self->{'hunt_creator_metadata'} == 1 ) {
+	my @extra_fields =
+	    (
+	     'author',
+	     'author.email',
+	     'creator',
+	     'dc.creator',
+	     'dc.creator.corporatename',
+	     );
+
+	# add the creator_metadata fields to search for
+	foreach my $field (@extra_fields) {
+	    $creator_fields{$field}=0; # add to lookup hash
+	}
+    }
+
+
+    # find the header in the html file, which has the meta tags
+    $$textref =~ m@<head>(.*?)</head>@si;
+
+    my $html_header=$1;
+
+    # go through every <meta... tag defined in the html and see if it is
+    # one of the tags we want to match.
+    
+    # special case for title - we want to remember if its been found
+    my $found_title = 0;
+    # this assumes that ">" won't appear. (I don't think it's allowed to...)
+    $html_header =~ /^/; # match the start of the string, for \G assertion
+ 
+    while ($html_header =~ m/\G.*?<meta(.*?)>/sig) {
+	my $metatag=$1;
+	my ($tag, $value);
+
+	# find the tag name
+	$metatag =~ /(?:name|http-equiv)\s*=\s*([\"\'])?(.*?)\1/is;
+	$tag=$2;
+	# in case they're not using " or ', but they should...
+	if (! $tag) {
+	    $metatag =~ /(?:name|http-equiv)\s*=\s*([^\s\>]+)/is;
+	    $tag=$1;
+	}
+
+	if (!defined $tag) {
+	    print $outhandle "HTMLPlug: can't find NAME in \"$metatag\"\n";
+	    next;
+	}
+	
+	# don't need to assign this field if it was passed in from a previous 
+	# (recursive) plugin
+	if (defined $metadata->{$tag}) {next}
+
+	# find the tag content
+	$metatag =~ /content\s*=\s*([\"\'])?(.*?)\1/is;
+	$value=$2;
+
+	if (! $value) {
+	    $metatag =~ /(?:name|http-equiv)\s*=\s*([^\s\>]+)/is;
+	    $value=$1;
+	}
+	if (!defined $value) {
+	    print $outhandle "HTMLPlug: can't find VALUE in \"$metatag\"\n";
+	    next;
+	}
+
+	# clean up and add
+	$value =~ s/\s+/ /gs;
+	chomp($value); # remove trailing \n, if any
+	if (exists $creator_fields{lc($tag)}) {
+	    # map this value onto greenstone's "Creator" metadata
+	    $tag='Creator';
+	} elsif (!exists $find_fields{lc($tag)}) {
+	     next; # don't want this tag
+	} else {
+	    # get the user's preferred capitalisation
+	    $tag = $find_fields{lc($tag)};
+	}
+	if (lc($tag) eq "title") {
+	    $found_title = 1;
+	}
+	print $outhandle " extracted \"$tag\" metadata \"$value\"\n" 
+	    if ($self->{'verbosity'} > 2);
+	if ($tag =~ /date.*/i){
+	    $tag = lc($tag);
+	}
+	$doc_obj->add_utf8_metadata($section, $tag, $value);
+
+    }
+    
+    # TITLE: extract the document title
+    if (exists $find_fields{'title'} && !$found_title) {
+	# we want a title, and didn't find one in the meta tags
+	# see if there's a <title> tag
+	my $title;
+	my $from = ""; # for debugging output only
+	if ($html_header =~ /<title[^>]*>([^<]+)<\/title[^>]*>/is) {
+	    $title = $1;
+	    $from = "<title> tags";
+	}
+
+	if (!defined $title) {
+	    $from = "first 100 chars";
+	    # if no title use first 100 or so characters
+	    $title = $$textref;
+	    $title =~ s/^\xFE\xFF//; # Remove unicode byte order mark	    
+	    $title =~ s/^.*?<body>//si;
+	    # ignore javascript!
+	    $title =~ s@<script.*?</script>@ @sig;
+	    $title =~ s/<\/([^>]+)><\1>//g; # (eg) </b><b> - no space
+	    $title =~ s/<[^>]*>/ /g; # remove all HTML tags
+	    $title = substr ($title, 0, 100);
+	    $title =~ s/\s\S*$/.../;
+	}
+	$title =~ s/<[^>]*>/ /g; # remove html tags
+	$title =~ s/&nbsp;/ /g;
+	$title =~ s/(?:&nbsp;|\xc2\xa0)/ /g; # utf-8 for nbsp...
+	$title =~ s/\s+/ /gs; # collapse multiple spaces
+	$title =~ s/^\s*//;   # remove leading spaces
+	$title =~ s/\s*$//;   # remove trailing spaces
+
+	$title =~ s/^$self->{'title_sub'}// if ($self->{'title_sub'});
+	$title =~ s/^\s+//s; # in case title_sub introduced any...
+	$doc_obj->add_utf8_metadata ($section, 'Title', $title);
+	print $outhandle " extracted Title metadata \"$title\" from $from\n" 
+	    if ($self->{'verbosity'} > 2);
+    } 
+    
+    # add FileFormat metadata
+    $doc_obj->add_metadata($section,"FileFormat", "HTML");
+
+    # Special, for metadata names such as tagH1 - extracts
+    # the text between the first <H1> and </H1> tags into "H1" metadata.
+
+    foreach my $field (keys %find_fields) {
+	if ($field !~ /^tag([a-z0-9]+)$/i) {next}
+	my $tag = $1;
+	if ($$textref =~ m@<$tag[^>]*>(.*?)</$tag[^>]*>@g) {
+	    my $content = $1;
+	    $content =~ s/&nbsp;/ /g;
+	    $content =~ s/<[^>]*>/ /g;
+	    $content =~ s/^\s+//;
+	    $content =~ s/\s+$//;
+	    $content =~ s/\s+/ /gs;
+	    if ($content) {
+		$tag=$find_fields{"tag$tag"}; # get the user's capitalisation
+		$tag =~ s/^tag//i;
+		$doc_obj->add_utf8_metadata ($section, $tag, $content);
+		print $outhandle " extracted \"$tag\" metadata \"$content\"\n" 
+		    if ($self->{'verbosity'} > 2);
+	    }
+	}
+    }    
+}
+
+
+# evaluate any "../" to next directory up
+# evaluate any "./" as here
+sub eval_dir_dots {
+    my $self = shift (@_);
+    my ($filename) = @_;
+    my $dirsep_os = &util::get_os_dirsep();
+    my @dirsep = split(/$dirsep_os/,$filename);
+
+    my @eval_dirs = ();
+    foreach my $d (@dirsep) {
+	if ($d eq "..") {
+	    pop(@eval_dirs);
+	    
+	} elsif ($d eq ".") {
+	    # do nothing!
+
+	} else {
+	    push(@eval_dirs,$d);
+	}
+    }
+
+    # Need to fiddle with number of elements in @eval_dirs if the
+    # first one is the empty string.  This is because of a
+    # modification to util::filename_cat that supresses the addition
+    # of a leading '/' character (or \ if windows) (intended to help
+    # filename cat with relative paths) if the first entry in the
+    # array is the empty string.  Making the array start with *two*
+    # empty strings is a way to defeat this "smart" option.
+    #
+    if (scalar(@eval_dirs) > 0) {
+	if ($eval_dirs[0] eq ""){
+	    unshift(@eval_dirs,"");
+	}
+    }
+    return &util::filename_cat(@eval_dirs);
+}
+
+sub replace_usemap_links {
+    my $self = shift (@_);
+    my ($front, $link, $back) = @_;
+
+    $link =~ s/^\.\///;
+    return $front . $link . $back;
+}
+
+sub inc_filecount {
+    my $self = shift (@_);
+
+    if ($self->{'file_num'} == 1000) {
+	$self->{'dir_num'} ++;
+	$self->{'file_num'} = 0;
+    } else {
+	$self->{'file_num'} ++;
+    }
+}
+
+
+# Extend the BasPlug read_file so that strings like &eacute; are
+# converted to UTF8 internally.  
+#
+# We don't convert &lt; or &gt; or &amp; or &quot; in case
+# they interfere with the GML files
+
+sub read_file {
+    my ($self, $filename, $encoding, $language, $textref) = @_;
+
+    &BasPlug::read_file($self, $filename, $encoding, $language, $textref);
+
+    # Convert entities to their UTF8 equivalents
+    $$textref =~ s/&(lt|gt|amp|quot|nbsp);/&z$1;/go;
+    $$textref =~ s/&([^;]+);/&ghtml::getcharequiv($1,1)/gseo;
+    $$textref =~ s/&z(lt|gt|amp|quot|nbsp);/&$1;/go;
+}
+
+1;
Index: dl/trunk/perllib/plugins/ISISPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ISISPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,406 +1,0 @@
-###########################################################################
-#
-# ISISPlug.pm -- A plugin for CDS/ISIS databases
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright 1999-2004 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 ISISPlug;
-
-
-use multiread;
-use SplitPlug;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-# ISISPlug is a sub-class of SplitPlug.
-sub BEGIN {
-    @ISISPlug::ISA = ('SplitPlug');
-}
-
-
-my $arguments = 
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_process_exp() },
-      { 'name' => "block_exp",
-	'desc' => "{BasPlug.block_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_block_exp(),
-	'hiddengli' => "yes" },
-      { 'name' => "split_exp",
-	'desc' => "{SplitPlug.split_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_split_exp(),
-        'hiddengli' => "yes" },
-
-      # The interesting options
-      { 'name' => "entry_separator",
-	'desc' => "{ISISPlug.entry_separator}",
-	'type' => "string",
-	'reqd' => "no",
-	'deft' => "<br>" },
-      { 'name' => "subfield_separator",
-	'desc' => "{ISISPlug.subfield_separator}",
-	'type' => "string",
-	'reqd' => "no",
-	'deft' => ", " }
-      ];
-
-my $options = { 'name'     => "ISISPlug",
-		'desc'     => "{ISISPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'explodes' => "yes",
-		'args'     => $arguments };
-
-
-# This plugin processes files with the suffix ".mst"
-sub get_default_process_exp {
-    return q^(?i)(\.mst)$^;
-}
-
-
-# This plugin blocks files with the suffix ".fdt" and ".xrf"
-sub get_default_block_exp {
-    return q^(?i)(\.fdt|\.xrf)$^;
-}
-
-    
-# This plugin splits the input text at the "----------" lines
-sub get_default_split_exp {
-    return q^\r?\n----------\r?\n^;
-}
-
-
-sub new
-{
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new SplitPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    if ($self->{'info_only'}) {
-	# don't worry about any options etc
-	return bless $self, $class;
-    }
-
-    # isis plug doesn't care about encoding - it assumes ascii unless the user
-    # has specified an encoding
-    if ($self->{'input_encoding'} eq "auto") {
-	$self->{'input_encoding'} = "ascii";
-    }
-    return bless $self, $class;
-}
-
-
-sub read_file
-{
-    my $self = shift (@_);
-    my ($filename, $encoding, $language, $textref) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    my ($database_file_path_root) = ($filename =~ /(.*)\.mst$/i);
-    my $mst_file_path_relative = $filename;
-    $mst_file_path_relative =~ s/^.+import.(.*?)$/$1/;
-
-    # Check the associated .fdt and .xrf files exist
-    $self->{'fdt_file_path'} = $database_file_path_root . ".FDT";
-    if (!-e $self->{'fdt_file_path'}) {
-	$self->{'fdt_file_path'} = $database_file_path_root . ".fdt";
-    }
-    if (!-e $self->{'fdt_file_path'}) {
-	print STDERR "<ProcessingError n='$mst_file_path_relative' r='Could not find ISIS FDT file $self->{'fdt_file_path'}'>\n" if ($self->{'gli'});
-	print $outhandle "Error: Could not find ISIS FDT file " . $self->{'fdt_file_path'} . ".\n";
-	return;
-    }
-    $self->{'xrf_file_path'} = $database_file_path_root . ".XRF";
-    if (!-e $self->{'xrf_file_path'}) {
-	$self->{'xrf_file_path'} = $database_file_path_root . ".xrf";
-    }
-    if (!-e $self->{'xrf_file_path'}) {
-	print STDERR "<ProcessingError n='$mst_file_path_relative' r='Could not find ISIS XRF file $self->{'xrf_file_path'}'>\n" if ($self->{'gli'});
-	print $outhandle "Error: Could not find ISIS XRF file " . $self->{'xrf_file_path'} . ".\n";
-	return;
-    }
-
-    # The text to split is exported from the database by the IsisGdl program
-    open(FILE, "IsisGdl \"$filename\" |");
-
-    my $reader = new multiread();
-    $reader->set_handle('ISISPlug::FILE');
-    $reader->set_encoding($encoding);
-    $reader->read_file($textref);
-
-    close(FILE);
-
-    # Parse the associated ISIS database Field Definition Table file (.fdt)
-    my %fdt_mapping = &parse_field_definition_table($self->{'fdt_file_path'}, $encoding);
-    $self->{'fdt_mapping'} = \%fdt_mapping;
-
-    # Remove the line at the start, and any blank lines, so the data is split and processed properly
-    $$textref =~ s/^----------\n//;
-    $$textref =~ s/\n\n/\n/g;
-}
-
-
-sub process
-{
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    my $section = $doc_obj->get_top_section();
-    my $fdt_mapping = $self->{'fdt_mapping'};
-    my $subfield_separator = $self->{'subfield_separator'};
-    my $entry_separator = $self->{'entry_separator'};
-    my $isis_record_html_metadata_value = "<table cellpadding=\"4\" cellspacing=\"0\">";
-
-    # Report that we're processing the file
-    print STDERR "\n<Processing n='$file' p='ISISPlug'>\n" if ($gli);
-    print $outhandle "IsisPlug: processing $file\n" if ($self->{'verbosity'}) > 1;
-
-    # Process each line of the ISIS record, one at a time
-    foreach my $line (split(/\n/, $$textref)) {
-	$line =~ s/(\s*)$//;  # Remove any nasty whitespace (very important for Windows)
-	$line =~ /^tag=(.*) data=(.+)$/;
-	my $tag = $1;
-	my $tag_data = $2;
-        # print STDERR "\nTag: $tag, Data: $tag_data\n";
-
-	# Convert the tag number into a name, and remove any invalid characters
-	my $raw_metadata_name = $fdt_mapping->{$tag}{'name'} || "";
-	$raw_metadata_name =~ s/[,&\#\.\-\/]/ /g;
-	next if ($raw_metadata_name eq "");
-
-	# Metadata field names: title case, then remove spaces
-	my $metadata_name = "";
-	foreach my $word (split(/\s+/, $raw_metadata_name)) {
-	    substr($word, 0, 1) =~ tr/a-z/A-Z/;
-	    $metadata_name .= $word;
-	}
-
-	my $all_metadata_name = $metadata_name . "^all";
-	my $all_metadata_value = "";
-
-	# Handle repeatable fields
-	if ($fdt_mapping->{$tag}{'repeatable'}) {
-	    # Multiple values are separated using the '%' character
-	    foreach my $raw_metadata_value (split(/%/, $tag_data)) {
-		my $metadata_value = "";
-
-		# Handle subfields
-		while ($raw_metadata_value ne "") {
-		    # If there is a subfield specifier, parse it off
-		    my $sub_metadata_name = $metadata_name;
-		    if ($raw_metadata_value =~ s/^\^// && $raw_metadata_value =~ s/^([a-z])//) {
-			$sub_metadata_name .= "^$1";
-		    }
-
-		    # Parse the value off and add it as metadata
-		    $raw_metadata_value =~ s/^([^\^]*)//;
-		    my $sub_metadata_value = &escape_metadata_value($1);
-
-		    # print STDERR "Sub metadata name: $sub_metadata_name, value: $sub_metadata_value\n";
-		    if ($sub_metadata_name ne $metadata_name) {
-			$doc_obj->add_utf8_metadata($section, $sub_metadata_name, $sub_metadata_value); 
-		    }
-
-		    # If this tag has subfields and this is the first, use the value for the CDS/ISIS ^* field
-		    if ($fdt_mapping->{$tag}{'subfields'} ne "" && $metadata_value eq "") {
-			$doc_obj->add_utf8_metadata($section, $metadata_name . "^*", $sub_metadata_value); 
-		    }
-
-		    $metadata_value .= $subfield_separator unless ($metadata_value eq "");
-		    $metadata_value .= $sub_metadata_value;
-		}
-
-		# Add the metadata value
-		# print STDERR "Metadata name: $metadata_name, value: $metadata_value\n";
-		$doc_obj->add_utf8_metadata($section, $metadata_name, $metadata_value); 
-
-		$all_metadata_value .= $entry_separator unless ($all_metadata_value eq "");
-		$all_metadata_value .= $metadata_value;
-	    }
-	}
-
-	# Handle non-repeatable fields
-	else {
-	    my $raw_metadata_value = $tag_data;
-	    my $metadata_value = "";
-
-	    # Handle subfields
-	    while ($raw_metadata_value ne "") {
-		# If there is a subfield specifier, parse it off
-		my $sub_metadata_name = $metadata_name;
-		if ($raw_metadata_value =~ s/^\^// && $raw_metadata_value =~ s/^([a-z])//) {
-		    $sub_metadata_name .= "^$1";
-		}
-
-		# Parse the value off and add it as metadata
-		$raw_metadata_value =~ s/^([^\^]*)//;
-		my $sub_metadata_value = $1;
-
-		# Deal with the case when multiple values are specified using <...>
-		if ($sub_metadata_value =~ /\<(.+)\>/) {
-		    my $sub_sub_metadata_name = $sub_metadata_name . "^sub";
-		    my $tmp_sub_metadata_value = $sub_metadata_value;
-		    while ($tmp_sub_metadata_value =~ s/\<(.+?)\>//) {
-			my $sub_sub_metadata_value = $1;
-			$doc_obj->add_utf8_metadata($section, $sub_sub_metadata_name, $sub_sub_metadata_value); 
-		    }
-		}
-		# Deal with the legacy case when multiple values are specified using /.../
-		elsif ($sub_metadata_value =~ /\/(.+)\//) {
-		    my $sub_sub_metadata_name = $sub_metadata_name . "^sub";
-		    my $tmp_sub_metadata_value = $sub_metadata_value;
-		    while ($tmp_sub_metadata_value =~ s/\/(.+?)\///) {
-			my $sub_sub_metadata_value = $1;
-			$doc_obj->add_utf8_metadata($section, $sub_sub_metadata_name, $sub_sub_metadata_value); 
-		    }
-		}
-
-		# Escape the metadata value so it appears correctly in the final collection
-		$sub_metadata_value = &escape_metadata_value($sub_metadata_value);
-
-		# print STDERR "Sub metadata name: $sub_metadata_name, value: $sub_metadata_value\n";
-		if ($sub_metadata_name ne $metadata_name) {
-		    $doc_obj->add_utf8_metadata($section, $sub_metadata_name, $sub_metadata_value); 
-		}
-
-		# If this tag has subfields and this is the first, use the value for the CDS/ISIS ^* field
-		if ($fdt_mapping->{$tag}{'subfields'} ne "" && $metadata_value eq "") {
-		    $doc_obj->add_utf8_metadata($section, $metadata_name . "^*", $sub_metadata_value); 
-		}
-
-		$metadata_value .= $subfield_separator unless ($metadata_value eq "");
-		$metadata_value .= $sub_metadata_value;
-	    }
-
-	    # Add the metadata value
-	    # print STDERR "Metadata name: $metadata_name, value: $metadata_value\n";
-	    $doc_obj->add_utf8_metadata($section, $metadata_name, $metadata_value); 
-
-	    $all_metadata_value .= $entry_separator unless ($all_metadata_value eq "");
-	    $all_metadata_value .= $metadata_value;
-	}
-
-	# Add the "^all" metadata value
-	# print STDERR "All metadata name: $all_metadata_name, value: $all_metadata_value\n";
-	$doc_obj->add_utf8_metadata($section, $all_metadata_name, $all_metadata_value); 
-
-	$isis_record_html_metadata_value .= "<tr><td valign=top><nobr><b>" . $fdt_mapping->{$tag}{'name'} . "</b></nobr></td><td valign=top>" . $all_metadata_value . "</td></tr>";
-    }
-
-    # Add a reasonably formatted HTML table view of the record as the document text
-    $isis_record_html_metadata_value .= "</table>";
-    $doc_obj->add_utf8_text($section, $isis_record_html_metadata_value);
-
-    # Add the full raw record as metadata
-    my $isis_raw_record_metadata_value = &escape_metadata_value($$textref);
-    $doc_obj->add_utf8_metadata($section, "ISISRawRecord", $isis_raw_record_metadata_value);
-
-    # Add FileFormat metadata
-    $doc_obj->add_utf8_metadata($section, "FileFormat", "CDS/ISIS");
-
-    # Record was processed successfully
-    return 1;
-}
-
-
-sub parse_field_definition_table
-{
-    my $fdtfilename = shift(@_);
-    my $encoding = shift(@_);
-
-    my %fdtmapping = ();
-
-    open(FDT_FILE, "<$fdtfilename") || die "Error: Could not open file $fdtfilename.\n";
-
-    my $fdtfiletext = "";
-    my $reader = new multiread();
-    $reader->set_handle('ISISPlug::FDT_FILE');
-    $reader->set_encoding($encoding);
-    $reader->read_file($fdtfiletext);
-
-    my $amongstdefinitions = 0;
-    foreach my $fdtfileline (split(/\n/, $$fdtfiletext)) {
-	$fdtfileline =~ s/(\s*)$//;  # Remove any nasty spaces at the end of the lines
-
-	if ($amongstdefinitions) {
-	    my $fieldname      = &unicode::substr($fdtfileline,  0, 30);
-	    my $fieldsubfields = &unicode::substr($fdtfileline, 30, 20);
-	    my $fieldspecs     = &unicode::substr($fdtfileline, 50, 50);
-
-	    # Remove extra spaces
-	    $fieldname =~ s/(\s*)$//;
-	    $fieldsubfields =~ s/(\s*)$//;
-	    $fieldspecs =~ s/(\s*)$//;
-
-	    # Map from tag number to metadata field title, subfields, and repeatability
-	    my $fieldtag = (split(/ /, $fieldspecs))[0];
-	    my $fieldrepeatable = (split(/ /, $fieldspecs))[3];
-	    $fdtmapping{$fieldtag} = { 'name' => $fieldname,
-				       'subfields' => $fieldsubfields,
-				       'repeatable' => $fieldrepeatable };
-	}
-	elsif ($fdtfileline eq "***") {
-	    $amongstdefinitions = 1;
-	}
-    }
-
-    close(FDT_FILE);
-
-    return %fdtmapping;
-}
-
-
-sub escape_metadata_value
-{
-    my $value = shift(@_);
-    $value =~ s/\</&lt;/g;
-    $value =~ s/\>/&gt;/g;
-    $value =~ s/\\/\\\\/g;
-    return $value;
-}
-
-
-sub clean_up_after_exploding
-{
-    my $self = shift(@_);
-
-    # Delete the FDT and XRF files too
-    &util::rm($self->{'fdt_file_path'});
-    &util::rm($self->{'xrf_file_path'});
-}
-
-
-1;
Index: /gsdl/trunk/perllib/plugins/ISISPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ISISPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/ISISPlugin.pm	(revision 15865)
@@ -0,0 +1,406 @@
+###########################################################################
+#
+# ISISPlug.pm -- A plugin for CDS/ISIS databases
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright 1999-2004 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 ISISPlug;
+
+
+use multiread;
+use SplitPlug;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+# ISISPlug is a sub-class of SplitPlug.
+sub BEGIN {
+    @ISISPlug::ISA = ('SplitPlug');
+}
+
+
+my $arguments = 
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_process_exp() },
+      { 'name' => "block_exp",
+	'desc' => "{BasPlug.block_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_block_exp(),
+	'hiddengli' => "yes" },
+      { 'name' => "split_exp",
+	'desc' => "{SplitPlug.split_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_split_exp(),
+        'hiddengli' => "yes" },
+
+      # The interesting options
+      { 'name' => "entry_separator",
+	'desc' => "{ISISPlug.entry_separator}",
+	'type' => "string",
+	'reqd' => "no",
+	'deft' => "<br>" },
+      { 'name' => "subfield_separator",
+	'desc' => "{ISISPlug.subfield_separator}",
+	'type' => "string",
+	'reqd' => "no",
+	'deft' => ", " }
+      ];
+
+my $options = { 'name'     => "ISISPlug",
+		'desc'     => "{ISISPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'explodes' => "yes",
+		'args'     => $arguments };
+
+
+# This plugin processes files with the suffix ".mst"
+sub get_default_process_exp {
+    return q^(?i)(\.mst)$^;
+}
+
+
+# This plugin blocks files with the suffix ".fdt" and ".xrf"
+sub get_default_block_exp {
+    return q^(?i)(\.fdt|\.xrf)$^;
+}
+
+    
+# This plugin splits the input text at the "----------" lines
+sub get_default_split_exp {
+    return q^\r?\n----------\r?\n^;
+}
+
+
+sub new
+{
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new SplitPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    if ($self->{'info_only'}) {
+	# don't worry about any options etc
+	return bless $self, $class;
+    }
+
+    # isis plug doesn't care about encoding - it assumes ascii unless the user
+    # has specified an encoding
+    if ($self->{'input_encoding'} eq "auto") {
+	$self->{'input_encoding'} = "ascii";
+    }
+    return bless $self, $class;
+}
+
+
+sub read_file
+{
+    my $self = shift (@_);
+    my ($filename, $encoding, $language, $textref) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    my ($database_file_path_root) = ($filename =~ /(.*)\.mst$/i);
+    my $mst_file_path_relative = $filename;
+    $mst_file_path_relative =~ s/^.+import.(.*?)$/$1/;
+
+    # Check the associated .fdt and .xrf files exist
+    $self->{'fdt_file_path'} = $database_file_path_root . ".FDT";
+    if (!-e $self->{'fdt_file_path'}) {
+	$self->{'fdt_file_path'} = $database_file_path_root . ".fdt";
+    }
+    if (!-e $self->{'fdt_file_path'}) {
+	print STDERR "<ProcessingError n='$mst_file_path_relative' r='Could not find ISIS FDT file $self->{'fdt_file_path'}'>\n" if ($self->{'gli'});
+	print $outhandle "Error: Could not find ISIS FDT file " . $self->{'fdt_file_path'} . ".\n";
+	return;
+    }
+    $self->{'xrf_file_path'} = $database_file_path_root . ".XRF";
+    if (!-e $self->{'xrf_file_path'}) {
+	$self->{'xrf_file_path'} = $database_file_path_root . ".xrf";
+    }
+    if (!-e $self->{'xrf_file_path'}) {
+	print STDERR "<ProcessingError n='$mst_file_path_relative' r='Could not find ISIS XRF file $self->{'xrf_file_path'}'>\n" if ($self->{'gli'});
+	print $outhandle "Error: Could not find ISIS XRF file " . $self->{'xrf_file_path'} . ".\n";
+	return;
+    }
+
+    # The text to split is exported from the database by the IsisGdl program
+    open(FILE, "IsisGdl \"$filename\" |");
+
+    my $reader = new multiread();
+    $reader->set_handle('ISISPlug::FILE');
+    $reader->set_encoding($encoding);
+    $reader->read_file($textref);
+
+    close(FILE);
+
+    # Parse the associated ISIS database Field Definition Table file (.fdt)
+    my %fdt_mapping = &parse_field_definition_table($self->{'fdt_file_path'}, $encoding);
+    $self->{'fdt_mapping'} = \%fdt_mapping;
+
+    # Remove the line at the start, and any blank lines, so the data is split and processed properly
+    $$textref =~ s/^----------\n//;
+    $$textref =~ s/\n\n/\n/g;
+}
+
+
+sub process
+{
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    my $section = $doc_obj->get_top_section();
+    my $fdt_mapping = $self->{'fdt_mapping'};
+    my $subfield_separator = $self->{'subfield_separator'};
+    my $entry_separator = $self->{'entry_separator'};
+    my $isis_record_html_metadata_value = "<table cellpadding=\"4\" cellspacing=\"0\">";
+
+    # Report that we're processing the file
+    print STDERR "\n<Processing n='$file' p='ISISPlug'>\n" if ($gli);
+    print $outhandle "IsisPlug: processing $file\n" if ($self->{'verbosity'}) > 1;
+
+    # Process each line of the ISIS record, one at a time
+    foreach my $line (split(/\n/, $$textref)) {
+	$line =~ s/(\s*)$//;  # Remove any nasty whitespace (very important for Windows)
+	$line =~ /^tag=(.*) data=(.+)$/;
+	my $tag = $1;
+	my $tag_data = $2;
+        # print STDERR "\nTag: $tag, Data: $tag_data\n";
+
+	# Convert the tag number into a name, and remove any invalid characters
+	my $raw_metadata_name = $fdt_mapping->{$tag}{'name'} || "";
+	$raw_metadata_name =~ s/[,&\#\.\-\/]/ /g;
+	next if ($raw_metadata_name eq "");
+
+	# Metadata field names: title case, then remove spaces
+	my $metadata_name = "";
+	foreach my $word (split(/\s+/, $raw_metadata_name)) {
+	    substr($word, 0, 1) =~ tr/a-z/A-Z/;
+	    $metadata_name .= $word;
+	}
+
+	my $all_metadata_name = $metadata_name . "^all";
+	my $all_metadata_value = "";
+
+	# Handle repeatable fields
+	if ($fdt_mapping->{$tag}{'repeatable'}) {
+	    # Multiple values are separated using the '%' character
+	    foreach my $raw_metadata_value (split(/%/, $tag_data)) {
+		my $metadata_value = "";
+
+		# Handle subfields
+		while ($raw_metadata_value ne "") {
+		    # If there is a subfield specifier, parse it off
+		    my $sub_metadata_name = $metadata_name;
+		    if ($raw_metadata_value =~ s/^\^// && $raw_metadata_value =~ s/^([a-z])//) {
+			$sub_metadata_name .= "^$1";
+		    }
+
+		    # Parse the value off and add it as metadata
+		    $raw_metadata_value =~ s/^([^\^]*)//;
+		    my $sub_metadata_value = &escape_metadata_value($1);
+
+		    # print STDERR "Sub metadata name: $sub_metadata_name, value: $sub_metadata_value\n";
+		    if ($sub_metadata_name ne $metadata_name) {
+			$doc_obj->add_utf8_metadata($section, $sub_metadata_name, $sub_metadata_value); 
+		    }
+
+		    # If this tag has subfields and this is the first, use the value for the CDS/ISIS ^* field
+		    if ($fdt_mapping->{$tag}{'subfields'} ne "" && $metadata_value eq "") {
+			$doc_obj->add_utf8_metadata($section, $metadata_name . "^*", $sub_metadata_value); 
+		    }
+
+		    $metadata_value .= $subfield_separator unless ($metadata_value eq "");
+		    $metadata_value .= $sub_metadata_value;
+		}
+
+		# Add the metadata value
+		# print STDERR "Metadata name: $metadata_name, value: $metadata_value\n";
+		$doc_obj->add_utf8_metadata($section, $metadata_name, $metadata_value); 
+
+		$all_metadata_value .= $entry_separator unless ($all_metadata_value eq "");
+		$all_metadata_value .= $metadata_value;
+	    }
+	}
+
+	# Handle non-repeatable fields
+	else {
+	    my $raw_metadata_value = $tag_data;
+	    my $metadata_value = "";
+
+	    # Handle subfields
+	    while ($raw_metadata_value ne "") {
+		# If there is a subfield specifier, parse it off
+		my $sub_metadata_name = $metadata_name;
+		if ($raw_metadata_value =~ s/^\^// && $raw_metadata_value =~ s/^([a-z])//) {
+		    $sub_metadata_name .= "^$1";
+		}
+
+		# Parse the value off and add it as metadata
+		$raw_metadata_value =~ s/^([^\^]*)//;
+		my $sub_metadata_value = $1;
+
+		# Deal with the case when multiple values are specified using <...>
+		if ($sub_metadata_value =~ /\<(.+)\>/) {
+		    my $sub_sub_metadata_name = $sub_metadata_name . "^sub";
+		    my $tmp_sub_metadata_value = $sub_metadata_value;
+		    while ($tmp_sub_metadata_value =~ s/\<(.+?)\>//) {
+			my $sub_sub_metadata_value = $1;
+			$doc_obj->add_utf8_metadata($section, $sub_sub_metadata_name, $sub_sub_metadata_value); 
+		    }
+		}
+		# Deal with the legacy case when multiple values are specified using /.../
+		elsif ($sub_metadata_value =~ /\/(.+)\//) {
+		    my $sub_sub_metadata_name = $sub_metadata_name . "^sub";
+		    my $tmp_sub_metadata_value = $sub_metadata_value;
+		    while ($tmp_sub_metadata_value =~ s/\/(.+?)\///) {
+			my $sub_sub_metadata_value = $1;
+			$doc_obj->add_utf8_metadata($section, $sub_sub_metadata_name, $sub_sub_metadata_value); 
+		    }
+		}
+
+		# Escape the metadata value so it appears correctly in the final collection
+		$sub_metadata_value = &escape_metadata_value($sub_metadata_value);
+
+		# print STDERR "Sub metadata name: $sub_metadata_name, value: $sub_metadata_value\n";
+		if ($sub_metadata_name ne $metadata_name) {
+		    $doc_obj->add_utf8_metadata($section, $sub_metadata_name, $sub_metadata_value); 
+		}
+
+		# If this tag has subfields and this is the first, use the value for the CDS/ISIS ^* field
+		if ($fdt_mapping->{$tag}{'subfields'} ne "" && $metadata_value eq "") {
+		    $doc_obj->add_utf8_metadata($section, $metadata_name . "^*", $sub_metadata_value); 
+		}
+
+		$metadata_value .= $subfield_separator unless ($metadata_value eq "");
+		$metadata_value .= $sub_metadata_value;
+	    }
+
+	    # Add the metadata value
+	    # print STDERR "Metadata name: $metadata_name, value: $metadata_value\n";
+	    $doc_obj->add_utf8_metadata($section, $metadata_name, $metadata_value); 
+
+	    $all_metadata_value .= $entry_separator unless ($all_metadata_value eq "");
+	    $all_metadata_value .= $metadata_value;
+	}
+
+	# Add the "^all" metadata value
+	# print STDERR "All metadata name: $all_metadata_name, value: $all_metadata_value\n";
+	$doc_obj->add_utf8_metadata($section, $all_metadata_name, $all_metadata_value); 
+
+	$isis_record_html_metadata_value .= "<tr><td valign=top><nobr><b>" . $fdt_mapping->{$tag}{'name'} . "</b></nobr></td><td valign=top>" . $all_metadata_value . "</td></tr>";
+    }
+
+    # Add a reasonably formatted HTML table view of the record as the document text
+    $isis_record_html_metadata_value .= "</table>";
+    $doc_obj->add_utf8_text($section, $isis_record_html_metadata_value);
+
+    # Add the full raw record as metadata
+    my $isis_raw_record_metadata_value = &escape_metadata_value($$textref);
+    $doc_obj->add_utf8_metadata($section, "ISISRawRecord", $isis_raw_record_metadata_value);
+
+    # Add FileFormat metadata
+    $doc_obj->add_utf8_metadata($section, "FileFormat", "CDS/ISIS");
+
+    # Record was processed successfully
+    return 1;
+}
+
+
+sub parse_field_definition_table
+{
+    my $fdtfilename = shift(@_);
+    my $encoding = shift(@_);
+
+    my %fdtmapping = ();
+
+    open(FDT_FILE, "<$fdtfilename") || die "Error: Could not open file $fdtfilename.\n";
+
+    my $fdtfiletext = "";
+    my $reader = new multiread();
+    $reader->set_handle('ISISPlug::FDT_FILE');
+    $reader->set_encoding($encoding);
+    $reader->read_file($fdtfiletext);
+
+    my $amongstdefinitions = 0;
+    foreach my $fdtfileline (split(/\n/, $$fdtfiletext)) {
+	$fdtfileline =~ s/(\s*)$//;  # Remove any nasty spaces at the end of the lines
+
+	if ($amongstdefinitions) {
+	    my $fieldname      = &unicode::substr($fdtfileline,  0, 30);
+	    my $fieldsubfields = &unicode::substr($fdtfileline, 30, 20);
+	    my $fieldspecs     = &unicode::substr($fdtfileline, 50, 50);
+
+	    # Remove extra spaces
+	    $fieldname =~ s/(\s*)$//;
+	    $fieldsubfields =~ s/(\s*)$//;
+	    $fieldspecs =~ s/(\s*)$//;
+
+	    # Map from tag number to metadata field title, subfields, and repeatability
+	    my $fieldtag = (split(/ /, $fieldspecs))[0];
+	    my $fieldrepeatable = (split(/ /, $fieldspecs))[3];
+	    $fdtmapping{$fieldtag} = { 'name' => $fieldname,
+				       'subfields' => $fieldsubfields,
+				       'repeatable' => $fieldrepeatable };
+	}
+	elsif ($fdtfileline eq "***") {
+	    $amongstdefinitions = 1;
+	}
+    }
+
+    close(FDT_FILE);
+
+    return %fdtmapping;
+}
+
+
+sub escape_metadata_value
+{
+    my $value = shift(@_);
+    $value =~ s/\</&lt;/g;
+    $value =~ s/\>/&gt;/g;
+    $value =~ s/\\/\\\\/g;
+    return $value;
+}
+
+
+sub clean_up_after_exploding
+{
+    my $self = shift(@_);
+
+    # Delete the FDT and XRF files too
+    &util::rm($self->{'fdt_file_path'});
+    &util::rm($self->{'xrf_file_path'});
+}
+
+
+1;
Index: dl/trunk/perllib/plugins/ImagePlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ImagePlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,501 +1,0 @@
-###########################################################################
-#
-# ImagePlug.pm -- simple text plugin
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999 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 ImagePlug;
-
-use BasPlug;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @ImagePlug::ISA = ('BasPlug');
-}
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" },
-      { 'name' => "cache_generated_images",
-	'desc' => "{ImagePlug.cache_generated_image}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "noscaleup",
-	'desc' => "{ImagePlug.noscaleup}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "nothumbnail",
-	'desc' => "{ImagePlug.generatethumbnail}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "thumbnailsize",
-	'desc' => "{ImagePlug.thumbnailsize}",
-	'type' => "int",
-	'deft' => "100",
-	'range' => "1,",
-	'reqd' => "no" },
-      { 'name' => "thumbnailtype",
-	'desc' => "{ImagePlug.thumbnailtype}",
-	'type' => "string",
-	'deft' => "gif",
-	'reqd' => "no" },
-      { 'name' => "noscreenview",
-	'desc' => "{ImagePlug.generatescreenview}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "screenviewsize",
-	'desc' => "{ImagePlug.screenviewsize}",
-	'type' => "int",
-	'deft' => "0",
-	'range' => "1,",
-	'reqd' => "no" },
-      { 'name' => "screenviewtype",
-	'desc' => "{ImagePlug.screenviewtype}",
-	'type' => "string",
-	'deft' => "jpg",
-	'reqd' => "no" },
-      { 'name' => "converttotype",
-	'desc' => "{ImagePlug.converttotype}",
-	'type' => "string",
-	'deft' => "",
-	'reqd' => "no" },
-      { 'name' => "minimumsize",
-	'desc' => "{ImagePlug.minimumsize}",
-	'type' => "int",
-	'deft' => "100",
-	'range' => "1,",
-	'reqd' => "no" } ];
-
-my $options = { 'name'     => "ImagePlug",
-		'desc'     => "{ImagePlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-    $self->{'tmp_file_paths'} = ();
-
-    # Check that ImageMagick is installed and available on the path (except for Windows 95/98)
-    if (!($ENV{'GSDLOS'} eq "windows" && !Win32::IsWinNT())) {
-	my $result = `identify 2>&1`;
-	if ($? == -1 || $? == 256) {  # Linux and Windows return different values for "program not found"
-	    $self->{'imagemagick_not_installed'} = 1;
-	}
-    }
-
-       
-    return bless $self, $class;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)(\.jpe?g|\.gif|\.png|\.bmp|\.xbm|\.tif?f)$^; 
-}
-
-# this makes no sense for images
-sub block_cover_image
-{
-    my $self =shift (@_);
-    my ($filename) = @_;
-
-    return;
-}
-# Create the thumbnail and screenview images, and discover the Image's
-# size, width, and height using the convert utility.
-
-sub generate_images
-{
-    my $self = shift (@_);
-    my $filename = shift (@_);   # filename with full path
-    my $file = shift (@_);       # filename without path
-    my $doc_obj = shift (@_);
-    my $section = $doc_obj->get_top_section();
-    
-    my $verbosity = $self->{'verbosity'};
-    my $outhandle = $self->{'outhandle'};
-
-    # check the filename is okay
-    return 0 if ($file eq "" || $filename eq "");
-
-#    Code now extended to quote filenames in 'convert' commnads
-#    Allows spaces in filenames, but note needs spaces to be escaped in URL as well
-#    if ($filename =~ m/ /) {
-#	print $outhandle "ImagePlug: \"$filename\" contains a space. choking.\n";
-#	return undef;
-#    }
-
-    my $minimumsize = $self->{'minimumsize'};
-    if (defined $minimumsize && (-s $filename < $minimumsize)) {
-        print $outhandle "ImagePlug: \"$filename\" too small, skipping\n"
-	    if ($verbosity > 1);
-    }
-
-
-    # Convert the image to a new type (if required).
-    my $converttotype = $self->{'converttotype'};
-    my $originalfilename = "";  # only set if we do a conversion
-    my $type = "unknown";
-
-    if ($converttotype ne "" && $filename !~ m/$converttotype$/) {
-	$originalfilename = $filename;
-
-	my $result = $self->convert($originalfilename, $converttotype, "", "");
-	($filename) = ($result =~ /=>(.*\.$converttotype)/);
-
-	$type = $converttotype;
-	$file =~ s/\..*$/\.$type/;
-    }
-    
-
-    # Add the image metadata
-    my $url = $file;
-    
-    ##not know why it is required at the first place, it seems all works fine without it, so I comment it out 
-    ##$url =~ s/ /%20/g;
-
-    my $utf8_filename_meta = $self->filename_to_metadata($url);
-    $doc_obj->add_utf8_metadata ($section, "Image", $utf8_filename_meta);
-
-    # Also want to set filename as 'Source' metadata to be
-    # consistent with other plugins
-    $doc_obj->add_utf8_metadata ($section, "Source", $utf8_filename_meta);
-
-    my ($image_type, $image_width, $image_height, $image_size) 
-	= &identify($filename, $outhandle, $verbosity);
-
-    if ($image_type ne " ") {
-	$type = $image_type;
-    }
-    
-    $doc_obj->add_metadata ($section, "FileFormat", $type);
-    $doc_obj->add_metadata ($section, "FileSize",   $image_size);
-
-    $doc_obj->add_metadata ($section, "ImageType",   $image_type);
-    $doc_obj->add_metadata ($section, "ImageWidth",  $image_width);
-    $doc_obj->add_metadata ($section, "ImageHeight", $image_height);
-    $doc_obj->add_metadata ($section, "ImageSize",   $image_size);
-    $doc_obj->add_metadata ($section, "NoText",    "1");
-
-    $doc_obj->add_metadata ($section, "srclink", 
-			    "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Image]\">");
-    $doc_obj->add_metadata ($section, "/srclink", "</a>");
-
-    $doc_obj->add_metadata ($section, "srcicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Image]\" width=100>");
-
-    
-    # Add the image as an associated file
-    $doc_obj->associate_file($filename,$file,"image/$type",$section);
-
-
-    if (!$self->{'nothumbnail'}) {
-
-	# Make the thumbnail image
-	my $thumbnailsize = $self->{'thumbnailsize'} || 100;
-	my $thumbnailtype = $self->{'thumbnailtype'} || 'gif';
-
-	# Generate the thumbnail with convert
-	my $result = $self->convert($filename, $thumbnailtype, "-geometry $thumbnailsize" . "x$thumbnailsize", "THUMB");
-	my ($thumbnailfile) = ($result =~ /=>(.*\.$thumbnailtype)/);
-	
-	# Add the thumbnail as an associated file ...
-	if (-e "$thumbnailfile") { 
-	    $doc_obj->associate_file("$thumbnailfile", "thumbnail.$thumbnailtype", 
-				     "image/$thumbnailtype",$section);
-	    $doc_obj->add_metadata ($section, "ThumbType", $thumbnailtype);
-	    $doc_obj->add_metadata ($section, "Thumb", "thumbnail.$thumbnailtype");
-	    
-	    $doc_obj->add_metadata ($section, "thumbicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Thumb]\" width=[ThumbWidth] height=[ThumbHeight]>");
-	}
-
-	# Extract Thumnail metadata from convert output
-	if ($result =~ m/[0-9]+x[0-9]+=>([0-9]+)x([0-9]+)/) {
-	    $doc_obj->add_metadata ($section, "ThumbWidth", $1);
-	    $doc_obj->add_metadata ($section, "ThumbHeight", $2);
-	}
-
-    }
-
-
-    # Make a screen-sized version of the picture if requested
-    if (!$self->{'noscreenview'}) {
-
-	# To do: if the actual image smaller than the screenview size,
-	# we should use the original !
-
-	my $screenviewsize = $self->{'screenviewsize'};
-	my $screenviewtype = $self->{'screenviewtype'} || 'jpeg';
-
-	# make the screenview image
-	my $result = $self->convert($filename, $screenviewtype, "-geometry $screenviewsize" . "x$screenviewsize", "SCREEN");
-	my ($screenviewfilename) = ($result =~ /=>(.*\.$screenviewtype)/);
-
-	# get screenview dimensions, size and type
-        if ($result =~ m/[0-9]+x[0-9]+=>([0-9]+)x([0-9]+)/) {
-	    $doc_obj->add_metadata ($section, "ScreenWidth", $1);
-	    $doc_obj->add_metadata ($section, "ScreenHeight", $2);
-	}
-	else {
-	    $doc_obj->add_metadata ($section, "ScreenWidth", $image_width);
-	    $doc_obj->add_metadata ($section, "ScreenHeight", $image_height);
-	}
-
-	#add the screenview as an associated file ...
-	if (-e "$screenviewfilename") { 
-	    $doc_obj->associate_file("$screenviewfilename", "screenview.$screenviewtype",
-				     "image/$screenviewtype",$section);
-	    $doc_obj->add_metadata ($section, "ScreenType", $screenviewtype);
-	    $doc_obj->add_metadata ($section, "Screen", "screenview.$screenviewtype");
-
-	    $doc_obj->add_metadata ($section, "screenicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Screen]\" width=[ScreenWidth] height=[ScreenHeight]>");
-	} else {
-	    print $outhandle "ImagePlug: couldn't find \"$screenviewfilename\"\n";
-	}
-    }
-
-    return $type;
-
-
-}
-
-
-
-# Discover the characteristics of an image file with the ImageMagick
-# "identify" command.
-
-sub identify { 
-    my ($image, $outhandle, $verbosity) = @_;
-
-    # Use the ImageMagick "identify" command to get the file specs
-    my $command = "identify \"$image\" 2>&1";
-    print $outhandle "$command\n" if ($verbosity > 2);
-    my $result = '';
-    $result = `$command`;
-    print $outhandle "$result\n" if ($verbosity > 3);
-
-    # Read the type, width, and height
-    my $type =   'unknown';
-    my $width =  'unknown';
-    my $height = 'unknown';
-
-    my $image_safe = quotemeta $image;
-    if ($result =~ /^$image_safe (\w+) (\d+)x(\d+)/) {
-	$type = $1;
-	$width = $2;
-	$height = $3;
-    }
-
-    # Read the size
-    my $size = "unknown";
-    if ($result =~ m/^.* ([0-9]+)b/) {
-	$size = $1;
-    }
-    elsif ($result =~ m/^.* ([0-9]+)(\.([0-9]+))?kb?/) {
-	$size = 1024 * $1;
-	if (defined($2)) {
-	    $size = $size + (1024 * $2);
-	    # Truncate size (it isn't going to be very accurate anyway)
-	    $size = int($size);
-	}
-    }
-    elsif ($result =~ m/^.* (([0-9]+)(\.([0-9]+))?e\+([0-9]+))(kb|b)?/) {
-	# Deals with file sizes on Linux of type "3.4e+02kb" where e+02 is 1*10^2.
-	# 3.4e+02 therefore evaluates to 3.4 x 1 x 10^2 = 340kb.
-	# Programming languages including Perl know how that 3.4e+02 is a number,
-	# so we don't need to do any calculations.
-	$size = $1*1; # turn the string into a number by multiplying it by 1
-	       #if we did $size = $1; $size would be merely the string "3.4e+02"
-	$size = int($size); # truncate size
-    }
-    print $outhandle "file: $image:\t $type, $width, $height, $size\n" 
-	if ($verbosity > 2);
-
-    # Return the specs
-    return ($type, $width, $height, $size);
-}
-
-
-sub convert
-{
-    my $self = shift(@_);
-    my $source_file_path = shift(@_);
-    my $target_file_type = shift(@_);
-    my $convert_options = shift(@_) || "";
-    my $convert_type = shift(@_) || "";
-
-    my $outhandle = $self->{'outhandle'};
-    my $verbosity = $self->{'verbosity'};
-
-    # Determine the full name and path of the output file
-    my $target_file_path = &util::get_tmp_filename() . "." . $target_file_type;
-    push(@{$self->{'tmp_file_paths'}}, $target_file_path);
-
-    # Generate and run the convert command
-    my $convert_command = "convert -interlace plane -verbose $convert_options \"$source_file_path\" \"$target_file_path\"";
-    print $outhandle "$convert_type $convert_command\n" if ($verbosity > 2);
-    my $result = `$convert_command 2>&1`;
-    print $outhandle "$convert_type RESULT = $result\n" if ($verbosity > 2);
-
-    return $result;
-}
-
-
-# The ImagePlug read() function. 
-# ImagePlug overrides read() because there is no need to read the actual 
-# text of the file in, because the contents of the file is not text...
-#
-# Return number of files processed, undef if can't process
-# Note that $base_dir might be "" and that $file might 
-# include directories
-
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-
-    #check process and block exps, smart block, etc
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-
-    print STDERR "<Processing n='$file' p='ImagePlug'>\n" if ($gli);
-    print $outhandle "ImagePlug processing $file\n"
-	    if $self->{'verbosity'} > 1;
-
-    # None of this works very well on Windows 95/98...
-    if ($ENV{'GSDLOS'} eq "windows" && !Win32::IsWinNT()) {
-	if ($gli) {
-	    print STDERR "<ProcessingError n='$file' r='Windows 95/98 not supported'>\n";
-	}
-	print $outhandle "ImagePlug: Windows 95/98 not supported\n";
-	return -1;
-    }
-
-    # None of this is going to work very well without ImageMagick...
-    if ($self->{'imagemagick_not_installed'}) {
-	if ($gli) {
-	    print STDERR "<ProcessingError n='$file' r='ImageMagick not installed'>\n";
-	}
-	print $outhandle "ImagePlug: ImageMagick not installed\n";
-	return -1;
-    }
-
-    #if there's a leading directory name, eat it...
-    $file =~ s/^.*[\/\\]//;
-    
-    # create a new document
-    my $doc_obj = new doc ($filename, "indexed_doc");
-    $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});    
-    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
-
-    #run convert to get the thumbnail and extract size and type info
-    my $result = generate_images($self, $filename, $file, $doc_obj);
-    
-    if (!defined $result)
-    {
-	if ($gli) {
-	    print STDERR "<ProcessingError n='$file'>\n";
-	}
-	print $outhandle "ImagePlug: couldn't process \"$filename\"\n";
-	return -1; # error during processing
-    }
-
-     
-    #create an empty text string so we don't break downstream plugins
-    my $text = &gsprintf::lookup_string("{BasPlug.dummy_text}",1);
-   
-    # include any metadata passed in from previous plugins 
-    # note that this metadata is associated with the top level section
-    my $section = $doc_obj->get_top_section();
-    $self->extra_metadata ($doc_obj, $section, $metadata);
-
-    # do plugin specific processing of doc_obj
-    unless (defined ($self->process(\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj))) {
-	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
-	return -1;
-    }
-
-    # do any automatic metadata extraction
-    $self->auto_extract_metadata ($doc_obj);
-
-    # if we haven't found any Title so far, assign one
-    # this was shifted to here from inside read()
-    $self->title_fallback($doc_obj,$section,$file);
-    # add an OID
-    $doc_obj->set_OID();
-    $doc_obj->add_utf8_text($section, $text);
-
-    # process the document
-    $processor->process($doc_obj);
-
-    # clean up temporary files - we do this here instead of in  
-    # generate_images becuase associated files aren't actually copied 
-    # until after process has been run.
-    foreach my $tmp_file_path (@{$self->{'tmp_file_paths'}})
-    {
-	if (-e $tmp_file_path)
-	{
-	    &util::rm($tmp_file_path);
-	}
-    }
-
-    $self->{'num_processed'}++;
-
-    return 1;
-}
-
-# do plugin specific processing of doc_obj
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
-    my $outhandle = $self->{'outhandle'};
-    
-    return 1;
-}
-
-1;
-
-
-
-
-
-
-
-
-
-
-
Index: /gsdl/trunk/perllib/plugins/ImagePlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ImagePlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/ImagePlugin.pm	(revision 15865)
@@ -0,0 +1,501 @@
+###########################################################################
+#
+# ImagePlug.pm -- simple text plugin
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999 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 ImagePlug;
+
+use BasPlug;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @ImagePlug::ISA = ('BasPlug');
+}
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" },
+      { 'name' => "cache_generated_images",
+	'desc' => "{ImagePlug.cache_generated_image}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "noscaleup",
+	'desc' => "{ImagePlug.noscaleup}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "nothumbnail",
+	'desc' => "{ImagePlug.generatethumbnail}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "thumbnailsize",
+	'desc' => "{ImagePlug.thumbnailsize}",
+	'type' => "int",
+	'deft' => "100",
+	'range' => "1,",
+	'reqd' => "no" },
+      { 'name' => "thumbnailtype",
+	'desc' => "{ImagePlug.thumbnailtype}",
+	'type' => "string",
+	'deft' => "gif",
+	'reqd' => "no" },
+      { 'name' => "noscreenview",
+	'desc' => "{ImagePlug.generatescreenview}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "screenviewsize",
+	'desc' => "{ImagePlug.screenviewsize}",
+	'type' => "int",
+	'deft' => "0",
+	'range' => "1,",
+	'reqd' => "no" },
+      { 'name' => "screenviewtype",
+	'desc' => "{ImagePlug.screenviewtype}",
+	'type' => "string",
+	'deft' => "jpg",
+	'reqd' => "no" },
+      { 'name' => "converttotype",
+	'desc' => "{ImagePlug.converttotype}",
+	'type' => "string",
+	'deft' => "",
+	'reqd' => "no" },
+      { 'name' => "minimumsize",
+	'desc' => "{ImagePlug.minimumsize}",
+	'type' => "int",
+	'deft' => "100",
+	'range' => "1,",
+	'reqd' => "no" } ];
+
+my $options = { 'name'     => "ImagePlug",
+		'desc'     => "{ImagePlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+    $self->{'tmp_file_paths'} = ();
+
+    # Check that ImageMagick is installed and available on the path (except for Windows 95/98)
+    if (!($ENV{'GSDLOS'} eq "windows" && !Win32::IsWinNT())) {
+	my $result = `identify 2>&1`;
+	if ($? == -1 || $? == 256) {  # Linux and Windows return different values for "program not found"
+	    $self->{'imagemagick_not_installed'} = 1;
+	}
+    }
+
+       
+    return bless $self, $class;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)(\.jpe?g|\.gif|\.png|\.bmp|\.xbm|\.tif?f)$^; 
+}
+
+# this makes no sense for images
+sub block_cover_image
+{
+    my $self =shift (@_);
+    my ($filename) = @_;
+
+    return;
+}
+# Create the thumbnail and screenview images, and discover the Image's
+# size, width, and height using the convert utility.
+
+sub generate_images
+{
+    my $self = shift (@_);
+    my $filename = shift (@_);   # filename with full path
+    my $file = shift (@_);       # filename without path
+    my $doc_obj = shift (@_);
+    my $section = $doc_obj->get_top_section();
+    
+    my $verbosity = $self->{'verbosity'};
+    my $outhandle = $self->{'outhandle'};
+
+    # check the filename is okay
+    return 0 if ($file eq "" || $filename eq "");
+
+#    Code now extended to quote filenames in 'convert' commnads
+#    Allows spaces in filenames, but note needs spaces to be escaped in URL as well
+#    if ($filename =~ m/ /) {
+#	print $outhandle "ImagePlug: \"$filename\" contains a space. choking.\n";
+#	return undef;
+#    }
+
+    my $minimumsize = $self->{'minimumsize'};
+    if (defined $minimumsize && (-s $filename < $minimumsize)) {
+        print $outhandle "ImagePlug: \"$filename\" too small, skipping\n"
+	    if ($verbosity > 1);
+    }
+
+
+    # Convert the image to a new type (if required).
+    my $converttotype = $self->{'converttotype'};
+    my $originalfilename = "";  # only set if we do a conversion
+    my $type = "unknown";
+
+    if ($converttotype ne "" && $filename !~ m/$converttotype$/) {
+	$originalfilename = $filename;
+
+	my $result = $self->convert($originalfilename, $converttotype, "", "");
+	($filename) = ($result =~ /=>(.*\.$converttotype)/);
+
+	$type = $converttotype;
+	$file =~ s/\..*$/\.$type/;
+    }
+    
+
+    # Add the image metadata
+    my $url = $file;
+    
+    ##not know why it is required at the first place, it seems all works fine without it, so I comment it out 
+    ##$url =~ s/ /%20/g;
+
+    my $utf8_filename_meta = $self->filename_to_metadata($url);
+    $doc_obj->add_utf8_metadata ($section, "Image", $utf8_filename_meta);
+
+    # Also want to set filename as 'Source' metadata to be
+    # consistent with other plugins
+    $doc_obj->add_utf8_metadata ($section, "Source", $utf8_filename_meta);
+
+    my ($image_type, $image_width, $image_height, $image_size) 
+	= &identify($filename, $outhandle, $verbosity);
+
+    if ($image_type ne " ") {
+	$type = $image_type;
+    }
+    
+    $doc_obj->add_metadata ($section, "FileFormat", $type);
+    $doc_obj->add_metadata ($section, "FileSize",   $image_size);
+
+    $doc_obj->add_metadata ($section, "ImageType",   $image_type);
+    $doc_obj->add_metadata ($section, "ImageWidth",  $image_width);
+    $doc_obj->add_metadata ($section, "ImageHeight", $image_height);
+    $doc_obj->add_metadata ($section, "ImageSize",   $image_size);
+    $doc_obj->add_metadata ($section, "NoText",    "1");
+
+    $doc_obj->add_metadata ($section, "srclink", 
+			    "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Image]\">");
+    $doc_obj->add_metadata ($section, "/srclink", "</a>");
+
+    $doc_obj->add_metadata ($section, "srcicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Image]\" width=100>");
+
+    
+    # Add the image as an associated file
+    $doc_obj->associate_file($filename,$file,"image/$type",$section);
+
+
+    if (!$self->{'nothumbnail'}) {
+
+	# Make the thumbnail image
+	my $thumbnailsize = $self->{'thumbnailsize'} || 100;
+	my $thumbnailtype = $self->{'thumbnailtype'} || 'gif';
+
+	# Generate the thumbnail with convert
+	my $result = $self->convert($filename, $thumbnailtype, "-geometry $thumbnailsize" . "x$thumbnailsize", "THUMB");
+	my ($thumbnailfile) = ($result =~ /=>(.*\.$thumbnailtype)/);
+	
+	# Add the thumbnail as an associated file ...
+	if (-e "$thumbnailfile") { 
+	    $doc_obj->associate_file("$thumbnailfile", "thumbnail.$thumbnailtype", 
+				     "image/$thumbnailtype",$section);
+	    $doc_obj->add_metadata ($section, "ThumbType", $thumbnailtype);
+	    $doc_obj->add_metadata ($section, "Thumb", "thumbnail.$thumbnailtype");
+	    
+	    $doc_obj->add_metadata ($section, "thumbicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Thumb]\" width=[ThumbWidth] height=[ThumbHeight]>");
+	}
+
+	# Extract Thumnail metadata from convert output
+	if ($result =~ m/[0-9]+x[0-9]+=>([0-9]+)x([0-9]+)/) {
+	    $doc_obj->add_metadata ($section, "ThumbWidth", $1);
+	    $doc_obj->add_metadata ($section, "ThumbHeight", $2);
+	}
+
+    }
+
+
+    # Make a screen-sized version of the picture if requested
+    if (!$self->{'noscreenview'}) {
+
+	# To do: if the actual image smaller than the screenview size,
+	# we should use the original !
+
+	my $screenviewsize = $self->{'screenviewsize'};
+	my $screenviewtype = $self->{'screenviewtype'} || 'jpeg';
+
+	# make the screenview image
+	my $result = $self->convert($filename, $screenviewtype, "-geometry $screenviewsize" . "x$screenviewsize", "SCREEN");
+	my ($screenviewfilename) = ($result =~ /=>(.*\.$screenviewtype)/);
+
+	# get screenview dimensions, size and type
+        if ($result =~ m/[0-9]+x[0-9]+=>([0-9]+)x([0-9]+)/) {
+	    $doc_obj->add_metadata ($section, "ScreenWidth", $1);
+	    $doc_obj->add_metadata ($section, "ScreenHeight", $2);
+	}
+	else {
+	    $doc_obj->add_metadata ($section, "ScreenWidth", $image_width);
+	    $doc_obj->add_metadata ($section, "ScreenHeight", $image_height);
+	}
+
+	#add the screenview as an associated file ...
+	if (-e "$screenviewfilename") { 
+	    $doc_obj->associate_file("$screenviewfilename", "screenview.$screenviewtype",
+				     "image/$screenviewtype",$section);
+	    $doc_obj->add_metadata ($section, "ScreenType", $screenviewtype);
+	    $doc_obj->add_metadata ($section, "Screen", "screenview.$screenviewtype");
+
+	    $doc_obj->add_metadata ($section, "screenicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Screen]\" width=[ScreenWidth] height=[ScreenHeight]>");
+	} else {
+	    print $outhandle "ImagePlug: couldn't find \"$screenviewfilename\"\n";
+	}
+    }
+
+    return $type;
+
+
+}
+
+
+
+# Discover the characteristics of an image file with the ImageMagick
+# "identify" command.
+
+sub identify { 
+    my ($image, $outhandle, $verbosity) = @_;
+
+    # Use the ImageMagick "identify" command to get the file specs
+    my $command = "identify \"$image\" 2>&1";
+    print $outhandle "$command\n" if ($verbosity > 2);
+    my $result = '';
+    $result = `$command`;
+    print $outhandle "$result\n" if ($verbosity > 3);
+
+    # Read the type, width, and height
+    my $type =   'unknown';
+    my $width =  'unknown';
+    my $height = 'unknown';
+
+    my $image_safe = quotemeta $image;
+    if ($result =~ /^$image_safe (\w+) (\d+)x(\d+)/) {
+	$type = $1;
+	$width = $2;
+	$height = $3;
+    }
+
+    # Read the size
+    my $size = "unknown";
+    if ($result =~ m/^.* ([0-9]+)b/) {
+	$size = $1;
+    }
+    elsif ($result =~ m/^.* ([0-9]+)(\.([0-9]+))?kb?/) {
+	$size = 1024 * $1;
+	if (defined($2)) {
+	    $size = $size + (1024 * $2);
+	    # Truncate size (it isn't going to be very accurate anyway)
+	    $size = int($size);
+	}
+    }
+    elsif ($result =~ m/^.* (([0-9]+)(\.([0-9]+))?e\+([0-9]+))(kb|b)?/) {
+	# Deals with file sizes on Linux of type "3.4e+02kb" where e+02 is 1*10^2.
+	# 3.4e+02 therefore evaluates to 3.4 x 1 x 10^2 = 340kb.
+	# Programming languages including Perl know how that 3.4e+02 is a number,
+	# so we don't need to do any calculations.
+	$size = $1*1; # turn the string into a number by multiplying it by 1
+	       #if we did $size = $1; $size would be merely the string "3.4e+02"
+	$size = int($size); # truncate size
+    }
+    print $outhandle "file: $image:\t $type, $width, $height, $size\n" 
+	if ($verbosity > 2);
+
+    # Return the specs
+    return ($type, $width, $height, $size);
+}
+
+
+sub convert
+{
+    my $self = shift(@_);
+    my $source_file_path = shift(@_);
+    my $target_file_type = shift(@_);
+    my $convert_options = shift(@_) || "";
+    my $convert_type = shift(@_) || "";
+
+    my $outhandle = $self->{'outhandle'};
+    my $verbosity = $self->{'verbosity'};
+
+    # Determine the full name and path of the output file
+    my $target_file_path = &util::get_tmp_filename() . "." . $target_file_type;
+    push(@{$self->{'tmp_file_paths'}}, $target_file_path);
+
+    # Generate and run the convert command
+    my $convert_command = "convert -interlace plane -verbose $convert_options \"$source_file_path\" \"$target_file_path\"";
+    print $outhandle "$convert_type $convert_command\n" if ($verbosity > 2);
+    my $result = `$convert_command 2>&1`;
+    print $outhandle "$convert_type RESULT = $result\n" if ($verbosity > 2);
+
+    return $result;
+}
+
+
+# The ImagePlug read() function. 
+# ImagePlug overrides read() because there is no need to read the actual 
+# text of the file in, because the contents of the file is not text...
+#
+# Return number of files processed, undef if can't process
+# Note that $base_dir might be "" and that $file might 
+# include directories
+
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+
+    #check process and block exps, smart block, etc
+    my ($block_status,$filename) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+
+    print STDERR "<Processing n='$file' p='ImagePlug'>\n" if ($gli);
+    print $outhandle "ImagePlug processing $file\n"
+	    if $self->{'verbosity'} > 1;
+
+    # None of this works very well on Windows 95/98...
+    if ($ENV{'GSDLOS'} eq "windows" && !Win32::IsWinNT()) {
+	if ($gli) {
+	    print STDERR "<ProcessingError n='$file' r='Windows 95/98 not supported'>\n";
+	}
+	print $outhandle "ImagePlug: Windows 95/98 not supported\n";
+	return -1;
+    }
+
+    # None of this is going to work very well without ImageMagick...
+    if ($self->{'imagemagick_not_installed'}) {
+	if ($gli) {
+	    print STDERR "<ProcessingError n='$file' r='ImageMagick not installed'>\n";
+	}
+	print $outhandle "ImagePlug: ImageMagick not installed\n";
+	return -1;
+    }
+
+    #if there's a leading directory name, eat it...
+    $file =~ s/^.*[\/\\]//;
+    
+    # create a new document
+    my $doc_obj = new doc ($filename, "indexed_doc");
+    $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});    
+    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
+
+    #run convert to get the thumbnail and extract size and type info
+    my $result = generate_images($self, $filename, $file, $doc_obj);
+    
+    if (!defined $result)
+    {
+	if ($gli) {
+	    print STDERR "<ProcessingError n='$file'>\n";
+	}
+	print $outhandle "ImagePlug: couldn't process \"$filename\"\n";
+	return -1; # error during processing
+    }
+
+     
+    #create an empty text string so we don't break downstream plugins
+    my $text = &gsprintf::lookup_string("{BasPlug.dummy_text}",1);
+   
+    # include any metadata passed in from previous plugins 
+    # note that this metadata is associated with the top level section
+    my $section = $doc_obj->get_top_section();
+    $self->extra_metadata ($doc_obj, $section, $metadata);
+
+    # do plugin specific processing of doc_obj
+    unless (defined ($self->process(\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj))) {
+	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
+	return -1;
+    }
+
+    # do any automatic metadata extraction
+    $self->auto_extract_metadata ($doc_obj);
+
+    # if we haven't found any Title so far, assign one
+    # this was shifted to here from inside read()
+    $self->title_fallback($doc_obj,$section,$file);
+    # add an OID
+    $doc_obj->set_OID();
+    $doc_obj->add_utf8_text($section, $text);
+
+    # process the document
+    $processor->process($doc_obj);
+
+    # clean up temporary files - we do this here instead of in  
+    # generate_images becuase associated files aren't actually copied 
+    # until after process has been run.
+    foreach my $tmp_file_path (@{$self->{'tmp_file_paths'}})
+    {
+	if (-e $tmp_file_path)
+	{
+	    &util::rm($tmp_file_path);
+	}
+    }
+
+    $self->{'num_processed'}++;
+
+    return 1;
+}
+
+# do plugin specific processing of doc_obj
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
+    my $outhandle = $self->{'outhandle'};
+    
+    return 1;
+}
+
+1;
+
+
+
+
+
+
+
+
+
+
+
Index: dl/trunk/perllib/plugins/IndexPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/IndexPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,160 +1,0 @@
-###########################################################################
-#
-# IndexPlug.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) 1999 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.
-#
-###########################################################################
-
-# This recursive plugin processes an index.txt file. 
-# The index.txt file should contain the list of files to be
-# included in the collection followed by any extra metadata to
-# be associated with each file.
-
-# The index.txt file should be formatted as follows:
-# The first line may be a key (beginning with key:)
-# to name the metadata fields
-# (e.g. key: Subject Organization Date) 
-# The following lines will contain a filename followed 
-# by the value that metadata entry is to be set to.
-# (e.g. 'irma/iw097e 3.2 unesco 1993' will associate the
-# metadata Subject=3.2, Organization=unesco, and Date=1993
-# with the file irma/iw097e if the above key line was used)
-
-# Note that if any of the metadata fields use the Hierarchy
-# classifier plugin then the value they're set to should
-# correspond to the first field (the descriptor) in the
-# appropriate classification file.
-
-# Metadata values may be named separately using a tag 
-# (e.g. <Subject>3.2) and this will override any name 
-# given to them by the key line.
-# If there's no key line any unnamed metadata value will be
-# named 'Subject'.
-
-# 12/05/02 Added usage datastructure - John Thompson
-
-package IndexPlug;
-
-use plugin;
-use BasPlug;
-use doc;
-use util;
-use cfgread;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @IndexPlug::ISA = ('BasPlug');
-}
-
-my $arguments = [
-		 ];
-
-my $options = { 'name'     => "IndexPlug",
-		'desc'     => "{IndexPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes" };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-# return 1 if this class might recurse using $pluginfo
-sub is_recursive {
-    my $self = shift (@_);
-    
-    return 1;
-}
-
-# return number of files processed, undef if can't process
-# Note that $base_dir might be "" and that $file might 
-# include directories
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    my $indexfile = &util::filename_cat($base_dir, $file, "index.txt");
-    if (!-f $indexfile) {
-	# not a directory containing an index file
-	return undef;
-    }
-
-    # found an index.txt file
-    print STDERR "<Processing n='$file' p='IndexPlug'>\n" if ($gli);
-    print $outhandle "IndexPlug: processing $indexfile\n";
-
-    # read in the index.txt
-    my $list = &cfgread::read_cfg_file ($indexfile, undef, '^[^#]\w');
-    my @fields = ();
-    # see if there's a 'key:' line
-    if (defined $list->{'key:'}) {
-	@fields = @{$list->{'key:'}};
-    }
-
-    my $index_base_dir = &util::filename_cat($base_dir, $file);
-
-    # process each document
-    my $count = 0;
-    foreach my $docfile (keys (%$list)) {
-	last if ($maxdocs != -1 && ($total_count + $count) >= $maxdocs);
-	$metadata = {}; # at present we can do this as metadata
-	                # will always be empty when it arrives
-	                # at this plugin - this might cause 
-	                # problems if things change though
-
-	# note that $list->{$docfile} is an array reference
-	if ($docfile !~ /key:/i) {
-	    my $i = 0;
-	    for ($i = 0; $i < scalar (@{$list->{$docfile}}); $i ++) {
-		if ($list->{$docfile}->[$i] =~ /^<([^>]+)>(.+)$/) {
-		    unless (defined ($metadata->{$1})) {
-			$metadata->{$1} = [];
-		    } 
-		    push (@{$metadata->{$1}}, $2);
-		} elsif (scalar @fields >= $i) {
-		    unless (defined ($metadata->{$fields[$i]})) {
-			$metadata->{$fields[$i]} = [];
-		    } 
-		    push (@{$metadata->{$fields[$i]}}, $list->{$docfile}->[$i]);
-		} else {
-		    $metadata->{'Subject'} = $list->{$docfile};
-		}
-	    }
-	    $count += &plugin::read ($pluginfo, $index_base_dir, $docfile, $metadata, $processor, $maxdocs, ($total_count +$count), $gli);
-	}
-    }
-
-    return $count; # was processed
-}
-
-
-1;
Index: /gsdl/trunk/perllib/plugins/IndexPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/IndexPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/IndexPlugin.pm	(revision 15865)
@@ -0,0 +1,160 @@
+###########################################################################
+#
+# IndexPlug.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) 1999 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.
+#
+###########################################################################
+
+# This recursive plugin processes an index.txt file. 
+# The index.txt file should contain the list of files to be
+# included in the collection followed by any extra metadata to
+# be associated with each file.
+
+# The index.txt file should be formatted as follows:
+# The first line may be a key (beginning with key:)
+# to name the metadata fields
+# (e.g. key: Subject Organization Date) 
+# The following lines will contain a filename followed 
+# by the value that metadata entry is to be set to.
+# (e.g. 'irma/iw097e 3.2 unesco 1993' will associate the
+# metadata Subject=3.2, Organization=unesco, and Date=1993
+# with the file irma/iw097e if the above key line was used)
+
+# Note that if any of the metadata fields use the Hierarchy
+# classifier plugin then the value they're set to should
+# correspond to the first field (the descriptor) in the
+# appropriate classification file.
+
+# Metadata values may be named separately using a tag 
+# (e.g. <Subject>3.2) and this will override any name 
+# given to them by the key line.
+# If there's no key line any unnamed metadata value will be
+# named 'Subject'.
+
+# 12/05/02 Added usage datastructure - John Thompson
+
+package IndexPlug;
+
+use plugin;
+use BasPlug;
+use doc;
+use util;
+use cfgread;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @IndexPlug::ISA = ('BasPlug');
+}
+
+my $arguments = [
+		 ];
+
+my $options = { 'name'     => "IndexPlug",
+		'desc'     => "{IndexPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes" };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+# return 1 if this class might recurse using $pluginfo
+sub is_recursive {
+    my $self = shift (@_);
+    
+    return 1;
+}
+
+# return number of files processed, undef if can't process
+# Note that $base_dir might be "" and that $file might 
+# include directories
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    my $indexfile = &util::filename_cat($base_dir, $file, "index.txt");
+    if (!-f $indexfile) {
+	# not a directory containing an index file
+	return undef;
+    }
+
+    # found an index.txt file
+    print STDERR "<Processing n='$file' p='IndexPlug'>\n" if ($gli);
+    print $outhandle "IndexPlug: processing $indexfile\n";
+
+    # read in the index.txt
+    my $list = &cfgread::read_cfg_file ($indexfile, undef, '^[^#]\w');
+    my @fields = ();
+    # see if there's a 'key:' line
+    if (defined $list->{'key:'}) {
+	@fields = @{$list->{'key:'}};
+    }
+
+    my $index_base_dir = &util::filename_cat($base_dir, $file);
+
+    # process each document
+    my $count = 0;
+    foreach my $docfile (keys (%$list)) {
+	last if ($maxdocs != -1 && ($total_count + $count) >= $maxdocs);
+	$metadata = {}; # at present we can do this as metadata
+	                # will always be empty when it arrives
+	                # at this plugin - this might cause 
+	                # problems if things change though
+
+	# note that $list->{$docfile} is an array reference
+	if ($docfile !~ /key:/i) {
+	    my $i = 0;
+	    for ($i = 0; $i < scalar (@{$list->{$docfile}}); $i ++) {
+		if ($list->{$docfile}->[$i] =~ /^<([^>]+)>(.+)$/) {
+		    unless (defined ($metadata->{$1})) {
+			$metadata->{$1} = [];
+		    } 
+		    push (@{$metadata->{$1}}, $2);
+		} elsif (scalar @fields >= $i) {
+		    unless (defined ($metadata->{$fields[$i]})) {
+			$metadata->{$fields[$i]} = [];
+		    } 
+		    push (@{$metadata->{$fields[$i]}}, $list->{$docfile}->[$i]);
+		} else {
+		    $metadata->{'Subject'} = $list->{$docfile};
+		}
+	    }
+	    $count += &plugin::read ($pluginfo, $index_base_dir, $docfile, $metadata, $processor, $maxdocs, ($total_count +$count), $gli);
+	}
+    }
+
+    return $count; # was processed
+}
+
+
+1;
Index: dl/trunk/perllib/plugins/LOMPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/LOMPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,706 +1,0 @@
-###########################################################################
-#
-# LOMPlug.pm -- plugin for import the collection from LOM
-# 
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 2005 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.
-#
-###########################################################################
-
-### Note this plugin currently can't download source documents from outside if you are behind a firewall.
-
-package LOMPlug;
-
-use BasPlug;
-use MetadataPass;
-use XMLParser;
-use Cwd;
-
-sub BEGIN {
-    @ISA = ('BasPlug', 'MetadataPass');
-}
-
-use strict; # every perl program should have this!
-no strict 'refs'; # make an exception so we can use variables as filehandles
-
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "string",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" },
-      { 'name' => "root_tag",
-	'desc' => "{LOMPlug.root_tag}",
-	'type' => "regexp",
-	'deft' => q/^(?i)lom$/,
-	'reqd' => "no" },
-      { 'name' => "check_timestamp",
-	'desc' => "{LOMPlug.check_timestamp}",
-	'type' => "flag" },
-      { 'name' => "download_srcdocs",
-	'desc' => "{LOMPlug.download_srcdocs}",
-	'type' => "regexp",
-	'deft' => "",
-	'reqd' => "no" }];
-
-my $options = { 'name'     => "LOMPlug",
-		'desc'     => "{LOMPlug.desc}",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-
-
-my ($self);
-sub new {
-    my $class = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-    
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-   
-    $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    #create XML::Parser object for parsing dublin_core.xml files
-    my $parser = new XML::Parser('Style' => 'Stream',
-				 'Handlers' => {'Char' => \&Char,
-						'Doctype' => \&Doctype
-						});
-    $self->{'parser'} = $parser;
-
-    $self->{'extra_blocks'} = {};
-
-    return bless $self, $class;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)\.xml$^;
-}
-
-
-
-
-sub metadata_read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-
-    my $filename = $file;
-    $filename = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
-    
-    if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
-	return undef; # can't recognise
-    }
-    if (!$self->check_doctype($filename)) {
-	# this file is not for us
-	return undef;
-    }
-
-    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
-    
-    print $outhandle "LOMPlug: extracting metadata from $file\n"
-	if $self->{'verbosity'} > 1;
-
-    my ($dir,$tail) = $filename =~ /^(.*?)([^\/\\]*)$/;
-    $self->{'output_dir'} = $dir;
-
-    eval {
-	$self->{'parser'}->parsefile($filename);
-    };
-    
-    if ($@) {
-	print $outhandle "LOMPlug: skipping $filename as not conformant to LOM syntax\n" if ($self->{'verbosity'} > 1);
-	print $outhandle "\n Perl Error:\n $@\n" if ($self->{'verbosity'}>2);
-	return 0;
-    }
-
-    $self->{'output_dir'} = undef;
-
-    my $file_re;
-    my $lom_srcdoc = $self->{'lom_srcdoc'};
-
-    if (defined $lom_srcdoc) {
-	my $dirsep = &util::get_re_dirsep();
-	$lom_srcdoc =~ s/^$base_dir($dirsep)//;
-	$self->{'extra_blocks'}->{$file}++;
-
-	$file_re = $lom_srcdoc;
-    }
-    else {
-	$file_re = $tail;
-    }
-    $file_re =~ s/\./\\\./g;
-
-    $self->{'lom_srcdoc'} = undef; # reset for next file to be processed
-
-    push(@$extrametakeys,$file_re);
-    $extrametadata->{$file_re} = $self->{'saved_metadata'};
-
-    return 1;
-}
-
-sub check_doctype {
-    $self = shift (@_);
-    
-    my ($filename) = @_;
-    
-    if (open(XMLIN,"<$filename")) {
-	my $doctype = $self->{'root_tag'};
-	## check whether the doctype has the same name as the root element tag
-	while (defined (my $line = <XMLIN>)) {
-	    ## find the root element
-	    if ($line =~ /<([\w\d:]+)[\s>]/){
-		my $root = $1;
-		if ($root !~ $doctype){
-		    close(XMLIN);
-		    return 0;
-		}
-		else {
-		    close(XMLIN); 
-		    return 1;
-		}
-	    }
-	}
-	close(XMLIN);
-    }
-    
-    return undef; # haven't found a valid line
-    
-}
-
-sub read_file {
-    my $self = shift (@_);
-    my ($filename, $encoding, $language, $textref) = @_;
-
-    my $metadata_table = $self->{'metadata_table'};
-
-    my $rawtext = $metadata_table->{'rawtext'};
-
-    delete $metadata_table->{'rawtext'};
-
-    $$textref = $rawtext;
-}
-
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-
-    return 0 if (defined $self->{'extra_blocks'}->{$file});
-
-    # need to check whether this file is for us
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-    if (!$self->check_doctype($filename)) {
-	# this file is not for us
-	return undef;
-    }
-
-    $self->{'metadata_table'} = $metadata;
-
-    my $lom_language = $metadata->{'lom_language'};
-
-    my $store_input_encoding;
-    my $store_extract_language;
-    my $store_default_language;
-    my $store_default_encoding;
-
-    if (defined $lom_language) {
-	delete $metadata->{'lom_language'};
-
-	$store_input_encoding   = $self->{'input_encoding'};
-	$store_extract_language = $self->{'extract_language'};
-	$store_default_language = $self->{'default_language'};
-	$store_default_encoding = $self->{'default_encoding'};
-
-	$self->{'input_encoding'}   = "utf8";
-	$self->{'extract_language'} = 0;
-	$self->{'default_language'} = $lom_language;
-	$self->{'default_encoding'} = "utf8";
-    }
-
-    my $rv = $self->SUPER::read(@_);
-
-    if (defined $lom_language) {	
-	$self->{'input_encoding'}   = $store_input_encoding;
-	$self->{'extract_language'} = $store_extract_language;
-	$self->{'default_language'} = $store_default_language;
-	$self->{'default_encoding'} = $store_default_encoding;
-    }
-
-    $self->{'metadata_table'} = undef;
-
-    return $rv;
-}
-
-# do plugin specific processing of doc_obj
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    print STDERR "<Processing n='$file' p='LOMPlug'>\n" if ($gli);
-
-    print $outhandle "LOMPLug: processing $file\n";
-
-    my $cursection = $doc_obj->get_top_section();
-    $doc_obj->add_utf8_text($cursection, $$textref);
-
-    return 1;
-}
-
-sub Doctype {
-    my ($expat, $name, $sysid, $pubid, $internal) = @_;
-
-    my $root_tag = $self->{'root_tag'};
-
-    if ($name !~ /$root_tag/) {	
-	die "Root tag $name does not match regular expression $root_tag";
-    }
-}
-
-sub StartTag {
-    my ($expat, $element) = @_;
-
-    my %attr = %_;
-    
-    my $raw_tag = "&lt;$element";
-    map { $raw_tag .= " $_=\"$attr{$_}\""; } keys %attr;
-    $raw_tag .= "&gt;";
-
-    if ($element =~ m/$self->{'root_tag'}/) {
-	$self->{'raw_text'} = $raw_tag;
-
-	$self->{'saved_metadata'} = {};
-	$self->{'metaname_stack'} = [];
-	$self->{'lom_datatype'} = "";
-	$self->{'lom_language'} = undef;
-	$self->{'metadatatext'} = "<table class=\"metadata\" width=\"_pagewidth_\" >\n";
-    }
-    else {
-	my $xml_depth = scalar(@{$self->{'metaname_stack'}});
-	$self->{'raw_text'} .= "\n"; 
-	$self->{'raw_text'} .= "&nbsp;&nbsp;" x $xml_depth; 
-	$self->{'raw_text'} .= $raw_tag;
-
-	my $metaname_stack = $self->{'metaname_stack'};
-	push(@$metaname_stack,$element);
-	if (scalar(@$metaname_stack)==1) {
-	    # top level LOM category
-	    my $style = "class=\"metadata\"";
-	    my $open_close
-		= "<a id=\"${element}opencloselink\" href=\"javascript:hideTBodyArea('$element')\">\n";
-	    $open_close
-		.= "<img id=\"${element}openclose\" border=\"0\" src=\"_httpopenmdicon_\"></a>\n";
-
-	    my $header_line = "  <tr $style ><th $style colspan=\"3\">$open_close \u$element</th></tr>\n";
-	    my $md_tbody = "<tbody id=\"$element\">\n";
-
-	    $self->{'mdheader'}     = $header_line;
-	    $self->{'mdtbody'}      = $md_tbody;
-	    $self->{'mdtbody_text'} = "";
-	}
-    }
-}
-
-sub EndTag {
-    my ($expat, $element) = @_;
-
-    my $raw_tag = "&lt;/$element&gt;";
-    
-    if ($element =~ m/$self->{'root_tag'}/) {
-	$self->{'raw_text'} .= $raw_tag;
-
-	my $metadatatext = $self->{'metadatatext'};
-	$metadatatext .= "</table>";
-
-	my $raw_text = $self->{'raw_text'};
-
-	$self->{'saved_metadata'}->{'MetadataTable'} =  $metadatatext;
-	$self->{'metadatatext'} = "";
-
-	$self->{'saved_metadata'}->{'rawtext'} =  $raw_text;
-	$self->{'raw_text'} = "";
-
-	if (defined $self->{'lom_language'}) {
-	    $self->{'saved_metadata'}->{'lom_language'} = $self->{'lom_language'};
-	    $self->{'lom_language'} = undef;
-	}
-    }
-    else {
-	my $metaname_stack = $self->{'metaname_stack'};
-
-	if (scalar(@$metaname_stack)==1) {
-	    my $header_line = $self->{'mdheader'};
-	    my $tbody_start = $self->{'mdtbody'};
-	    my $tbody_text  = $self->{'mdtbody_text'};
-	    if ($tbody_text !~ m/^\s*$/s) {
-		my $tbody_end = "</tbody>\n";
-		my $table_chunk 
-		    = $header_line.$tbody_start.$tbody_text.$tbody_end;
-
-		$self->{'metadatatext'} .= $table_chunk;
-	    }
-	    $self->{'mdtheader'}    = "";
-	    $self->{'mdtbody'}      = "";
-	    $self->{'mdtbody_text'} = "";
-	}
-
-	pop(@$metaname_stack);
-
-	my $xml_depth = scalar(@{$self->{'metaname_stack'}});
-	$self->{'raw_text'} .= "\n"; 
-	$self->{'raw_text'} .= "&nbsp;&nbsp;" x $xml_depth; 
-	$self->{'raw_text'} .= $raw_tag;
-    }
-}
-
-sub process_datatype_info
-{
-    my $self = shift(@_);
-    my ($metaname_stack,$md_content) = @_;
-
-    my @without_dt_stack = @$metaname_stack; # without datatype stack
-
-    my $innermost_element = $without_dt_stack[$#without_dt_stack];
-
-    # Loose last item if encoding datatype information
-    if ($innermost_element =~ m/^(lang)?string$/) {
-	$self->{'lom_datatype'} = $innermost_element;
-
-	pop @without_dt_stack;
-	$innermost_element = $without_dt_stack[$#without_dt_stack];
-    }
-    elsif ($innermost_element =~ m/^date(Time)?$/i) { 
-	if ($innermost_element =~ m/^date$/i) {
-	    $self->{'lom_datatype'} = "dateTime";
-	}
-	else {
-	    $self->{'lom_datatype'} = $innermost_element;
-
-	    pop @without_dt_stack;
-	    $innermost_element = $without_dt_stack[$#without_dt_stack];
-	}
-
-	if ($md_content =~ m/^(\d{1,2})\s*(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\w*\s*(\d{4})/i) {
-	    my ($day,$mon,$year) = ($1,$2,$3);
-	    
-	    my %month_lookup = ( 'jan' =>  1, 'feb' =>  2, 'mar' =>  3,
-				 'apr' =>  4, 'may' =>  5, 'jun' =>  6,
-				 'jul' =>  7, 'aug' =>  8, 'sep' =>  9,
-				 'oct' => 10, 'nov' => 11, 'dec' => 12 );
-
-	    my $mon_num = $month_lookup{lc($mon)};
-
-	    $md_content = sprintf("%d%02d%02d",$year,$mon_num,$day);
-	}
-
-	$md_content =~ s/\-//g;
-    }
-
-    if ($innermost_element eq "source") {
-	$self->{'lom_source'} = $md_content;
-    }
-    elsif ($innermost_element eq "value") {
-	$self->{'lom_value'} = $md_content;
-    }
-
-    return (\@without_dt_stack,$innermost_element,$md_content);
-}
-
-sub reset_datatype_info
-{
-    my $self = shift(@_);
-
-    $self->{'lom_datatype'} = "";
-}
-
-
-sub pretty_print_text
-{
-    my $self = shift(@_);
-    
-    my ($pretty_print_text) = @_;
-
-##    $metavalue_utf8 = &util::hyperlink_text($metavalue_utf8);
-    $pretty_print_text = &util::hyperlink_text($pretty_print_text);
-	
-####    $pretty_print_text =~ s/(BEGIN:vCard.*END:vCard)/<pre>$1<\/pre>/sg;
-
-    if ($self->{'lom_datatype'} eq "dateTime") {
-	if ($pretty_print_text =~ m/^(\d{4})(\d{2})(\d{2})$/) {
-	    $pretty_print_text = "$1-$2-$3";
-	}
-    }
-
-    return $pretty_print_text;
-}
-
-sub pretty_print_table_tr
-{
-    my $self = shift (@_);
-    my ($without_dt_stack) = @_;
-
-    my $style = "class=\"metadata\"";
-
-    my $innermost_element = $without_dt_stack->[scalar(@$without_dt_stack)-1];
-    my $outermost_element = $without_dt_stack->[0];
-
-    # Loose top level stack item (already named in pretty print table)
-    my @pretty_print_stack = @$without_dt_stack;
-    shift @pretty_print_stack; 
-
-    if ($innermost_element eq "source") {
-	return if (!defined $self->{'lom_value'});
-    }
-
-    if ($innermost_element eq "value") {
-	return if (!defined $self->{'lom_source'});
-    }
-
-    my $pretty_print_text = "";
-
-    if (($innermost_element eq "value") || ($innermost_element eq "source")) {
-	my $source = $self->{'lom_source'};
-	my $value  = $self->pretty_print_text($self->{'lom_value'});
-
-	$self->{'lom_source'} = undef;
-	$self->{'lom_value'} = undef;
-
-	pop @pretty_print_stack;
-	
-	$pretty_print_text = "<td $style>$source</td><td $style>$value</td>";
-    }
-    else {
-	$pretty_print_text = $self->pretty_print_text($_);
-	$pretty_print_text = "<td $style colspan=2>$pretty_print_text</td>";
-    }
-    my $pretty_print_fmn = join(' : ',map { "\u$_"; } @pretty_print_stack);
-
-
-    # my $tr_attr = "id=\"$outermost_element\" style=\"display:block;\"";
-    my $tr_attr = "$style id=\"$outermost_element\"";
-
-    my $mdtext_line = "  <tr $tr_attr><td $style><nobr>$pretty_print_fmn</nobr></td>$pretty_print_text</tr>\n";
-    $self->{'mdtbody_text'} .= $mdtext_line;
-}
-
-
-sub check_for_language
-{
-    my $self = shift(@_);
-    my ($innermost_element,$md_content) = @_;
-
-    # Look for 'language' tag
-    if ($innermost_element eq "language") {
-	my $lom_lang = $self->{'lom_language'};
-	
-	if (defined $lom_lang) {
-	    my $new_lom_lang = $md_content;
-	    $new_lom_lang =~ s/-.*//; # remove endings like -US or -GB
-
-	    if ($lom_lang ne $new_lom_lang) {
-		my $outhandle = $self->{'outhandle'};
-		
-		print $outhandle "Warning: Conflicting general language in record\n";
-		print $outhandle "         $new_lom_lang (previous value for language = $lom_lang)\n";
-	    }
-	    # otherwise, existing value OK => do nothing
-	}
-	else {
-	    $lom_lang = $md_content;
-	    $lom_lang =~ s/-.*//; # remove endings like -US or -GB
-	    
-	    $self->{'lom_language'} = $lom_lang;
-	}
-    }
-}
-
-sub found_specific_identifier
-{
-    my $self = shift(@_);
-    my ($specific_id,$full_mname,$md_content) = @_;
-
-    my $found_id = 0;
-    if ($full_mname eq $specific_id) {
-	if ($md_content =~ m/^(http|ftp):/) {
-	    $found_id = 1;
-	}
-    }
-
-    return $found_id;
-}
-
-sub download_srcdoc
-{
-    my $self = shift(@_);
-    my ($doc_url) = @_;
-
-    my $outhandle  = $self->{'outhandle'};
-    my $output_dir = $self->{'output_dir'};
-
-    $output_dir = &util::filename_cat($output_dir,"_gsdldown.all");
-
-    if (! -d $output_dir) {
-	mkdir $output_dir;
-    }
-
-    my $re_dirsep = &util::get_re_dirsep();
-    my $os_dirsep = &util::get_dirsep();
-
-    my $file_url = $doc_url;
-    $file_url =~ s/$re_dirsep/$os_dirsep/g;
-    $file_url =~ s/^(http|ftp):\/\///;
-    $file_url .= "index.html" if ($file_url =~ m/\/$/);
-
-    my $full_file_url = &util::filename_cat($output_dir,$file_url);
-
-    my $check_timestamp = $self->{'check_timestamp'};
-    my $status;
-
-    if (($check_timestamp) || (!$check_timestamp && !-e $full_file_url)) {
-	if (!-e $full_file_url) {
-	    print $outhandle "Mirroring $doc_url\n";
-	}
-	else {
-	    print $outhandle "Checking to see if update needed for $doc_url\n";
-	}
-
-	# on linux, if we pass an absolute path as -P arg to wget, then it 
-	# stuffs up the 
-	# URL rewriting in the file. Need a relative path or none, so now
-	# we change working directory first.
-	my $changed_dir = 0;
-	my $current_dir = cwd();
-	my $wget_cmd = "";
-	if ($ENV{'GSDLOS'} ne "windows") {
-	    $changed_dir = 1;
-	    
-	    chdir "$output_dir";
-	    $wget_cmd = "wget -nv  --timestamping -k -p \"$doc_url\"";
-	} else {
-	    $wget_cmd = "wget -nv -P \"$output_dir\" --timestamping -k -p \"$doc_url\""; 
-	}
-	#my $wget_cmd = "wget -nv -P$output_dir --timestamping -k -p \"$doc_url\""; 
-	### my $full_dir_url = &File::Basename::dirname($full_file_url);
-
-	## my $wget_cmd = "wget -O $full_file_url --timestamping -k \"$doc_url\"";
-	#my $wget_cmd = "wget -nv -P$output_dir --timestamping -x -k \"$doc_url\"";
-	print STDERR "**** wget = $wget_cmd\n";
-
-	
-	$status = system($wget_cmd);
-	if ($changed_dir) {
-	    chdir $current_dir;
-	}
-	if ($status==0) {
-	    $self->{'lom_srcdoc'} = $full_file_url;	
-	}
-	else {
-	    $self->{'lom_srcdoc'} = undef;
-	    print $outhandle "Error: failed to execute $wget_cmd\n";
-	}
-    }
-    else {
-	# not time-stamping and file already exists
-	$status=0;
-	$self->{'lom_srcdoc'} = $full_file_url;	
-    }
-
-    return $status==0;
-    
-}
-
-
-sub check_for_identifier
-{
-    my $self = shift(@_);
-    my ($full_mname,$md_content) = @_;
-
-    my $success = 0;
-
-    my $download_re = $self->{'download_srcdocs'};
-    if (($download_re ne "") && $md_content =~ m/$download_re/) {
-	
-	if ($self->found_specific_identifier("general^identifier^entry",$full_mname,$md_content)) {
-	    $success = $self->download_srcdoc($md_content);
-	}
-
-	if (!$success) {
-	    if ($self->found_specific_identifier("technical^location",$full_mname,$md_content)) {
-		$success = $self->download_srcdoc($md_content);
-	    }
-	}
-    }
-
-    return $success;
-}
-
-
-sub Text {
-    if ($_ !~ m/^\s*$/) {
-	#
-	# Work out indentations and line wraps for raw XML
-	#
-	my $xml_depth = scalar(@{$self->{'metaname_stack'}})+1;
-	my $indent = "&nbsp;&nbsp;" x $xml_depth; 
-	
-	my $formatted_text = "\n".$_;
-
-	# break into lines < 80 chars on space
-	$formatted_text =~ s/(.{50,80})\s+/$1\n/mg; 
-	$formatted_text =~ s/^/$indent/mg;
-	## $formatted_text =~ s/\s+$//s;
-
-	$self->{'raw_text'} .= $formatted_text;
-    }
-
-    my $metaname_stack = $self->{'metaname_stack'};
-    if (($_ !~ /^\s*$/) && (scalar(@$metaname_stack)>0)) {
-
-	my ($without_dt_stack,$innermost_element,$md_content)
-	    = $self->process_datatype_info($metaname_stack,$_);
-
-	$self->pretty_print_table_tr($without_dt_stack);
-
-	my $full_mname = join('^',@{$without_dt_stack});
-	$self->set_filere_metadata(lc($full_mname),$md_content);
-
-	$self->check_for_language($innermost_element,$md_content);
-	$self->check_for_identifier($full_mname,$md_content); # source doc
-
-	$self->reset_datatype_info();
-    }
-}
-
-# This Char function overrides the one in XML::Parser::Stream to overcome a
-# problem where $expat->{Text} is treated as the return value, slowing
-# things down significantly in some cases.
-sub Char {
-  $_[0]->{'Text'} .= $_[1];
-  return undef;
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/LOMPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/LOMPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/LOMPlugin.pm	(revision 15865)
@@ -0,0 +1,706 @@
+###########################################################################
+#
+# LOMPlug.pm -- plugin for import the collection from LOM
+# 
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 2005 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.
+#
+###########################################################################
+
+### Note this plugin currently can't download source documents from outside if you are behind a firewall.
+
+package LOMPlug;
+
+use BasPlug;
+use MetadataPass;
+use XMLParser;
+use Cwd;
+
+sub BEGIN {
+    @ISA = ('BasPlug', 'MetadataPass');
+}
+
+use strict; # every perl program should have this!
+no strict 'refs'; # make an exception so we can use variables as filehandles
+
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "string",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" },
+      { 'name' => "root_tag",
+	'desc' => "{LOMPlug.root_tag}",
+	'type' => "regexp",
+	'deft' => q/^(?i)lom$/,
+	'reqd' => "no" },
+      { 'name' => "check_timestamp",
+	'desc' => "{LOMPlug.check_timestamp}",
+	'type' => "flag" },
+      { 'name' => "download_srcdocs",
+	'desc' => "{LOMPlug.download_srcdocs}",
+	'type' => "regexp",
+	'deft' => "",
+	'reqd' => "no" }];
+
+my $options = { 'name'     => "LOMPlug",
+		'desc'     => "{LOMPlug.desc}",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+
+
+my ($self);
+sub new {
+    my $class = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+    
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+   
+    $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    #create XML::Parser object for parsing dublin_core.xml files
+    my $parser = new XML::Parser('Style' => 'Stream',
+				 'Handlers' => {'Char' => \&Char,
+						'Doctype' => \&Doctype
+						});
+    $self->{'parser'} = $parser;
+
+    $self->{'extra_blocks'} = {};
+
+    return bless $self, $class;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)\.xml$^;
+}
+
+
+
+
+sub metadata_read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+
+    my $filename = $file;
+    $filename = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
+    
+    if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
+	return undef; # can't recognise
+    }
+    if (!$self->check_doctype($filename)) {
+	# this file is not for us
+	return undef;
+    }
+
+    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
+    
+    print $outhandle "LOMPlug: extracting metadata from $file\n"
+	if $self->{'verbosity'} > 1;
+
+    my ($dir,$tail) = $filename =~ /^(.*?)([^\/\\]*)$/;
+    $self->{'output_dir'} = $dir;
+
+    eval {
+	$self->{'parser'}->parsefile($filename);
+    };
+    
+    if ($@) {
+	print $outhandle "LOMPlug: skipping $filename as not conformant to LOM syntax\n" if ($self->{'verbosity'} > 1);
+	print $outhandle "\n Perl Error:\n $@\n" if ($self->{'verbosity'}>2);
+	return 0;
+    }
+
+    $self->{'output_dir'} = undef;
+
+    my $file_re;
+    my $lom_srcdoc = $self->{'lom_srcdoc'};
+
+    if (defined $lom_srcdoc) {
+	my $dirsep = &util::get_re_dirsep();
+	$lom_srcdoc =~ s/^$base_dir($dirsep)//;
+	$self->{'extra_blocks'}->{$file}++;
+
+	$file_re = $lom_srcdoc;
+    }
+    else {
+	$file_re = $tail;
+    }
+    $file_re =~ s/\./\\\./g;
+
+    $self->{'lom_srcdoc'} = undef; # reset for next file to be processed
+
+    push(@$extrametakeys,$file_re);
+    $extrametadata->{$file_re} = $self->{'saved_metadata'};
+
+    return 1;
+}
+
+sub check_doctype {
+    $self = shift (@_);
+    
+    my ($filename) = @_;
+    
+    if (open(XMLIN,"<$filename")) {
+	my $doctype = $self->{'root_tag'};
+	## check whether the doctype has the same name as the root element tag
+	while (defined (my $line = <XMLIN>)) {
+	    ## find the root element
+	    if ($line =~ /<([\w\d:]+)[\s>]/){
+		my $root = $1;
+		if ($root !~ $doctype){
+		    close(XMLIN);
+		    return 0;
+		}
+		else {
+		    close(XMLIN); 
+		    return 1;
+		}
+	    }
+	}
+	close(XMLIN);
+    }
+    
+    return undef; # haven't found a valid line
+    
+}
+
+sub read_file {
+    my $self = shift (@_);
+    my ($filename, $encoding, $language, $textref) = @_;
+
+    my $metadata_table = $self->{'metadata_table'};
+
+    my $rawtext = $metadata_table->{'rawtext'};
+
+    delete $metadata_table->{'rawtext'};
+
+    $$textref = $rawtext;
+}
+
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+
+    return 0 if (defined $self->{'extra_blocks'}->{$file});
+
+    # need to check whether this file is for us
+    my ($block_status,$filename) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+    if (!$self->check_doctype($filename)) {
+	# this file is not for us
+	return undef;
+    }
+
+    $self->{'metadata_table'} = $metadata;
+
+    my $lom_language = $metadata->{'lom_language'};
+
+    my $store_input_encoding;
+    my $store_extract_language;
+    my $store_default_language;
+    my $store_default_encoding;
+
+    if (defined $lom_language) {
+	delete $metadata->{'lom_language'};
+
+	$store_input_encoding   = $self->{'input_encoding'};
+	$store_extract_language = $self->{'extract_language'};
+	$store_default_language = $self->{'default_language'};
+	$store_default_encoding = $self->{'default_encoding'};
+
+	$self->{'input_encoding'}   = "utf8";
+	$self->{'extract_language'} = 0;
+	$self->{'default_language'} = $lom_language;
+	$self->{'default_encoding'} = "utf8";
+    }
+
+    my $rv = $self->SUPER::read(@_);
+
+    if (defined $lom_language) {	
+	$self->{'input_encoding'}   = $store_input_encoding;
+	$self->{'extract_language'} = $store_extract_language;
+	$self->{'default_language'} = $store_default_language;
+	$self->{'default_encoding'} = $store_default_encoding;
+    }
+
+    $self->{'metadata_table'} = undef;
+
+    return $rv;
+}
+
+# do plugin specific processing of doc_obj
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    print STDERR "<Processing n='$file' p='LOMPlug'>\n" if ($gli);
+
+    print $outhandle "LOMPLug: processing $file\n";
+
+    my $cursection = $doc_obj->get_top_section();
+    $doc_obj->add_utf8_text($cursection, $$textref);
+
+    return 1;
+}
+
+sub Doctype {
+    my ($expat, $name, $sysid, $pubid, $internal) = @_;
+
+    my $root_tag = $self->{'root_tag'};
+
+    if ($name !~ /$root_tag/) {	
+	die "Root tag $name does not match regular expression $root_tag";
+    }
+}
+
+sub StartTag {
+    my ($expat, $element) = @_;
+
+    my %attr = %_;
+    
+    my $raw_tag = "&lt;$element";
+    map { $raw_tag .= " $_=\"$attr{$_}\""; } keys %attr;
+    $raw_tag .= "&gt;";
+
+    if ($element =~ m/$self->{'root_tag'}/) {
+	$self->{'raw_text'} = $raw_tag;
+
+	$self->{'saved_metadata'} = {};
+	$self->{'metaname_stack'} = [];
+	$self->{'lom_datatype'} = "";
+	$self->{'lom_language'} = undef;
+	$self->{'metadatatext'} = "<table class=\"metadata\" width=\"_pagewidth_\" >\n";
+    }
+    else {
+	my $xml_depth = scalar(@{$self->{'metaname_stack'}});
+	$self->{'raw_text'} .= "\n"; 
+	$self->{'raw_text'} .= "&nbsp;&nbsp;" x $xml_depth; 
+	$self->{'raw_text'} .= $raw_tag;
+
+	my $metaname_stack = $self->{'metaname_stack'};
+	push(@$metaname_stack,$element);
+	if (scalar(@$metaname_stack)==1) {
+	    # top level LOM category
+	    my $style = "class=\"metadata\"";
+	    my $open_close
+		= "<a id=\"${element}opencloselink\" href=\"javascript:hideTBodyArea('$element')\">\n";
+	    $open_close
+		.= "<img id=\"${element}openclose\" border=\"0\" src=\"_httpopenmdicon_\"></a>\n";
+
+	    my $header_line = "  <tr $style ><th $style colspan=\"3\">$open_close \u$element</th></tr>\n";
+	    my $md_tbody = "<tbody id=\"$element\">\n";
+
+	    $self->{'mdheader'}     = $header_line;
+	    $self->{'mdtbody'}      = $md_tbody;
+	    $self->{'mdtbody_text'} = "";
+	}
+    }
+}
+
+sub EndTag {
+    my ($expat, $element) = @_;
+
+    my $raw_tag = "&lt;/$element&gt;";
+    
+    if ($element =~ m/$self->{'root_tag'}/) {
+	$self->{'raw_text'} .= $raw_tag;
+
+	my $metadatatext = $self->{'metadatatext'};
+	$metadatatext .= "</table>";
+
+	my $raw_text = $self->{'raw_text'};
+
+	$self->{'saved_metadata'}->{'MetadataTable'} =  $metadatatext;
+	$self->{'metadatatext'} = "";
+
+	$self->{'saved_metadata'}->{'rawtext'} =  $raw_text;
+	$self->{'raw_text'} = "";
+
+	if (defined $self->{'lom_language'}) {
+	    $self->{'saved_metadata'}->{'lom_language'} = $self->{'lom_language'};
+	    $self->{'lom_language'} = undef;
+	}
+    }
+    else {
+	my $metaname_stack = $self->{'metaname_stack'};
+
+	if (scalar(@$metaname_stack)==1) {
+	    my $header_line = $self->{'mdheader'};
+	    my $tbody_start = $self->{'mdtbody'};
+	    my $tbody_text  = $self->{'mdtbody_text'};
+	    if ($tbody_text !~ m/^\s*$/s) {
+		my $tbody_end = "</tbody>\n";
+		my $table_chunk 
+		    = $header_line.$tbody_start.$tbody_text.$tbody_end;
+
+		$self->{'metadatatext'} .= $table_chunk;
+	    }
+	    $self->{'mdtheader'}    = "";
+	    $self->{'mdtbody'}      = "";
+	    $self->{'mdtbody_text'} = "";
+	}
+
+	pop(@$metaname_stack);
+
+	my $xml_depth = scalar(@{$self->{'metaname_stack'}});
+	$self->{'raw_text'} .= "\n"; 
+	$self->{'raw_text'} .= "&nbsp;&nbsp;" x $xml_depth; 
+	$self->{'raw_text'} .= $raw_tag;
+    }
+}
+
+sub process_datatype_info
+{
+    my $self = shift(@_);
+    my ($metaname_stack,$md_content) = @_;
+
+    my @without_dt_stack = @$metaname_stack; # without datatype stack
+
+    my $innermost_element = $without_dt_stack[$#without_dt_stack];
+
+    # Loose last item if encoding datatype information
+    if ($innermost_element =~ m/^(lang)?string$/) {
+	$self->{'lom_datatype'} = $innermost_element;
+
+	pop @without_dt_stack;
+	$innermost_element = $without_dt_stack[$#without_dt_stack];
+    }
+    elsif ($innermost_element =~ m/^date(Time)?$/i) { 
+	if ($innermost_element =~ m/^date$/i) {
+	    $self->{'lom_datatype'} = "dateTime";
+	}
+	else {
+	    $self->{'lom_datatype'} = $innermost_element;
+
+	    pop @without_dt_stack;
+	    $innermost_element = $without_dt_stack[$#without_dt_stack];
+	}
+
+	if ($md_content =~ m/^(\d{1,2})\s*(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\w*\s*(\d{4})/i) {
+	    my ($day,$mon,$year) = ($1,$2,$3);
+	    
+	    my %month_lookup = ( 'jan' =>  1, 'feb' =>  2, 'mar' =>  3,
+				 'apr' =>  4, 'may' =>  5, 'jun' =>  6,
+				 'jul' =>  7, 'aug' =>  8, 'sep' =>  9,
+				 'oct' => 10, 'nov' => 11, 'dec' => 12 );
+
+	    my $mon_num = $month_lookup{lc($mon)};
+
+	    $md_content = sprintf("%d%02d%02d",$year,$mon_num,$day);
+	}
+
+	$md_content =~ s/\-//g;
+    }
+
+    if ($innermost_element eq "source") {
+	$self->{'lom_source'} = $md_content;
+    }
+    elsif ($innermost_element eq "value") {
+	$self->{'lom_value'} = $md_content;
+    }
+
+    return (\@without_dt_stack,$innermost_element,$md_content);
+}
+
+sub reset_datatype_info
+{
+    my $self = shift(@_);
+
+    $self->{'lom_datatype'} = "";
+}
+
+
+sub pretty_print_text
+{
+    my $self = shift(@_);
+    
+    my ($pretty_print_text) = @_;
+
+##    $metavalue_utf8 = &util::hyperlink_text($metavalue_utf8);
+    $pretty_print_text = &util::hyperlink_text($pretty_print_text);
+	
+####    $pretty_print_text =~ s/(BEGIN:vCard.*END:vCard)/<pre>$1<\/pre>/sg;
+
+    if ($self->{'lom_datatype'} eq "dateTime") {
+	if ($pretty_print_text =~ m/^(\d{4})(\d{2})(\d{2})$/) {
+	    $pretty_print_text = "$1-$2-$3";
+	}
+    }
+
+    return $pretty_print_text;
+}
+
+sub pretty_print_table_tr
+{
+    my $self = shift (@_);
+    my ($without_dt_stack) = @_;
+
+    my $style = "class=\"metadata\"";
+
+    my $innermost_element = $without_dt_stack->[scalar(@$without_dt_stack)-1];
+    my $outermost_element = $without_dt_stack->[0];
+
+    # Loose top level stack item (already named in pretty print table)
+    my @pretty_print_stack = @$without_dt_stack;
+    shift @pretty_print_stack; 
+
+    if ($innermost_element eq "source") {
+	return if (!defined $self->{'lom_value'});
+    }
+
+    if ($innermost_element eq "value") {
+	return if (!defined $self->{'lom_source'});
+    }
+
+    my $pretty_print_text = "";
+
+    if (($innermost_element eq "value") || ($innermost_element eq "source")) {
+	my $source = $self->{'lom_source'};
+	my $value  = $self->pretty_print_text($self->{'lom_value'});
+
+	$self->{'lom_source'} = undef;
+	$self->{'lom_value'} = undef;
+
+	pop @pretty_print_stack;
+	
+	$pretty_print_text = "<td $style>$source</td><td $style>$value</td>";
+    }
+    else {
+	$pretty_print_text = $self->pretty_print_text($_);
+	$pretty_print_text = "<td $style colspan=2>$pretty_print_text</td>";
+    }
+    my $pretty_print_fmn = join(' : ',map { "\u$_"; } @pretty_print_stack);
+
+
+    # my $tr_attr = "id=\"$outermost_element\" style=\"display:block;\"";
+    my $tr_attr = "$style id=\"$outermost_element\"";
+
+    my $mdtext_line = "  <tr $tr_attr><td $style><nobr>$pretty_print_fmn</nobr></td>$pretty_print_text</tr>\n";
+    $self->{'mdtbody_text'} .= $mdtext_line;
+}
+
+
+sub check_for_language
+{
+    my $self = shift(@_);
+    my ($innermost_element,$md_content) = @_;
+
+    # Look for 'language' tag
+    if ($innermost_element eq "language") {
+	my $lom_lang = $self->{'lom_language'};
+	
+	if (defined $lom_lang) {
+	    my $new_lom_lang = $md_content;
+	    $new_lom_lang =~ s/-.*//; # remove endings like -US or -GB
+
+	    if ($lom_lang ne $new_lom_lang) {
+		my $outhandle = $self->{'outhandle'};
+		
+		print $outhandle "Warning: Conflicting general language in record\n";
+		print $outhandle "         $new_lom_lang (previous value for language = $lom_lang)\n";
+	    }
+	    # otherwise, existing value OK => do nothing
+	}
+	else {
+	    $lom_lang = $md_content;
+	    $lom_lang =~ s/-.*//; # remove endings like -US or -GB
+	    
+	    $self->{'lom_language'} = $lom_lang;
+	}
+    }
+}
+
+sub found_specific_identifier
+{
+    my $self = shift(@_);
+    my ($specific_id,$full_mname,$md_content) = @_;
+
+    my $found_id = 0;
+    if ($full_mname eq $specific_id) {
+	if ($md_content =~ m/^(http|ftp):/) {
+	    $found_id = 1;
+	}
+    }
+
+    return $found_id;
+}
+
+sub download_srcdoc
+{
+    my $self = shift(@_);
+    my ($doc_url) = @_;
+
+    my $outhandle  = $self->{'outhandle'};
+    my $output_dir = $self->{'output_dir'};
+
+    $output_dir = &util::filename_cat($output_dir,"_gsdldown.all");
+
+    if (! -d $output_dir) {
+	mkdir $output_dir;
+    }
+
+    my $re_dirsep = &util::get_re_dirsep();
+    my $os_dirsep = &util::get_dirsep();
+
+    my $file_url = $doc_url;
+    $file_url =~ s/$re_dirsep/$os_dirsep/g;
+    $file_url =~ s/^(http|ftp):\/\///;
+    $file_url .= "index.html" if ($file_url =~ m/\/$/);
+
+    my $full_file_url = &util::filename_cat($output_dir,$file_url);
+
+    my $check_timestamp = $self->{'check_timestamp'};
+    my $status;
+
+    if (($check_timestamp) || (!$check_timestamp && !-e $full_file_url)) {
+	if (!-e $full_file_url) {
+	    print $outhandle "Mirroring $doc_url\n";
+	}
+	else {
+	    print $outhandle "Checking to see if update needed for $doc_url\n";
+	}
+
+	# on linux, if we pass an absolute path as -P arg to wget, then it 
+	# stuffs up the 
+	# URL rewriting in the file. Need a relative path or none, so now
+	# we change working directory first.
+	my $changed_dir = 0;
+	my $current_dir = cwd();
+	my $wget_cmd = "";
+	if ($ENV{'GSDLOS'} ne "windows") {
+	    $changed_dir = 1;
+	    
+	    chdir "$output_dir";
+	    $wget_cmd = "wget -nv  --timestamping -k -p \"$doc_url\"";
+	} else {
+	    $wget_cmd = "wget -nv -P \"$output_dir\" --timestamping -k -p \"$doc_url\""; 
+	}
+	#my $wget_cmd = "wget -nv -P$output_dir --timestamping -k -p \"$doc_url\""; 
+	### my $full_dir_url = &File::Basename::dirname($full_file_url);
+
+	## my $wget_cmd = "wget -O $full_file_url --timestamping -k \"$doc_url\"";
+	#my $wget_cmd = "wget -nv -P$output_dir --timestamping -x -k \"$doc_url\"";
+	print STDERR "**** wget = $wget_cmd\n";
+
+	
+	$status = system($wget_cmd);
+	if ($changed_dir) {
+	    chdir $current_dir;
+	}
+	if ($status==0) {
+	    $self->{'lom_srcdoc'} = $full_file_url;	
+	}
+	else {
+	    $self->{'lom_srcdoc'} = undef;
+	    print $outhandle "Error: failed to execute $wget_cmd\n";
+	}
+    }
+    else {
+	# not time-stamping and file already exists
+	$status=0;
+	$self->{'lom_srcdoc'} = $full_file_url;	
+    }
+
+    return $status==0;
+    
+}
+
+
+sub check_for_identifier
+{
+    my $self = shift(@_);
+    my ($full_mname,$md_content) = @_;
+
+    my $success = 0;
+
+    my $download_re = $self->{'download_srcdocs'};
+    if (($download_re ne "") && $md_content =~ m/$download_re/) {
+	
+	if ($self->found_specific_identifier("general^identifier^entry",$full_mname,$md_content)) {
+	    $success = $self->download_srcdoc($md_content);
+	}
+
+	if (!$success) {
+	    if ($self->found_specific_identifier("technical^location",$full_mname,$md_content)) {
+		$success = $self->download_srcdoc($md_content);
+	    }
+	}
+    }
+
+    return $success;
+}
+
+
+sub Text {
+    if ($_ !~ m/^\s*$/) {
+	#
+	# Work out indentations and line wraps for raw XML
+	#
+	my $xml_depth = scalar(@{$self->{'metaname_stack'}})+1;
+	my $indent = "&nbsp;&nbsp;" x $xml_depth; 
+	
+	my $formatted_text = "\n".$_;
+
+	# break into lines < 80 chars on space
+	$formatted_text =~ s/(.{50,80})\s+/$1\n/mg; 
+	$formatted_text =~ s/^/$indent/mg;
+	## $formatted_text =~ s/\s+$//s;
+
+	$self->{'raw_text'} .= $formatted_text;
+    }
+
+    my $metaname_stack = $self->{'metaname_stack'};
+    if (($_ !~ /^\s*$/) && (scalar(@$metaname_stack)>0)) {
+
+	my ($without_dt_stack,$innermost_element,$md_content)
+	    = $self->process_datatype_info($metaname_stack,$_);
+
+	$self->pretty_print_table_tr($without_dt_stack);
+
+	my $full_mname = join('^',@{$without_dt_stack});
+	$self->set_filere_metadata(lc($full_mname),$md_content);
+
+	$self->check_for_language($innermost_element,$md_content);
+	$self->check_for_identifier($full_mname,$md_content); # source doc
+
+	$self->reset_datatype_info();
+    }
+}
+
+# This Char function overrides the one in XML::Parser::Stream to overcome a
+# problem where $expat->{Text} is treated as the return value, slowing
+# things down significantly in some cases.
+sub Char {
+  $_[0]->{'Text'} .= $_[1];
+  return undef;
+}
+
+1;
Index: dl/trunk/perllib/plugins/LaTeXPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/LaTeXPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,762 +1,0 @@
-###########################################################################
-#
-# LaTeXPlug.pm
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Written by John McPherson
-# Copyright (C) 2004 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.
-#
-###########################################################################
-
-# todo:
-#  \includegraphics
-#  parse/remove tex \if ... macros
-
-package LaTeXPlug;
-
-# System complains about $arguments if the strict is set
-use strict;
-no strict 'refs'; # so we can print to a handle named by a variable
-
-# greenstone packages
-use BasPlug;
-use unicode;
-use util;
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_process_exp() } ];
-
-my $options = { 'name'     => 'LaTeXPlug',
-		'desc'     => '{LaTeXPlug.desc}',
-		'abstract' => 'no',
-		'inherits' => 'yes',
-		'args'     => $arguments };
-
-sub BEGIN {
-    @LaTeXPlug::ISA = ('BasPlug');
-}
-
-sub print_usage {
-    print STDERR "\n  usage: plugin LaTeXPlug [options]\n\n";
-}
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    $self->{'aux_files'} = {};
-    $self->{'dir_num'} = 0;
-    $self->{'file_num'} = 0;
-    return bless $self, $class;
-}
-
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-    return q^\.tex$^;
-}
-
-sub get_default_block_exp {
-    # assume any .eps files are part of the latex stuff
-    return '\.(?:eps)$';
-}
-
-
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-
-    my $start=substr($$textref, 0, 200); # first 200 bytes
-
-    if ($start !~ m~\\ (?:documentclass | documentstyle | input | section 
-			| chapter | contents | begin) ~x) {
-	# this doesn't look like latex...
-	return undef;
-    }
-    my $outhandle = $self->{'outhandle'};
-    if ($gli) {
-	print STDERR "<Processing n='$file' p='LaTeXPlug'>\n";
-    } elsif ($self->{'verbosity'} > 1) {
-	print $outhandle "LaTeXPlug: processing $file\n" 
-    }
-    my $cursection = $doc_obj->get_top_section();
-
-    ###### clean up text ######
-    $$textref =~ s/\r$//mg;  # remove dos ^M
-    $$textref =~ s/%.*$//mg; # remove comments
-
-    # convert to utf-8 if not already - assume non ascii => iso-8859-1/latin
-
-    $$textref =~ s@(?<=[[:ascii:]])\xA0+@\xc2\xa0@g; # latin nonbreaking space
-    # check that both sides are ascii, so we don't screw up utf-8 chars
-    $$textref =~ s@ (?<=[[:ascii:]])([\x80-\xff])(?=[[:ascii:]]) @
-	unicode::ascii2utf8($1) @egx; # takes "extended ascii" (ie latin)
-
-
-    ###### find metadata ######
-
-    ## FileFormat metadata ##
-    $doc_obj->add_metadata($cursection, "FileFormat", "LaTeX");
-
-    ### title metadata ###
-    $$textref =~ m@\\title\s*{(.*?)}@s;
-    my $title = $1;
-    if (!$title) {
-	# no title tag. look for a chapter/section heading
-	$$textref =~ m@\\(?:chapter|section)\s*{(.*?)}@s; # will get 1st match
-	$title = $1;
-    }
-    if (!$title) {
-	# no chapter/section heading tags either... use filename
-	$title = $file;
-	$title =~ s/\.tex$//i;
-	$title =~ s/[-_.]/ /g; # turn punctuation into spaces
-    }
-    if ($title) {
-	$title =~ s@\\\\@ @g; # embedded newlines
-	$title = $self->process_latex($title); # no "-html" for title eg in browser
-	$doc_obj->add_utf8_metadata($cursection, "Title", $title);
-    }
-
-    ### creator/individual author metadata ###
-    $$textref =~ m@\\author\s*{((?:{.*?}|.*?)+)}\s*$@sm;
-    my $authors=$1;
-    if ($authors) {
-	# take care of "et al."...
-	$authors =~ s/(\s+et\.?\s+al\.?)\s*$//;
-	my $etal=$1;
-	$etal="" if (!defined ($etal));
-
-	my @authorlist=parse_authors($self, $authors);
-
-	foreach my $author (@authorlist) {
-	    # Add each name to set of Authors
-	    $doc_obj->add_utf8_metadata ($cursection, "Author", $author);
-	}
-
-	# Only want at most one "and" in the Creator field
-	my $creator_str="";
-	if (scalar(@authorlist) > 2) {
-	    my $lastauthor=pop @authorlist;
-	    $creator_str=join(', ', @authorlist);
-	    $creator_str.=" and $lastauthor";
-	} else { # 1 or 2 authors...
-	    $creator_str=join(" and ",@authorlist);
-	}
-	$creator_str.=$etal; # if there was "et al."
-    	$doc_obj->add_utf8_metadata($cursection, "Creator", $creator_str);
-    }
-    ### end of author metadata ###
-
-    ###### process latex for the main text ######
-    $$textref =~ s/^.*?\\begin{document}//s;
-    $$textref =~ s/\\end{document}.*?$//s;
-    $$textref = $self->process_latex("-html",$$textref);
-    $doc_obj->add_utf8_text($cursection, $$textref);
-
-    return 1;
-}
-
-
-# returns a list of author names
-sub parse_authors {
-    my $self=shift;
-    my $authors=shift;
-
-    my $outhandle=$self->{'outhandle'};
-
-    $authors =~ s/\n/ /g; # remove newlines
-	
-    # some people do this for affiliation footnote/dagger
-    $authors =~ s@\$.*?\$@@g; # remove maths from author :(
-
-    # und here for german language...
-    # don't use brackets in pattern, else the matched bit becomes
-    # an element in the list!
-    my @authorlist = split(/\s+and\s+|\s+und\s+/, $authors);
-    my @formattedlist = ();
-    foreach my $author (@authorlist) {
-	$author =~ s/\s*$//; 
-	$author =~ s/^\s*//; 
-	# Reformat and add author name
-	next if $author=~ /^\s*$/;
-
-	# names are "First von Last", "von Last, First"
-	# or "von Last, Jr, First". See the "BibTeXing" manual, page 16
-	my $first="";
-	my $vonlast="";
-	my $jr="";
-	    
-	if ($author =~ /,/) {
-	    my @parts=split(/,\s*/, $author);
-	    $first = pop @parts;
-	    if (scalar(@parts) == 2) {
-		$jr = pop @parts;
-	    }
-	    $vonlast=shift @parts;
-	    if (scalar(@parts) > 0) {
-		print $outhandle $self->{'plugin_type'} .
-		    ": couldn't parse name $author\n";
-		# but we continue anyway...
-	    }
-	} else { # First von Last
-	    my @words = split(/ /, $author);
-	    while (scalar(@words) > 1 && $words[0] !~ /^[a-z]{2..}/) {
-		$first .= " " . shift (@words);
-	    }
-	    $first =~ s/^\s//;
-	    $vonlast = join (' ', @words); # whatever's left...
-	}
-	my $von="";
-	my $last="";
-	if ($vonlast =~ m/^[a-z]/) { # lowercase implies "von"
-	    $vonlast =~ s/^(([a-z]\w+\s+)+)//;
-	    $von = $1;
-	    if (!defined ($von)) {
-		# some non-English names do start with lowercase
-		# eg "Marie desJardins". Also we can get typos...
-		print $outhandle "BibTexPlug: couldn't parse surname $vonlast\n";
-		$von="";
-		if ($vonlast =~ /^[a-z]+$/) {
-		    # if it's all lowercase, uppercase 1st.
-		    $vonlast =~ s/^(.)/\u$1/;
-		}
-	    }
-	    $von =~ s/\s*$//;
-	    $last=$vonlast;
-	} else {
-	    $last=$vonlast;
-	}
-	my $wholename="$first $von $last $jr";
-	$wholename =~ s/ $//; $wholename =~ s/\s+/ /g;
-#	my $fullname = "$last";
-#	$fullname .= " $jr" if ($jr);
-#	$fullname .= ", $first";
-#	$fullname .= " $von" if ($von);
-	push (@formattedlist, $wholename);
-    }
-    return @formattedlist;
-}
-
-
-## following functions based on bibtex plugin ##
-# not actually used at the moment, but might be useful in future?
-sub expand_month {
-    my $text=shift;
-
-    # bibtex style files expand abbreviations for months.
-    # Entries can contain more than one month (eg ' month = jun # "-" # aug, ')
-    $text =~ s/jan/_textmonth01_/g;
-    $text =~ s/feb/_textmonth02_/g;
-    $text =~ s/mar/_textmonth03_/g;
-    $text =~ s/apr/_textmonth04_/g;
-    $text =~ s/may/_textmonth05_/g;
-    $text =~ s/jun/_textmonth06_/g;
-    $text =~ s/jul/_textmonth07_/g;
-    $text =~ s/aug/_textmonth08_/g;
-    $text =~ s/sep/_textmonth09_/g;
-    $text =~ s/oct/_textmonth10_/g;
-    $text =~ s/nov/_textmonth11_/g;
-    $text =~ s/dec/_textmonth12_/g;
-
-    return $text;
-}
-
-
-# If you want basic html formatting (eg \emph -> <em>, \bf, etc), give "-html"
-# as the first argument to this function.
-#
-# Convert accented characters, remove { }, interprete some commands....
-# Note!! This is not comprehensive! Also assumes Latin -> Unicode!
-
-# Also, it sucks quite a bit for complicated/nested commands since it doesn't
-# match { with the corresponding }, only the nearest }
-
-sub process_latex {
-    my $self=shift;
-    my $text=shift;
-
-    my $outhandle=$self->{'outhandle'};
-
-    my $html_markup=0;
-    if ($text =~ /^\-html/) {
-	$html_markup=1;
-	$text=shift;
-    }
-
-    if (! $text) {
-	return $text;
-    }
-    # escape html-sensitive characters
-    $text =~ s@&@&amp;@g;
-    $text =~ s@<@&lt;@g;
-    $text =~ s@>@&gt;@g;
- 
-    # do this before accents, since \= means something different in tabbing
-    # also \> is a tab stop too, and \\ is newline
-    sub do_tabbing {
-	my $tabbing=shift;
-	$tabbing =~ s!^.*\\kill\s*$!!mg; # \kill sets tab stops, kills line
-	$tabbing =~ s~\\(?:=|&gt;)~\xc2\xa0~g; # replace with nbsp
-	$tabbing =~ s~[\\][\\](?:\[.*?\])?\s*$~<br/>~mg;
-	return "<br/>" . $tabbing . "<br/>\n";
-    }
-    $text =~ s@\\begin{tabbing}(.*?)\\end{tabbing}@do_tabbing($1)@ges;
-    sub do_tabular {
-	my $tabular=shift;
-	$tabular =~ s~(?<!\\)\s*&amp;\s*~</td><td>~g;
-	$tabular =~ s~[\\][\\]\s*~</td></tr>\n <tr><td>~g;
-	$tabular =~ s~\\hline~~g; # for now...
-	$tabular =~ s~<td>\s*\\multicolumn{(\d+)}{.*?}~<td colspan="$1">~g;
-	return "<table border=\"1\">\n <tr><td>"
-	    . $tabular . "</td></tr></table>\n";
-    }
-    $text =~ s@\\begin{tabular}(?:\[.*?\])?{.*?}(.*?)\\end{tabular} @
-    		do_tabular($1)  @xges;
-
-    $text =~ s@[\\][\\]\s*\n@ @g; # fold lines ending with \\
-
-    # process maths mode before accents... things like \, mean different!
-    # maths mode
-    $text =~ s@\$\$(.*?)\$\$ 
-	@ process_latex_math($html_markup,$1)
-	@xsge; # multi-line maths: $$ .... $$
-
-    $text =~ s@([^\\])\$(.*?[^\\])\$
-	@$1.process_latex_math($html_markup,$2)@xsge;
-
-
-    # is this an amstext environment, or just custom for that input file?
-    $text =~ s@\\begin{(algorithm)}(.*?)\\end{\1}@remove_equals($2)@ges;
-
-    # convert latex-style accented characters.
-    $self->latex_accents_to_utf8(\$text);
-
-    # replace quotes with utf-8
-
-    $text =~ s/``/\xe2\xc0\x9c/g; # Latex-specific, left-dbl quote (&ldquo;)
-    $text =~ s/''/\xe2\xc0\x9d/g; # Latex-specific, right-dbl quote (&rdquo;)
-    $text =~ s/`/\xe2\xc0\x98/g; # single left quote
-    $text =~ s/'/\xe2\xc0\x99/g; # single right quote
-
-    ###### remove/replace latex commands ######
-    ### commands that expand to something that gets displayed ###
-    $text =~ s~\\ldots~&hellip;~g;
-    $text =~ s~\\hrule~<hr/>\n~g;
-    $text =~ s~\\maketitle~ ~;
-    ### space commands ###
-    $text =~ s~\\[vh]skip\s+\S+~~g;
-    $text =~ s~\\vspace\*?{.*?}~<div>&nbsp;</div>~g; # vertical space
-    $text =~ s~\\\w+skip~ ~g; # \smallskip \medskip \bigskip \baselineskip etc
-    $text =~ s~\\noindent\b~~g;
-    # newpage, etc
-    $text =~ s~\\(?:clearemptydoublepage|newpage)~~g;
-    ### counters, contents, environments, labels, etc ###
-    $text =~ s~\\(?:addcontentsline){.*?}{.*?}{.*}~~g;
-    $text =~ s~\s*\\begin{itemize}\s*~\n<ul>\n~g;
-    $text =~ s~\s*\\end{itemize}\s*~</li></ul>\n~g;
-    $text =~ s~\s*\\begin{enumerate}\s*~<ol>\n~g;
-    $text =~ s~\s*\\end{enumerate}\s*~</li></ol>\n~g;
-    if ($text =~ s~\s*\\item~</li>\n<li>~g) {
-	# (count for first list item)
-	$text =~ s~<([ou])l>\s*</li>\s*~<$1l>~g;
-    }
-    $text =~ s~\\(?:label|begin|end){.*?}\s*\n?~ ~g; # remove tag and contents
-    $text =~ s~\\(?:tableofcontents|listoffigures)~ ~g;
-    ### font sizes/styles ###
-    $text =~ s~\\(?:tiny|small|footnotesize|normalsize|large|Large|huge|Huge)\b~~g;
-
-    if ($html_markup) {
-	$text =~ s~\\section\*?{([^\}]+)}\s*\n?~<H1>$1</H1>\n~g;
-	$text =~ s~\\subsection\*?{(.*?)}\s*\n?~<H2>$1</H2>\n~g;
-	$text =~ s~{\\tt\s*(.*?)}~<tt>$1</tt>~g;
-	$text =~ s~\\(?:texttt|tt|ttseries)\s*{(.*?)}~<tt>$1</tt>~g;
-	$text =~ s~\\emph{(.*?)}~<em>$1</em>~g;
-	$text =~ s~{\\(?:em|it)\s*(.*?)}~<em>$1</em>~g;
-	$text =~ s~{\\(?:bf|bfseries)\s*(.*?)}~<strong>$1</strong>~g;
-	$text =~ s~\\(?:textbf|bf|bfseries)\s*{(.*?)}~<strong>$1</strong>~g;
-    } else {
-	# remove tags for text-only
-	$text =~ s~\\(?:textbf|bf|bfseries|em|emph|tt|rm|texttt)\b~ ~g;
-    }
-    $text =~ s ~ {\\sc\s+(.*?)} ~
-		{<span style="font-variant:\ small-caps">$1</span>} ~gx;
-    # ignore these font tags (if there are any left)
-    # sf is sans-serif
-    $text =~ s~\\(?:mdseries|textmd|bfseries|textbf|sffamily|sf|sc)\b~ ~;
-    #### end font-related stuff ####
-
-    ### remove all other commands with optional arguments... ###
-    # don't remove commands without { }....
-    # $text =~ s~\\\w+(\[.*?\])?\s*~~g;
-    # $text =~ s~\\noopsort{[^}]+\}~~g;
-    # verbatim
-    $text =~ s~\\verb(.)(.*?)\1~verb_text($1)~ge;
-    # remove tags, keep contents for \tag[optional]{contents}
-    while ($text =~ s~\\\w+(\[.*?\])?{([^}]+)}~$2 ~g) {;} # all other commands
-    
-    # remove latex groupings { } (but not \{ or \} )
-    while ($text =~ s/([^\\])[\{\}]/$1/g) {;} # needed for "...}{..."
-    $text =~ s/^\{//; # remove { if first char
-
-    # latex characters
-    # spaces - nobr space (~), opt break (\-), append ("#" - bibtex only)
-    $text =~ s/([^\\])~+/$1 /g; # non-breaking space  "~"
-    # optional break "\-"
-    if ($text =~ m/[^&]\#/) { # concat macros (bibtex) but not HTML codes
-	# the non-macro bits have quotes around them - we just remove quotes
-	# XXX bibtex and latex differ here (for the '#' char)...
-	$text =~ s/([^&])[\"\#]/$1/g;
-    }
-    # dashes. Convert (m|n)-dash into single dash for html.
-    $text =~ s~\-\-+~\-~g;
-
-    # quoted { } chars
-    $text =~ s~\\{~{~g;
-    $text =~ s~\\}~}~g;
-
-    # spaces
-    $text =~ s~\\ ~ ~g;
-
-    # finally to protect against macro language...
-    # greenstone-specific
-    $text =~ s~\[~&\#91;~g;
-    $text =~ s~\]~&\#93;~g;
-    $text =~ s~(?<!\\)([\\_])~\\$1~g;
-
-    if ($html_markup) {
-	$text =~ s~\n{2,}~\n</p>\n<p>~g;
-	return "<p>$text</p>";
-    }
-
-    return $text;
-}
-
-# only used by process_latex for \verb....
-sub verb_text {
-    my $verbatim=shift;
-    $verbatim =~ s/([{}_])/\\$1/g;
-    return $verbatim;
-}
-# only used by process_latex_math
-# returns a unicode char if applicable, otherwise ascii
-sub math_fraction {
-    my $num=$1;
-    my $denom=$2;
-
-    if ($num==1 && $denom==2) {return chr(0xc2).chr(0xbd)}
-    if ($num==1 && $denom==4) {return chr(0xc2).chr(0xbc)}
-    if ($num==3 && $denom==4) {return chr(0xc2).chr(0xbe)}
-    return "$num/$denom";
-}
-
-sub process_latex_math {
-
-    my $text = pop; # if given one or two args, this is the last one...
-    my $html_markup=pop; # if given two args, this is the first one else undef
-
-    $text =~ s~\\,~ ~g; # forces a space?
-    $text =~ s~\\infty~infinity~g;             # or unicode 0x221E...
-
-# use this one when more things can read 3-byte utf8 values like this!
-#    $text =~ s~\\cup\b~\xe2\xc8\xaa~g; # union operator - unicode 0x222a
-    $text =~ s~\\cup\b~ U ~g;
-
-    $text =~ s~\\frac\s*{(.+?)}{(.+?)}~math_fraction($1,$2)~ge;
-
-    if ($html_markup) {
-	$text =~ s~\^{(.*?)}~<sup>$1</sup>~g;  # a^b superscript
-	$text =~ s~\^([^\{])~<sup>$1</sup>~g;
-	$text =~ s~\_{(.*?)}~<sub>$1</sub>~g;  # a_b subscript
-	$text =~ s~\_([^\{])~<sub>$1</sub>~g;
-	
-	$text =~ s~\\ldots~&hellip;~g;         # use html named entity for now
-
-	# put all other command names in italics for now
-	$text =~ s~\\([\w]+)~<i>$1</i> ~g;
-    }
-
-    # special cases, for some input files
-    if ($text =~ m~^\\\w+$~) {
-	$text="{" . $text . "}";
-    }
-
-    return $text;
-}
-
-
-
-sub latex_accents_to_utf8 {
-
-    # note - this is really ugly, but it works. There may be a prettier way
-    # of mapping latex accented chars to utf8, but we just brute force it here.
-    # Also, this isn't complete - not every single possible accented letter
-    # is in here yet, but most of the common ones are.
-
-    my %utf8_chars =
-	(
-	 # acutes
-	 '\'a' => chr(0xc3).chr(0xa1),
-	 '\'c' => chr(0xc4).chr(0x87),
-	 '\'e' => chr(0xc3).chr(0xa9),
-	 '\'i' => chr(0xc3).chr(0xad),
-	 '\'l' => chr(0xc3).chr(0xba),
-	 '\'n' => chr(0xc3).chr(0x84),
-	 '\'o' => chr(0xc3).chr(0xb3),
-	 '\'r' => chr(0xc5).chr(0x95),
-	 '\'s' => chr(0xc5).chr(0x9b),
-	 '\'u' => chr(0xc3).chr(0xba),
-	 '\'y' => chr(0xc3).chr(0xbd),
-	 '\'z' => chr(0xc5).chr(0xba),
-	 # graves
-	 '`a' => chr(0xc3).chr(0xa0),
-	 '`A' => chr(0xc3).chr(0x80),
-	 '`e' => chr(0xc3).chr(0xa8),
-	 '`E' => chr(0xc3).chr(0x88),
-	 '`i' => chr(0xc3).chr(0xac),
-	 '`I' => chr(0xc3).chr(0x8c),
-	 '`o' => chr(0xc3).chr(0xb2),
-	 '`O' => chr(0xc3).chr(0x92),
-	 '`u' => chr(0xc3).chr(0xb9),
-	 '`U' => chr(0xc3).chr(0x99),
-	 # circumflex
-	 '^a' => chr(0xc3).chr(0xa2),
-	 '^A' => chr(0xc3).chr(0x82),
-	 '^c' => chr(0xc4).chr(0x89),
-	 '^C' => chr(0xc4).chr(0x88),
-	 '^e' => chr(0xc3).chr(0xaa),
-	 '^E' => chr(0xc3).chr(0x8a),
-	 '^g' => chr(0xc4).chr(0x9d),
-	 '^G' => chr(0xc4).chr(0x9c),
-	 '^h' => chr(0xc4).chr(0xa5),
-	 '^H' => chr(0xc4).chr(0xa4),
-	 '^i' => chr(0xc3).chr(0xae),
-	 '^I' => chr(0xc3).chr(0x8e),
-	 '^j' => chr(0xc4).chr(0xb5),
-	 '^J' => chr(0xc4).chr(0xb4),
-	 '^o' => chr(0xc3).chr(0xb4),
-	 '^O' => chr(0xc3).chr(0x94),
-	 '^s' => chr(0xc5).chr(0x9d),
-	 '^S' => chr(0xc5).chr(0x9c),
-	 '^u' => chr(0xc3).chr(0xa2),
-	 '^U' => chr(0xc3).chr(0xbb),
-	 '^w' => chr(0xc5).chr(0xb5),
-	 '^W' => chr(0xc5).chr(0xb4),
-	 '^y' => chr(0xc5).chr(0xb7),
-	 '^Y' => chr(0xc5).chr(0xb6),
-	 
-	 # diaeresis
-	 '"a' => chr(0xc3).chr(0xa4),
-	 '"A' => chr(0xc3).chr(0x84),
-	 '"e' => chr(0xc3).chr(0xab),
-	 '"E' => chr(0xc3).chr(0x8b),
-	 '"i' => chr(0xc3).chr(0xaf),
-	 '"I' => chr(0xc3).chr(0x8f),
-	 '"\\\\i' => chr(0xc3).chr(0xaf),
-	 '"\\\\I' => chr(0xc3).chr(0x8f),
-	 '"o' => chr(0xc3).chr(0xb6),
-	 '"O' => chr(0xc3).chr(0x96),
-	 '"u' => chr(0xc3).chr(0xbc),
-	 '"U' => chr(0xc3).chr(0x9c),
-	 '"y' => chr(0xc3).chr(0xbf),
-	 '"Y' => chr(0xc3).chr(0xb8),
-	 # tilde
-	 '~A' => chr(0xc3).chr(0x83),
-	 '~N' => chr(0xc3).chr(0x91),
-	 '~O' => chr(0xc3).chr(0x95),
-	 '~a' => chr(0xc3).chr(0xa3),
-	 '~n' => chr(0xc3).chr(0xb1),
-	 '~o' => chr(0xc3).chr(0xb5),
-	 # caron - handled specially
-	 # double acute
-	 # ring
-	 # dot
-	 '.c' => chr(0xc4).chr(0x8b),
-	 '.C' => chr(0xc4).chr(0x8a),
-	 '.e' => chr(0xc4).chr(0x97),
-	 '.E' => chr(0xc4).chr(0x96),
-	 '.g' => chr(0xc4).chr(0xa1),
-	 '.G' => chr(0xc4).chr(0xa0),
-	 '.I' => chr(0xc4).chr(0xb0),
-	 '.z' => chr(0xc5).chr(0xbc),
-	 '.Z' => chr(0xc5).chr(0xbb),
-	 # macron
-	 '=a' => chr(0xc4).chr(0x81),
-	 '=A' => chr(0xc4).chr(0x80),
-	 '=e' => chr(0xc4).chr(0x93),
-	 '=E' => chr(0xc4).chr(0x92),
-	 '=i' => chr(0xc4).chr(0xab),
-	 '=I' => chr(0xc4).chr(0xaa),
-	 '=o' => chr(0xc4).chr(0x8d),
-	 '=O' => chr(0xc4).chr(0x8c),
-	 '=u' => chr(0xc4).chr(0xab),
-	 '=U' => chr(0xc4).chr(0xaa),
-	 
-	 # stroke - handled specially - see below
-	 
-	 # cedilla - handled specially
-	 );
-    
-# these are one letter latex commands - we make sure they're not a longer
-# command name. eg {\d} is d+stroke, so careful of \d
-    my %special_utf8_chars = 
-	(
-	 # breve
-	 'u g' => chr(0xc4).chr(0x9f),
-	 'u G' => chr(0xc4).chr(0x9e),
-	 'u i' => chr(0xc4).chr(0xad),
-	 'u I' => chr(0xc4).chr(0xac),
-	 'u o' => chr(0xc5).chr(0x8f),
-	 'u O' => chr(0xc5).chr(0x8e),
-	 'u u' => chr(0xc5).chr(0xad),
-	 'u U' => chr(0xc5).chr(0xac),
-	 'u z' => chr(0xc5).chr(0xbe), # !!! no such char, but common mistake
-	 'u Z' => chr(0xc5).chr(0xbd), # used instead of v Z !!!
-	 # caron
-	 'v c' => chr(0xc4).chr(0x8d),
-	 'v C' => chr(0xc4).chr(0x8c),
-	 'v n' => chr(0xc5).chr(0x88),
-	 'v N' => chr(0xc5).chr(0x87),
-	 'v s' => chr(0xc5).chr(0xa1),
-	 'v S' => chr(0xc5).chr(0xa5),
-	 'v z' => chr(0xc5).chr(0xbe),
-	 'v Z' => chr(0xc5).chr(0xbd),
-	 # cedilla
-	 'c c' => chr(0xc3).chr(0xa7),
-	 'c C' => chr(0xc3).chr(0x87),
-	 'c g' => chr(0xc4).chr(0xa3),
-	 'c G' => chr(0xc4).chr(0xa2),
-	 'c k' => chr(0xc4).chr(0xb7),
-	 'c K' => chr(0xc4).chr(0xb6),
-	 'c l' => chr(0xc4).chr(0xbc),
-	 'c L' => chr(0xc4).chr(0xbb),
-	 'c n' => chr(0xc5).chr(0x86),
-	 'c N' => chr(0xc5).chr(0x85),
-	 'c r' => chr(0xc5).chr(0x97),
-	 'c R' => chr(0xc5).chr(0x96),
-	 'c s' => chr(0xc5).chr(0x9f),
-	 'c S' => chr(0xc5).chr(0x9e),
-	 'c t' => chr(0xc5).chr(0xa3),
-	 'c T' => chr(0xc5).chr(0xa2),
-	 # double acute / Hungarian accent
-	 'H O' => chr(0xc5).chr(0x90),
-	 'H o' => chr(0xc5).chr(0x91),
-	 'H U' => chr(0xc5).chr(0xb0),
-	 'H u' => chr(0xc5).chr(0xb1),
-	 
-	 # stroke 
-	 'd' => chr(0xc4).chr(0x91),
-	 'D' => chr(0xc4).chr(0x90),
-	 'h' => chr(0xc4).chr(0xa7),
-#	 'H' => chr(0xc4).chr(0xa6), # !! this normally(!!?) means Hung. umlaut
-	 'i' => chr(0xc4).chr(0xb1), # dotless lowercase i
-	 'l' => chr(0xc5).chr(0x82),
-	 'L' => chr(0xc5).chr(0x81),
-	 'o' => chr(0xc3).chr(0xb8),
-	 'O' => chr(0xc3).chr(0x98),
-	 't' => chr(0xc5).chr(0xa7),
-	 'T' => chr(0xc5).chr(0xa6),
-
-         # other special chars
-         'ss' => chr(0xc3).chr(0x9f), # german ss/szlig/sharp s
-         'aa' =>,chr(0xc3).chr(0xa5), # scandanavian/latin a with ring
-	 );
-
-    my $self=shift;
-    my $textref=shift;
-
-    my $outhandle=$self->{'outhandle'};
-    my $text=$$textref;
-    
-    # remove space (if any) between \ and letter to accent (eg {\' a})
-    $text =~ s!(\\[`'="^~\.])\s(\w)\b!$1$2!g;   # for emacs indenting... `]);
-
-    # remove {} around a single character (eg \'{e})
-    $text =~ s!(\\[`'="^~\.]){(\w)}!{$1$2}!g;  # for emacs indenting... `]);
-
-    ## only in bibtex... not in latex proper?!
-    ### \, is another way of doing cedilla \c
-    ##$text =~ s~\\,(.)~\\c $1~g;
-
-    # remove {} around a single character for special 1 letter commands -
-    # need to insert a space. Eg \v{s}  ->  {\v s}
-    $text =~ s~(\\[uvcH]){(\w)}~{$1 $2}~g;
-
-    # only do if the text contains a '\' character. 
-    if ($text =~ m|\\|) {
-	# "normal" accents - ie non-alpha latex tag
-	# xxx used to have ([\w]\b)@ (for word boundary)
-	while ($text =~ m/\\([`'="^~\.])([\w])/) {      # for emacs `])){
-	    my $tex="$1$2"; my $char="$2";
-	    my $replacement=$utf8_chars{$tex};
-	    if (!defined($replacement)) {
-		$text =~ m~(.{20}\\\Q$tex\E.{20})~s;
-		print $outhandle . $self->{'plugin_type'} .
-		    ": Warning: unknown latex accent \"$tex\""
-		    . " in \"$1\"\n";
-		$replacement=$char;
-	    }
-	    $text =~ s/\\\Q$tex/$replacement/g;
-	}
-
-        # where the following letter matters (eg "sm\o rrebr\o d", \ss{})
-        # only do the change if immediately followed by a space, }, {, or \
-	# one letter accents ( + ss / aa)
-        while ($text =~ m~\\([DdhiLlOoTt]|ss|aa)[{}\s\"\\]~) {
-	    my $tex=$1;
-	    my $replacement=$special_utf8_chars{$tex};
-	    if (!defined($replacement)) {
-		$text =~ m~(.{20}\\\Q$tex\E.{20})~s;
-		print $outhandle $self->{'plugin_type'} .
-		    ": Warning: unknown latex accent \"$tex\""
-		    . " in \"$1\"\n";
-		$replacement=$tex;
-	    }
-	    ($text =~ s/{\\$tex}/$replacement/g) or
-		$text =~ s/\\$tex([{}\s\"\\])/$replacement$1/g;
-
-	}
-
-	# one letter latex accent commands that affect following letter
-        while ($text =~ m~\\([uvcH]) ([\w])~) {
-          my $tex="$1 $2"; my $char="$2";
-          my $replacement=$special_utf8_chars{$tex};
-          if (!defined($replacement)) {
-	      $text =~ m~(.{20}\\\Q$tex\E.{20})~s;
-	      print  $outhandle $self->{'plugin_type'} .
-		  ": Warning: unknown latex accent \"$tex\""
-		  . " in \"$1\"\n";
-	      $replacement=$char;
-	  }
-          $text =~ s/\\$tex/$replacement/g;
-        }
-    }
-    $textref=\$text;
-}
-
-
-# modules must return true
-1;
Index: /gsdl/trunk/perllib/plugins/LaTeXPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/LaTeXPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/LaTeXPlugin.pm	(revision 15865)
@@ -0,0 +1,762 @@
+###########################################################################
+#
+# LaTeXPlug.pm
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Written by John McPherson
+# Copyright (C) 2004 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.
+#
+###########################################################################
+
+# todo:
+#  \includegraphics
+#  parse/remove tex \if ... macros
+
+package LaTeXPlug;
+
+# System complains about $arguments if the strict is set
+use strict;
+no strict 'refs'; # so we can print to a handle named by a variable
+
+# greenstone packages
+use BasPlug;
+use unicode;
+use util;
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_process_exp() } ];
+
+my $options = { 'name'     => 'LaTeXPlug',
+		'desc'     => '{LaTeXPlug.desc}',
+		'abstract' => 'no',
+		'inherits' => 'yes',
+		'args'     => $arguments };
+
+sub BEGIN {
+    @LaTeXPlug::ISA = ('BasPlug');
+}
+
+sub print_usage {
+    print STDERR "\n  usage: plugin LaTeXPlug [options]\n\n";
+}
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    $self->{'aux_files'} = {};
+    $self->{'dir_num'} = 0;
+    $self->{'file_num'} = 0;
+    return bless $self, $class;
+}
+
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+    return q^\.tex$^;
+}
+
+sub get_default_block_exp {
+    # assume any .eps files are part of the latex stuff
+    return '\.(?:eps)$';
+}
+
+
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+
+    my $start=substr($$textref, 0, 200); # first 200 bytes
+
+    if ($start !~ m~\\ (?:documentclass | documentstyle | input | section 
+			| chapter | contents | begin) ~x) {
+	# this doesn't look like latex...
+	return undef;
+    }
+    my $outhandle = $self->{'outhandle'};
+    if ($gli) {
+	print STDERR "<Processing n='$file' p='LaTeXPlug'>\n";
+    } elsif ($self->{'verbosity'} > 1) {
+	print $outhandle "LaTeXPlug: processing $file\n" 
+    }
+    my $cursection = $doc_obj->get_top_section();
+
+    ###### clean up text ######
+    $$textref =~ s/\r$//mg;  # remove dos ^M
+    $$textref =~ s/%.*$//mg; # remove comments
+
+    # convert to utf-8 if not already - assume non ascii => iso-8859-1/latin
+
+    $$textref =~ s@(?<=[[:ascii:]])\xA0+@\xc2\xa0@g; # latin nonbreaking space
+    # check that both sides are ascii, so we don't screw up utf-8 chars
+    $$textref =~ s@ (?<=[[:ascii:]])([\x80-\xff])(?=[[:ascii:]]) @
+	unicode::ascii2utf8($1) @egx; # takes "extended ascii" (ie latin)
+
+
+    ###### find metadata ######
+
+    ## FileFormat metadata ##
+    $doc_obj->add_metadata($cursection, "FileFormat", "LaTeX");
+
+    ### title metadata ###
+    $$textref =~ m@\\title\s*{(.*?)}@s;
+    my $title = $1;
+    if (!$title) {
+	# no title tag. look for a chapter/section heading
+	$$textref =~ m@\\(?:chapter|section)\s*{(.*?)}@s; # will get 1st match
+	$title = $1;
+    }
+    if (!$title) {
+	# no chapter/section heading tags either... use filename
+	$title = $file;
+	$title =~ s/\.tex$//i;
+	$title =~ s/[-_.]/ /g; # turn punctuation into spaces
+    }
+    if ($title) {
+	$title =~ s@\\\\@ @g; # embedded newlines
+	$title = $self->process_latex($title); # no "-html" for title eg in browser
+	$doc_obj->add_utf8_metadata($cursection, "Title", $title);
+    }
+
+    ### creator/individual author metadata ###
+    $$textref =~ m@\\author\s*{((?:{.*?}|.*?)+)}\s*$@sm;
+    my $authors=$1;
+    if ($authors) {
+	# take care of "et al."...
+	$authors =~ s/(\s+et\.?\s+al\.?)\s*$//;
+	my $etal=$1;
+	$etal="" if (!defined ($etal));
+
+	my @authorlist=parse_authors($self, $authors);
+
+	foreach my $author (@authorlist) {
+	    # Add each name to set of Authors
+	    $doc_obj->add_utf8_metadata ($cursection, "Author", $author);
+	}
+
+	# Only want at most one "and" in the Creator field
+	my $creator_str="";
+	if (scalar(@authorlist) > 2) {
+	    my $lastauthor=pop @authorlist;
+	    $creator_str=join(', ', @authorlist);
+	    $creator_str.=" and $lastauthor";
+	} else { # 1 or 2 authors...
+	    $creator_str=join(" and ",@authorlist);
+	}
+	$creator_str.=$etal; # if there was "et al."
+    	$doc_obj->add_utf8_metadata($cursection, "Creator", $creator_str);
+    }
+    ### end of author metadata ###
+
+    ###### process latex for the main text ######
+    $$textref =~ s/^.*?\\begin{document}//s;
+    $$textref =~ s/\\end{document}.*?$//s;
+    $$textref = $self->process_latex("-html",$$textref);
+    $doc_obj->add_utf8_text($cursection, $$textref);
+
+    return 1;
+}
+
+
+# returns a list of author names
+sub parse_authors {
+    my $self=shift;
+    my $authors=shift;
+
+    my $outhandle=$self->{'outhandle'};
+
+    $authors =~ s/\n/ /g; # remove newlines
+	
+    # some people do this for affiliation footnote/dagger
+    $authors =~ s@\$.*?\$@@g; # remove maths from author :(
+
+    # und here for german language...
+    # don't use brackets in pattern, else the matched bit becomes
+    # an element in the list!
+    my @authorlist = split(/\s+and\s+|\s+und\s+/, $authors);
+    my @formattedlist = ();
+    foreach my $author (@authorlist) {
+	$author =~ s/\s*$//; 
+	$author =~ s/^\s*//; 
+	# Reformat and add author name
+	next if $author=~ /^\s*$/;
+
+	# names are "First von Last", "von Last, First"
+	# or "von Last, Jr, First". See the "BibTeXing" manual, page 16
+	my $first="";
+	my $vonlast="";
+	my $jr="";
+	    
+	if ($author =~ /,/) {
+	    my @parts=split(/,\s*/, $author);
+	    $first = pop @parts;
+	    if (scalar(@parts) == 2) {
+		$jr = pop @parts;
+	    }
+	    $vonlast=shift @parts;
+	    if (scalar(@parts) > 0) {
+		print $outhandle $self->{'plugin_type'} .
+		    ": couldn't parse name $author\n";
+		# but we continue anyway...
+	    }
+	} else { # First von Last
+	    my @words = split(/ /, $author);
+	    while (scalar(@words) > 1 && $words[0] !~ /^[a-z]{2..}/) {
+		$first .= " " . shift (@words);
+	    }
+	    $first =~ s/^\s//;
+	    $vonlast = join (' ', @words); # whatever's left...
+	}
+	my $von="";
+	my $last="";
+	if ($vonlast =~ m/^[a-z]/) { # lowercase implies "von"
+	    $vonlast =~ s/^(([a-z]\w+\s+)+)//;
+	    $von = $1;
+	    if (!defined ($von)) {
+		# some non-English names do start with lowercase
+		# eg "Marie desJardins". Also we can get typos...
+		print $outhandle "BibTexPlug: couldn't parse surname $vonlast\n";
+		$von="";
+		if ($vonlast =~ /^[a-z]+$/) {
+		    # if it's all lowercase, uppercase 1st.
+		    $vonlast =~ s/^(.)/\u$1/;
+		}
+	    }
+	    $von =~ s/\s*$//;
+	    $last=$vonlast;
+	} else {
+	    $last=$vonlast;
+	}
+	my $wholename="$first $von $last $jr";
+	$wholename =~ s/ $//; $wholename =~ s/\s+/ /g;
+#	my $fullname = "$last";
+#	$fullname .= " $jr" if ($jr);
+#	$fullname .= ", $first";
+#	$fullname .= " $von" if ($von);
+	push (@formattedlist, $wholename);
+    }
+    return @formattedlist;
+}
+
+
+## following functions based on bibtex plugin ##
+# not actually used at the moment, but might be useful in future?
+sub expand_month {
+    my $text=shift;
+
+    # bibtex style files expand abbreviations for months.
+    # Entries can contain more than one month (eg ' month = jun # "-" # aug, ')
+    $text =~ s/jan/_textmonth01_/g;
+    $text =~ s/feb/_textmonth02_/g;
+    $text =~ s/mar/_textmonth03_/g;
+    $text =~ s/apr/_textmonth04_/g;
+    $text =~ s/may/_textmonth05_/g;
+    $text =~ s/jun/_textmonth06_/g;
+    $text =~ s/jul/_textmonth07_/g;
+    $text =~ s/aug/_textmonth08_/g;
+    $text =~ s/sep/_textmonth09_/g;
+    $text =~ s/oct/_textmonth10_/g;
+    $text =~ s/nov/_textmonth11_/g;
+    $text =~ s/dec/_textmonth12_/g;
+
+    return $text;
+}
+
+
+# If you want basic html formatting (eg \emph -> <em>, \bf, etc), give "-html"
+# as the first argument to this function.
+#
+# Convert accented characters, remove { }, interprete some commands....
+# Note!! This is not comprehensive! Also assumes Latin -> Unicode!
+
+# Also, it sucks quite a bit for complicated/nested commands since it doesn't
+# match { with the corresponding }, only the nearest }
+
+sub process_latex {
+    my $self=shift;
+    my $text=shift;
+
+    my $outhandle=$self->{'outhandle'};
+
+    my $html_markup=0;
+    if ($text =~ /^\-html/) {
+	$html_markup=1;
+	$text=shift;
+    }
+
+    if (! $text) {
+	return $text;
+    }
+    # escape html-sensitive characters
+    $text =~ s@&@&amp;@g;
+    $text =~ s@<@&lt;@g;
+    $text =~ s@>@&gt;@g;
+ 
+    # do this before accents, since \= means something different in tabbing
+    # also \> is a tab stop too, and \\ is newline
+    sub do_tabbing {
+	my $tabbing=shift;
+	$tabbing =~ s!^.*\\kill\s*$!!mg; # \kill sets tab stops, kills line
+	$tabbing =~ s~\\(?:=|&gt;)~\xc2\xa0~g; # replace with nbsp
+	$tabbing =~ s~[\\][\\](?:\[.*?\])?\s*$~<br/>~mg;
+	return "<br/>" . $tabbing . "<br/>\n";
+    }
+    $text =~ s@\\begin{tabbing}(.*?)\\end{tabbing}@do_tabbing($1)@ges;
+    sub do_tabular {
+	my $tabular=shift;
+	$tabular =~ s~(?<!\\)\s*&amp;\s*~</td><td>~g;
+	$tabular =~ s~[\\][\\]\s*~</td></tr>\n <tr><td>~g;
+	$tabular =~ s~\\hline~~g; # for now...
+	$tabular =~ s~<td>\s*\\multicolumn{(\d+)}{.*?}~<td colspan="$1">~g;
+	return "<table border=\"1\">\n <tr><td>"
+	    . $tabular . "</td></tr></table>\n";
+    }
+    $text =~ s@\\begin{tabular}(?:\[.*?\])?{.*?}(.*?)\\end{tabular} @
+    		do_tabular($1)  @xges;
+
+    $text =~ s@[\\][\\]\s*\n@ @g; # fold lines ending with \\
+
+    # process maths mode before accents... things like \, mean different!
+    # maths mode
+    $text =~ s@\$\$(.*?)\$\$ 
+	@ process_latex_math($html_markup,$1)
+	@xsge; # multi-line maths: $$ .... $$
+
+    $text =~ s@([^\\])\$(.*?[^\\])\$
+	@$1.process_latex_math($html_markup,$2)@xsge;
+
+
+    # is this an amstext environment, or just custom for that input file?
+    $text =~ s@\\begin{(algorithm)}(.*?)\\end{\1}@remove_equals($2)@ges;
+
+    # convert latex-style accented characters.
+    $self->latex_accents_to_utf8(\$text);
+
+    # replace quotes with utf-8
+
+    $text =~ s/``/\xe2\xc0\x9c/g; # Latex-specific, left-dbl quote (&ldquo;)
+    $text =~ s/''/\xe2\xc0\x9d/g; # Latex-specific, right-dbl quote (&rdquo;)
+    $text =~ s/`/\xe2\xc0\x98/g; # single left quote
+    $text =~ s/'/\xe2\xc0\x99/g; # single right quote
+
+    ###### remove/replace latex commands ######
+    ### commands that expand to something that gets displayed ###
+    $text =~ s~\\ldots~&hellip;~g;
+    $text =~ s~\\hrule~<hr/>\n~g;
+    $text =~ s~\\maketitle~ ~;
+    ### space commands ###
+    $text =~ s~\\[vh]skip\s+\S+~~g;
+    $text =~ s~\\vspace\*?{.*?}~<div>&nbsp;</div>~g; # vertical space
+    $text =~ s~\\\w+skip~ ~g; # \smallskip \medskip \bigskip \baselineskip etc
+    $text =~ s~\\noindent\b~~g;
+    # newpage, etc
+    $text =~ s~\\(?:clearemptydoublepage|newpage)~~g;
+    ### counters, contents, environments, labels, etc ###
+    $text =~ s~\\(?:addcontentsline){.*?}{.*?}{.*}~~g;
+    $text =~ s~\s*\\begin{itemize}\s*~\n<ul>\n~g;
+    $text =~ s~\s*\\end{itemize}\s*~</li></ul>\n~g;
+    $text =~ s~\s*\\begin{enumerate}\s*~<ol>\n~g;
+    $text =~ s~\s*\\end{enumerate}\s*~</li></ol>\n~g;
+    if ($text =~ s~\s*\\item~</li>\n<li>~g) {
+	# (count for first list item)
+	$text =~ s~<([ou])l>\s*</li>\s*~<$1l>~g;
+    }
+    $text =~ s~\\(?:label|begin|end){.*?}\s*\n?~ ~g; # remove tag and contents
+    $text =~ s~\\(?:tableofcontents|listoffigures)~ ~g;
+    ### font sizes/styles ###
+    $text =~ s~\\(?:tiny|small|footnotesize|normalsize|large|Large|huge|Huge)\b~~g;
+
+    if ($html_markup) {
+	$text =~ s~\\section\*?{([^\}]+)}\s*\n?~<H1>$1</H1>\n~g;
+	$text =~ s~\\subsection\*?{(.*?)}\s*\n?~<H2>$1</H2>\n~g;
+	$text =~ s~{\\tt\s*(.*?)}~<tt>$1</tt>~g;
+	$text =~ s~\\(?:texttt|tt|ttseries)\s*{(.*?)}~<tt>$1</tt>~g;
+	$text =~ s~\\emph{(.*?)}~<em>$1</em>~g;
+	$text =~ s~{\\(?:em|it)\s*(.*?)}~<em>$1</em>~g;
+	$text =~ s~{\\(?:bf|bfseries)\s*(.*?)}~<strong>$1</strong>~g;
+	$text =~ s~\\(?:textbf|bf|bfseries)\s*{(.*?)}~<strong>$1</strong>~g;
+    } else {
+	# remove tags for text-only
+	$text =~ s~\\(?:textbf|bf|bfseries|em|emph|tt|rm|texttt)\b~ ~g;
+    }
+    $text =~ s ~ {\\sc\s+(.*?)} ~
+		{<span style="font-variant:\ small-caps">$1</span>} ~gx;
+    # ignore these font tags (if there are any left)
+    # sf is sans-serif
+    $text =~ s~\\(?:mdseries|textmd|bfseries|textbf|sffamily|sf|sc)\b~ ~;
+    #### end font-related stuff ####
+
+    ### remove all other commands with optional arguments... ###
+    # don't remove commands without { }....
+    # $text =~ s~\\\w+(\[.*?\])?\s*~~g;
+    # $text =~ s~\\noopsort{[^}]+\}~~g;
+    # verbatim
+    $text =~ s~\\verb(.)(.*?)\1~verb_text($1)~ge;
+    # remove tags, keep contents for \tag[optional]{contents}
+    while ($text =~ s~\\\w+(\[.*?\])?{([^}]+)}~$2 ~g) {;} # all other commands
+    
+    # remove latex groupings { } (but not \{ or \} )
+    while ($text =~ s/([^\\])[\{\}]/$1/g) {;} # needed for "...}{..."
+    $text =~ s/^\{//; # remove { if first char
+
+    # latex characters
+    # spaces - nobr space (~), opt break (\-), append ("#" - bibtex only)
+    $text =~ s/([^\\])~+/$1 /g; # non-breaking space  "~"
+    # optional break "\-"
+    if ($text =~ m/[^&]\#/) { # concat macros (bibtex) but not HTML codes
+	# the non-macro bits have quotes around them - we just remove quotes
+	# XXX bibtex and latex differ here (for the '#' char)...
+	$text =~ s/([^&])[\"\#]/$1/g;
+    }
+    # dashes. Convert (m|n)-dash into single dash for html.
+    $text =~ s~\-\-+~\-~g;
+
+    # quoted { } chars
+    $text =~ s~\\{~{~g;
+    $text =~ s~\\}~}~g;
+
+    # spaces
+    $text =~ s~\\ ~ ~g;
+
+    # finally to protect against macro language...
+    # greenstone-specific
+    $text =~ s~\[~&\#91;~g;
+    $text =~ s~\]~&\#93;~g;
+    $text =~ s~(?<!\\)([\\_])~\\$1~g;
+
+    if ($html_markup) {
+	$text =~ s~\n{2,}~\n</p>\n<p>~g;
+	return "<p>$text</p>";
+    }
+
+    return $text;
+}
+
+# only used by process_latex for \verb....
+sub verb_text {
+    my $verbatim=shift;
+    $verbatim =~ s/([{}_])/\\$1/g;
+    return $verbatim;
+}
+# only used by process_latex_math
+# returns a unicode char if applicable, otherwise ascii
+sub math_fraction {
+    my $num=$1;
+    my $denom=$2;
+
+    if ($num==1 && $denom==2) {return chr(0xc2).chr(0xbd)}
+    if ($num==1 && $denom==4) {return chr(0xc2).chr(0xbc)}
+    if ($num==3 && $denom==4) {return chr(0xc2).chr(0xbe)}
+    return "$num/$denom";
+}
+
+sub process_latex_math {
+
+    my $text = pop; # if given one or two args, this is the last one...
+    my $html_markup=pop; # if given two args, this is the first one else undef
+
+    $text =~ s~\\,~ ~g; # forces a space?
+    $text =~ s~\\infty~infinity~g;             # or unicode 0x221E...
+
+# use this one when more things can read 3-byte utf8 values like this!
+#    $text =~ s~\\cup\b~\xe2\xc8\xaa~g; # union operator - unicode 0x222a
+    $text =~ s~\\cup\b~ U ~g;
+
+    $text =~ s~\\frac\s*{(.+?)}{(.+?)}~math_fraction($1,$2)~ge;
+
+    if ($html_markup) {
+	$text =~ s~\^{(.*?)}~<sup>$1</sup>~g;  # a^b superscript
+	$text =~ s~\^([^\{])~<sup>$1</sup>~g;
+	$text =~ s~\_{(.*?)}~<sub>$1</sub>~g;  # a_b subscript
+	$text =~ s~\_([^\{])~<sub>$1</sub>~g;
+	
+	$text =~ s~\\ldots~&hellip;~g;         # use html named entity for now
+
+	# put all other command names in italics for now
+	$text =~ s~\\([\w]+)~<i>$1</i> ~g;
+    }
+
+    # special cases, for some input files
+    if ($text =~ m~^\\\w+$~) {
+	$text="{" . $text . "}";
+    }
+
+    return $text;
+}
+
+
+
+sub latex_accents_to_utf8 {
+
+    # note - this is really ugly, but it works. There may be a prettier way
+    # of mapping latex accented chars to utf8, but we just brute force it here.
+    # Also, this isn't complete - not every single possible accented letter
+    # is in here yet, but most of the common ones are.
+
+    my %utf8_chars =
+	(
+	 # acutes
+	 '\'a' => chr(0xc3).chr(0xa1),
+	 '\'c' => chr(0xc4).chr(0x87),
+	 '\'e' => chr(0xc3).chr(0xa9),
+	 '\'i' => chr(0xc3).chr(0xad),
+	 '\'l' => chr(0xc3).chr(0xba),
+	 '\'n' => chr(0xc3).chr(0x84),
+	 '\'o' => chr(0xc3).chr(0xb3),
+	 '\'r' => chr(0xc5).chr(0x95),
+	 '\'s' => chr(0xc5).chr(0x9b),
+	 '\'u' => chr(0xc3).chr(0xba),
+	 '\'y' => chr(0xc3).chr(0xbd),
+	 '\'z' => chr(0xc5).chr(0xba),
+	 # graves
+	 '`a' => chr(0xc3).chr(0xa0),
+	 '`A' => chr(0xc3).chr(0x80),
+	 '`e' => chr(0xc3).chr(0xa8),
+	 '`E' => chr(0xc3).chr(0x88),
+	 '`i' => chr(0xc3).chr(0xac),
+	 '`I' => chr(0xc3).chr(0x8c),
+	 '`o' => chr(0xc3).chr(0xb2),
+	 '`O' => chr(0xc3).chr(0x92),
+	 '`u' => chr(0xc3).chr(0xb9),
+	 '`U' => chr(0xc3).chr(0x99),
+	 # circumflex
+	 '^a' => chr(0xc3).chr(0xa2),
+	 '^A' => chr(0xc3).chr(0x82),
+	 '^c' => chr(0xc4).chr(0x89),
+	 '^C' => chr(0xc4).chr(0x88),
+	 '^e' => chr(0xc3).chr(0xaa),
+	 '^E' => chr(0xc3).chr(0x8a),
+	 '^g' => chr(0xc4).chr(0x9d),
+	 '^G' => chr(0xc4).chr(0x9c),
+	 '^h' => chr(0xc4).chr(0xa5),
+	 '^H' => chr(0xc4).chr(0xa4),
+	 '^i' => chr(0xc3).chr(0xae),
+	 '^I' => chr(0xc3).chr(0x8e),
+	 '^j' => chr(0xc4).chr(0xb5),
+	 '^J' => chr(0xc4).chr(0xb4),
+	 '^o' => chr(0xc3).chr(0xb4),
+	 '^O' => chr(0xc3).chr(0x94),
+	 '^s' => chr(0xc5).chr(0x9d),
+	 '^S' => chr(0xc5).chr(0x9c),
+	 '^u' => chr(0xc3).chr(0xa2),
+	 '^U' => chr(0xc3).chr(0xbb),
+	 '^w' => chr(0xc5).chr(0xb5),
+	 '^W' => chr(0xc5).chr(0xb4),
+	 '^y' => chr(0xc5).chr(0xb7),
+	 '^Y' => chr(0xc5).chr(0xb6),
+	 
+	 # diaeresis
+	 '"a' => chr(0xc3).chr(0xa4),
+	 '"A' => chr(0xc3).chr(0x84),
+	 '"e' => chr(0xc3).chr(0xab),
+	 '"E' => chr(0xc3).chr(0x8b),
+	 '"i' => chr(0xc3).chr(0xaf),
+	 '"I' => chr(0xc3).chr(0x8f),
+	 '"\\\\i' => chr(0xc3).chr(0xaf),
+	 '"\\\\I' => chr(0xc3).chr(0x8f),
+	 '"o' => chr(0xc3).chr(0xb6),
+	 '"O' => chr(0xc3).chr(0x96),
+	 '"u' => chr(0xc3).chr(0xbc),
+	 '"U' => chr(0xc3).chr(0x9c),
+	 '"y' => chr(0xc3).chr(0xbf),
+	 '"Y' => chr(0xc3).chr(0xb8),
+	 # tilde
+	 '~A' => chr(0xc3).chr(0x83),
+	 '~N' => chr(0xc3).chr(0x91),
+	 '~O' => chr(0xc3).chr(0x95),
+	 '~a' => chr(0xc3).chr(0xa3),
+	 '~n' => chr(0xc3).chr(0xb1),
+	 '~o' => chr(0xc3).chr(0xb5),
+	 # caron - handled specially
+	 # double acute
+	 # ring
+	 # dot
+	 '.c' => chr(0xc4).chr(0x8b),
+	 '.C' => chr(0xc4).chr(0x8a),
+	 '.e' => chr(0xc4).chr(0x97),
+	 '.E' => chr(0xc4).chr(0x96),
+	 '.g' => chr(0xc4).chr(0xa1),
+	 '.G' => chr(0xc4).chr(0xa0),
+	 '.I' => chr(0xc4).chr(0xb0),
+	 '.z' => chr(0xc5).chr(0xbc),
+	 '.Z' => chr(0xc5).chr(0xbb),
+	 # macron
+	 '=a' => chr(0xc4).chr(0x81),
+	 '=A' => chr(0xc4).chr(0x80),
+	 '=e' => chr(0xc4).chr(0x93),
+	 '=E' => chr(0xc4).chr(0x92),
+	 '=i' => chr(0xc4).chr(0xab),
+	 '=I' => chr(0xc4).chr(0xaa),
+	 '=o' => chr(0xc4).chr(0x8d),
+	 '=O' => chr(0xc4).chr(0x8c),
+	 '=u' => chr(0xc4).chr(0xab),
+	 '=U' => chr(0xc4).chr(0xaa),
+	 
+	 # stroke - handled specially - see below
+	 
+	 # cedilla - handled specially
+	 );
+    
+# these are one letter latex commands - we make sure they're not a longer
+# command name. eg {\d} is d+stroke, so careful of \d
+    my %special_utf8_chars = 
+	(
+	 # breve
+	 'u g' => chr(0xc4).chr(0x9f),
+	 'u G' => chr(0xc4).chr(0x9e),
+	 'u i' => chr(0xc4).chr(0xad),
+	 'u I' => chr(0xc4).chr(0xac),
+	 'u o' => chr(0xc5).chr(0x8f),
+	 'u O' => chr(0xc5).chr(0x8e),
+	 'u u' => chr(0xc5).chr(0xad),
+	 'u U' => chr(0xc5).chr(0xac),
+	 'u z' => chr(0xc5).chr(0xbe), # !!! no such char, but common mistake
+	 'u Z' => chr(0xc5).chr(0xbd), # used instead of v Z !!!
+	 # caron
+	 'v c' => chr(0xc4).chr(0x8d),
+	 'v C' => chr(0xc4).chr(0x8c),
+	 'v n' => chr(0xc5).chr(0x88),
+	 'v N' => chr(0xc5).chr(0x87),
+	 'v s' => chr(0xc5).chr(0xa1),
+	 'v S' => chr(0xc5).chr(0xa5),
+	 'v z' => chr(0xc5).chr(0xbe),
+	 'v Z' => chr(0xc5).chr(0xbd),
+	 # cedilla
+	 'c c' => chr(0xc3).chr(0xa7),
+	 'c C' => chr(0xc3).chr(0x87),
+	 'c g' => chr(0xc4).chr(0xa3),
+	 'c G' => chr(0xc4).chr(0xa2),
+	 'c k' => chr(0xc4).chr(0xb7),
+	 'c K' => chr(0xc4).chr(0xb6),
+	 'c l' => chr(0xc4).chr(0xbc),
+	 'c L' => chr(0xc4).chr(0xbb),
+	 'c n' => chr(0xc5).chr(0x86),
+	 'c N' => chr(0xc5).chr(0x85),
+	 'c r' => chr(0xc5).chr(0x97),
+	 'c R' => chr(0xc5).chr(0x96),
+	 'c s' => chr(0xc5).chr(0x9f),
+	 'c S' => chr(0xc5).chr(0x9e),
+	 'c t' => chr(0xc5).chr(0xa3),
+	 'c T' => chr(0xc5).chr(0xa2),
+	 # double acute / Hungarian accent
+	 'H O' => chr(0xc5).chr(0x90),
+	 'H o' => chr(0xc5).chr(0x91),
+	 'H U' => chr(0xc5).chr(0xb0),
+	 'H u' => chr(0xc5).chr(0xb1),
+	 
+	 # stroke 
+	 'd' => chr(0xc4).chr(0x91),
+	 'D' => chr(0xc4).chr(0x90),
+	 'h' => chr(0xc4).chr(0xa7),
+#	 'H' => chr(0xc4).chr(0xa6), # !! this normally(!!?) means Hung. umlaut
+	 'i' => chr(0xc4).chr(0xb1), # dotless lowercase i
+	 'l' => chr(0xc5).chr(0x82),
+	 'L' => chr(0xc5).chr(0x81),
+	 'o' => chr(0xc3).chr(0xb8),
+	 'O' => chr(0xc3).chr(0x98),
+	 't' => chr(0xc5).chr(0xa7),
+	 'T' => chr(0xc5).chr(0xa6),
+
+         # other special chars
+         'ss' => chr(0xc3).chr(0x9f), # german ss/szlig/sharp s
+         'aa' =>,chr(0xc3).chr(0xa5), # scandanavian/latin a with ring
+	 );
+
+    my $self=shift;
+    my $textref=shift;
+
+    my $outhandle=$self->{'outhandle'};
+    my $text=$$textref;
+    
+    # remove space (if any) between \ and letter to accent (eg {\' a})
+    $text =~ s!(\\[`'="^~\.])\s(\w)\b!$1$2!g;   # for emacs indenting... `]);
+
+    # remove {} around a single character (eg \'{e})
+    $text =~ s!(\\[`'="^~\.]){(\w)}!{$1$2}!g;  # for emacs indenting... `]);
+
+    ## only in bibtex... not in latex proper?!
+    ### \, is another way of doing cedilla \c
+    ##$text =~ s~\\,(.)~\\c $1~g;
+
+    # remove {} around a single character for special 1 letter commands -
+    # need to insert a space. Eg \v{s}  ->  {\v s}
+    $text =~ s~(\\[uvcH]){(\w)}~{$1 $2}~g;
+
+    # only do if the text contains a '\' character. 
+    if ($text =~ m|\\|) {
+	# "normal" accents - ie non-alpha latex tag
+	# xxx used to have ([\w]\b)@ (for word boundary)
+	while ($text =~ m/\\([`'="^~\.])([\w])/) {      # for emacs `])){
+	    my $tex="$1$2"; my $char="$2";
+	    my $replacement=$utf8_chars{$tex};
+	    if (!defined($replacement)) {
+		$text =~ m~(.{20}\\\Q$tex\E.{20})~s;
+		print $outhandle . $self->{'plugin_type'} .
+		    ": Warning: unknown latex accent \"$tex\""
+		    . " in \"$1\"\n";
+		$replacement=$char;
+	    }
+	    $text =~ s/\\\Q$tex/$replacement/g;
+	}
+
+        # where the following letter matters (eg "sm\o rrebr\o d", \ss{})
+        # only do the change if immediately followed by a space, }, {, or \
+	# one letter accents ( + ss / aa)
+        while ($text =~ m~\\([DdhiLlOoTt]|ss|aa)[{}\s\"\\]~) {
+	    my $tex=$1;
+	    my $replacement=$special_utf8_chars{$tex};
+	    if (!defined($replacement)) {
+		$text =~ m~(.{20}\\\Q$tex\E.{20})~s;
+		print $outhandle $self->{'plugin_type'} .
+		    ": Warning: unknown latex accent \"$tex\""
+		    . " in \"$1\"\n";
+		$replacement=$tex;
+	    }
+	    ($text =~ s/{\\$tex}/$replacement/g) or
+		$text =~ s/\\$tex([{}\s\"\\])/$replacement$1/g;
+
+	}
+
+	# one letter latex accent commands that affect following letter
+        while ($text =~ m~\\([uvcH]) ([\w])~) {
+          my $tex="$1 $2"; my $char="$2";
+          my $replacement=$special_utf8_chars{$tex};
+          if (!defined($replacement)) {
+	      $text =~ m~(.{20}\\\Q$tex\E.{20})~s;
+	      print  $outhandle $self->{'plugin_type'} .
+		  ": Warning: unknown latex accent \"$tex\""
+		  . " in \"$1\"\n";
+	      $replacement=$char;
+	  }
+          $text =~ s/\\$tex/$replacement/g;
+        }
+    }
+    $textref=\$text;
+}
+
+
+# modules must return true
+1;
Index: dl/trunk/perllib/plugins/MARCPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/MARCPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,453 +1,0 @@
-###########################################################################
-#
-# MARCPlug.pm -- basic MARC plugin
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 2002 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 MARCPlug;
-
-use SplitPlug;
-
-use unicode;
-use util;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @MARCPlug::ISA = ('SplitPlug');
-    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
-}
-
-my $arguments = 
-    [ { 'name' => "metadata_mapping",
-	'desc' => "{MARCPlug.metadata_mapping}",
-	'type' => "string",
-	'deft' => "marctodc.txt",
-	'hiddengli' => "yes", # deprecated in favour or 'metadata_mapping_file'
-	'reqd' => "no" },
-      { 'name' => "metadata_mapping_file",
-	'desc' => "{MARCXMLPlug.metadata_mapping_file}",
-	'type' => "string",
-	'deft' => "",
-	'reqd' => "no" },
-      { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_process_exp() },
-      { 'name' => "split_exp",
-	'desc' => "{SplitPlug.split_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_split_exp() } 
-      ];
-
-my $options = { 'name'     => "MARCPlug",
-		'desc'     => "{MARCPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'explodes' => "yes",
-		'args'     => $arguments };
-
-require MARC::Record;  
-require MARC::Batch;  
-#use MARC::Record;  
-#use MARC::Batch;
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new SplitPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    # 'metadata_mapping' was used in two ways in the plugin: as a plugin
-    # option (filename) and as a datastructure to represent the mapping.
-    # In MARXXMLPlug (written later) the two are separated: filename is
-    # represented through 'metadata_mapping_file' and the data-structure
-    # mapping left as 'metadata_mapping'
-    # 'metadata_mapping' still present (but hidden in GLI) for
-    # backwards compatibility, but 'metadata_mapping_file' is used by
-    # preference
-
-    if ($self->{'metadata_mapping_file'} eq "") {
-	# If nothing set in the new version, use the old version
-	# that defaults to 'marctodc.txt'
-	$self->{'metadata_mapping_file'} = $self->{'metadata_mapping'};
-    }
-
-    $self->{'type'} = "";
-    
-    return bless $self, $class;
-}
-
-sub init {
-    my $self = shift (@_);
-    my ($verbosity, $outhandle, $failhandle) = @_;
-
-    my @metadata_mapping = ();
-
-    # read in the metadata mapping file
-
-    my $mm_file = &util::locate_config_file($self->{'metadata_mapping_file'}); 
-
-    if (!defined $mm_file)
-    {
-
-	my $msg = "MARCPlug ERROR: Can't locate mapping file \"" .
-	    $self->{'metadata_mapping_file'} . "\".\n" .
-		"    No marc files can be processed.\n";
-
-	print $outhandle $msg;
-	print $failhandle $msg;
-	$self->{'metadata_mapping'} = undef;
-	# We pick up the error in process() if there is no $mm_file
-	# If we exit here, then pluginfo.pl will exit too!
-    }
-    elsif (open(MMIN, "<$mm_file"))
-    {
-	my $l=1;
-	my $line;
-	while (defined($line=<MMIN>))
-	{
-	    chomp $line;
-	    if ($line =~ m/^(\d+)\s*->\s*([\w\^]+)$/)
-	    {
-		my $marc_info = $1;
-		my $gsdl_info = $2;
-		my $mapping = { 'marc' => $marc_info, 'gsdl' => $gsdl_info };
-		push(@metadata_mapping,$mapping);
-	    }
-	    elsif ($line !~ m/^\#/       # allow comments (# in first column)
-		   && $line !~ m/^\s*$/) # allow blank lines
-	    {
-		print $outhandle "Parse error on line $l of $mm_file:\n";
-		print $outhandle "  \"$line\"\n";
-	    }
-	    $l++
-	}
-	close(MMIN);
-
-	$self->{'metadata_mapping'} = \@metadata_mapping;
-    }
-    else
-    {
-	print STDERR "Unable to open $mm_file: $!\n";
-    }
-
-
-
-    $self->SUPER::init(@_);
-}
-    
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)(\.marc)$^;
-}
-
-
-sub get_default_split_exp {
-    # \r\n for msdos eol, \n for unix
-    return q^\r?\n\s*\r?\n|\[\w+\]Record type: USmarc^;
-}
-
-
-
-# The bulk of this function is based on read_line in multiread.pm
-# Unable to use read_line original because it expects to get its input
-# from a file.  Here the line to be converted is passed in as a string
-
-sub to_utf8
-{
-    my $self = shift (@_);
-    my ($encoding, $line) = @_;
-
-    if ($encoding eq "utf8") {
-	# nothing needs to be done
-	return $line;
-    }
-
-    if ($encoding eq "iso_8859_1") {
-	# we'll use ascii2utf8() for this as it's faster than going
-	# through convert2unicode()
-	return &unicode::ascii2utf8 (\$line);
-    }
-
-    # everything else uses unicode::convert2unicode
-    return &unicode::unicode2utf8 (&unicode::convert2unicode ($encoding, \$line));
-}
-
-
-sub read_file {
-    my $self = shift (@_);
-    my ($filename, $encoding, $language, $textref) = @_;
-
-    $self->{'readfile_encoding'}->{$filename} = $encoding;
-
-       
-    if (!-r $filename)
-    {
-	my $outhandle = $self->{'outhandle'};
-	print $outhandle "Read permission denied for $filename\n" if $self->{'verbosity'};
-	return;
-    }
-
-    ##handle ascii marc
-    #test whether this is ascii marc file 
-    if (open (FILE, $filename)) {
-	while (defined (my $line = <FILE>)) {
-	    $$textref .= $line;
-	   if ($line =~ /\[\w+\]Record type:/){
-	       undef $/;
-	       $$textref .= <FILE>;
-	       $/ = "\n";
-	       $self->{'type'} = "ascii";
-	       close FILE;
-	       return;
-	   }
-	}
-	close FILE;	
-    }
-
-      
-    $$textref = "";
-    my @marc_entries = ();
- 
-    my $batch = new MARC::Batch( 'USMARC', $filename );
-    while ( my $marc = $batch->next ) 
-    {
-      	push(@marc_entries,$marc);
-	$$textref .= $marc->as_formatted();
-	$$textref .= "\n\n"; # for SplitPlug - see default_split_exp above...
-    }
-
-    $self->{'marc_entries'}->{$filename} = \@marc_entries;
-}
-
-
-
-# do plugin specific processing of doc_obj
-# This gets done for each record found by SplitPlug in marc files.
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-    my $filename = &util::filename_cat($base_dir, $file);
-
-    if (! defined($self->{'metadata_mapping'}))
-    {
-	print $outhandle "MARCPlug: no metadata file! Can't process $file\n";
-	return undef;
-    }
-
-    print STDERR "<Processing n='$file' p='MARCPlug'>\n" if ($gli);
-    print $outhandle "MARCPlug: processing $file\n"
-	if $self->{'verbosity'} > 1;
-
-    my $cursection = $doc_obj->get_top_section();
-
-    # Add fileFormat as the metadata
-    $doc_obj->add_metadata($cursection, "FileFormat", "MARC");
-    
-    my $marc_entries = $self->{'marc_entries'}->{$filename};
-    my $marc = shift(@$marc_entries);
-
-    my $encoding = $self->{'readfile_encoding'}->{$filename};
-
-    if ($self->{'type'} ne "ascii" ){   
-       	$self->extract_metadata ($marc, $metadata, $encoding, $doc_obj, $cursection);
-    }
-    else{
-	$self->extract_ascii_metadata ($$textref,$metadata,$doc_obj, $cursection);
-    }
-
-    # add spaces after the sub-field markers, for word boundaries
-    $$textref =~ s/^(.{6} _\w)/$1 /gm;
-
-    # add text to document object
-    $$textref =~ s/</&lt;/g;
-    $$textref =~ s/>/&gt;/g;
-
-    $$textref = $self->to_utf8($encoding,$$textref);
-
-    print $outhandle "  Adding Marc Record:\n",substr($$textref,0,40), " ...\n"
-	if $self->{'verbosity'} > 2;
-
-    # line wrapping
-    $$textref = &wrap_text_in_columns($$textref, 64);
-    $$textref = "<pre>\n" . $$textref . "</pre>\n"; # HTML formatting...
-
-    $doc_obj->add_utf8_text($cursection, $$textref);
-
-    return 1;
-}
-
-sub wrap_text_in_columns
-{
-    my ($text, $columnwidth) = @_;
-    my $newtext = "";
-    my $linelength = 0;
-    
-    # Break the text into words, and display one at a time
-    my @words = split(/ /, $text);
-
-    foreach my $word (@words) {
-	# If printing this word would exceed the column end, start a new line
-	if (($linelength + length($word)) >= $columnwidth) {
-	    $newtext .= "\n";
-	    $linelength = 0;
-	}
-	
-	# Write the word
-	$newtext .= " $word";
-	if ($word =~ /\n/) {
-	    $linelength = 0;
-	} else {
-	    $linelength = $linelength + length(" $word");
-	}
-    }
-
-    $newtext .= "\n";
-    return $newtext;
-}
-
-
-sub extract_metadata 
-{
-    my $self = shift (@_);
-    my ($marc, $metadata, $encoding, $doc_obj, $section) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    if (!defined $marc){
-	return;
-    }
-
-    my $metadata_mapping = $self->{'metadata_mapping'};
-    my $mm;
-
-    foreach $mm ( @$metadata_mapping )
-    {
-	my $marc_field = $mm->{'marc'};
-
-	my @metavalues = $marc->field($marc_field);
-
-	if (scalar(@metavalues)>0)
-	{
-	    my $metaname = $mm->{'gsdl'};
-	    my $metavalue;
-	    foreach $metavalue ( @metavalues )
-	    {
-		my $metavalue_str = $self->to_utf8($encoding,$metavalue->as_string());
-		$doc_obj->add_utf8_metadata ($section, $metaname, $metavalue_str);
-	    }
-	}
-    }
-}
-
-sub extract_ascii_metadata 
-{
-    my $self = shift (@_);
-    my ($text, $metadata,$doc_obj, $section) = @_;
-    my $outhandle = $self->{'outhandle'};
-    my $metadata_mapping = $self->{'metadata_mapping'};
-    ## get fields
-    my @fields = split(/[\n\r]+/,$text);
-    my $marc_mapping ={};
-
-    foreach my $field (@fields){
-	if ($field ne ""){
-	    $field =~ /^(\d\d\d)\s/;
-	    my $code = $1;
-	    $field = $';
-	    ##get subfields
-	    my @subfields = split(/\$/,$field);
-	    my $i=0;
-	    $marc_mapping->{$code} = [];  
-	    foreach my $subfield (@subfields){
-		if ($i == 0){
-		    ##print STDERR $subfield."\n";
-		    push(@{$marc_mapping->{$code}},"info");
-		    push(@{$marc_mapping->{$code}},$subfield);
-		    	 
-		    $i++;
-		} 
-		 else{
-		     $subfield =~ /(\w)\s/;
-		     ##print STDERR "$1=>$'\n";
-		     push(@{$marc_mapping->{$code}},$1);
-                     push(@{$marc_mapping->{$code}},$'); 
-		 }
-	    }
-	}
-    }
-
-
-     foreach my $mm ( @$metadata_mapping )
-    {
-	my $marc_field = $mm->{'marc'};
-		
-	my $matched_field = $marc_mapping->{$marc_field};
- 	my $subfield = undef;
-
-	if (defined $matched_field){
-	    ## test whether this field has subfield
-	    if ($marc_field =~ /\d\d\d(\w)/){
-		$subfield = $1;
-	    }
-	    my $metaname = $mm->{'gsdl'};
- 
-	    my $metavalue;
-	    if (defined $subfield){
-		my %mapped_subfield = {@$matched_field};
-		$metavalue = $mapped_subfield{$subfield};
-	    }
-	    else{ ## get all values except info
-		my $i =0;
-		foreach my $value (@$matched_field){
-		    if ($i%2 != 0 and $i != 1){
-			$metavalue .= $value." ";
-		    }
-		    $i++;
-		}
-	    }
-	    
-	    ## escape [ and ]
-	    $metavalue =~ s/\[/\\\[/g;
-	    $metavalue =~ s/\]/\\\]/g;
-	    ##print STDERR  "$metaname=$metavalue\n";
-   	    $doc_obj->add_metadata ($section, $metaname, $metavalue) ;		 	
-	}
-       
-    }
-
-}
-
-
-1;
Index: /gsdl/trunk/perllib/plugins/MARCPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/MARCPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/MARCPlugin.pm	(revision 15865)
@@ -0,0 +1,453 @@
+###########################################################################
+#
+# MARCPlug.pm -- basic MARC plugin
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 2002 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 MARCPlug;
+
+use SplitPlug;
+
+use unicode;
+use util;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @MARCPlug::ISA = ('SplitPlug');
+    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
+}
+
+my $arguments = 
+    [ { 'name' => "metadata_mapping",
+	'desc' => "{MARCPlug.metadata_mapping}",
+	'type' => "string",
+	'deft' => "marctodc.txt",
+	'hiddengli' => "yes", # deprecated in favour or 'metadata_mapping_file'
+	'reqd' => "no" },
+      { 'name' => "metadata_mapping_file",
+	'desc' => "{MARCXMLPlug.metadata_mapping_file}",
+	'type' => "string",
+	'deft' => "",
+	'reqd' => "no" },
+      { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_process_exp() },
+      { 'name' => "split_exp",
+	'desc' => "{SplitPlug.split_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_split_exp() } 
+      ];
+
+my $options = { 'name'     => "MARCPlug",
+		'desc'     => "{MARCPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'explodes' => "yes",
+		'args'     => $arguments };
+
+require MARC::Record;  
+require MARC::Batch;  
+#use MARC::Record;  
+#use MARC::Batch;
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new SplitPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    # 'metadata_mapping' was used in two ways in the plugin: as a plugin
+    # option (filename) and as a datastructure to represent the mapping.
+    # In MARXXMLPlug (written later) the two are separated: filename is
+    # represented through 'metadata_mapping_file' and the data-structure
+    # mapping left as 'metadata_mapping'
+    # 'metadata_mapping' still present (but hidden in GLI) for
+    # backwards compatibility, but 'metadata_mapping_file' is used by
+    # preference
+
+    if ($self->{'metadata_mapping_file'} eq "") {
+	# If nothing set in the new version, use the old version
+	# that defaults to 'marctodc.txt'
+	$self->{'metadata_mapping_file'} = $self->{'metadata_mapping'};
+    }
+
+    $self->{'type'} = "";
+    
+    return bless $self, $class;
+}
+
+sub init {
+    my $self = shift (@_);
+    my ($verbosity, $outhandle, $failhandle) = @_;
+
+    my @metadata_mapping = ();
+
+    # read in the metadata mapping file
+
+    my $mm_file = &util::locate_config_file($self->{'metadata_mapping_file'}); 
+
+    if (!defined $mm_file)
+    {
+
+	my $msg = "MARCPlug ERROR: Can't locate mapping file \"" .
+	    $self->{'metadata_mapping_file'} . "\".\n" .
+		"    No marc files can be processed.\n";
+
+	print $outhandle $msg;
+	print $failhandle $msg;
+	$self->{'metadata_mapping'} = undef;
+	# We pick up the error in process() if there is no $mm_file
+	# If we exit here, then pluginfo.pl will exit too!
+    }
+    elsif (open(MMIN, "<$mm_file"))
+    {
+	my $l=1;
+	my $line;
+	while (defined($line=<MMIN>))
+	{
+	    chomp $line;
+	    if ($line =~ m/^(\d+)\s*->\s*([\w\^]+)$/)
+	    {
+		my $marc_info = $1;
+		my $gsdl_info = $2;
+		my $mapping = { 'marc' => $marc_info, 'gsdl' => $gsdl_info };
+		push(@metadata_mapping,$mapping);
+	    }
+	    elsif ($line !~ m/^\#/       # allow comments (# in first column)
+		   && $line !~ m/^\s*$/) # allow blank lines
+	    {
+		print $outhandle "Parse error on line $l of $mm_file:\n";
+		print $outhandle "  \"$line\"\n";
+	    }
+	    $l++
+	}
+	close(MMIN);
+
+	$self->{'metadata_mapping'} = \@metadata_mapping;
+    }
+    else
+    {
+	print STDERR "Unable to open $mm_file: $!\n";
+    }
+
+
+
+    $self->SUPER::init(@_);
+}
+    
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)(\.marc)$^;
+}
+
+
+sub get_default_split_exp {
+    # \r\n for msdos eol, \n for unix
+    return q^\r?\n\s*\r?\n|\[\w+\]Record type: USmarc^;
+}
+
+
+
+# The bulk of this function is based on read_line in multiread.pm
+# Unable to use read_line original because it expects to get its input
+# from a file.  Here the line to be converted is passed in as a string
+
+sub to_utf8
+{
+    my $self = shift (@_);
+    my ($encoding, $line) = @_;
+
+    if ($encoding eq "utf8") {
+	# nothing needs to be done
+	return $line;
+    }
+
+    if ($encoding eq "iso_8859_1") {
+	# we'll use ascii2utf8() for this as it's faster than going
+	# through convert2unicode()
+	return &unicode::ascii2utf8 (\$line);
+    }
+
+    # everything else uses unicode::convert2unicode
+    return &unicode::unicode2utf8 (&unicode::convert2unicode ($encoding, \$line));
+}
+
+
+sub read_file {
+    my $self = shift (@_);
+    my ($filename, $encoding, $language, $textref) = @_;
+
+    $self->{'readfile_encoding'}->{$filename} = $encoding;
+
+       
+    if (!-r $filename)
+    {
+	my $outhandle = $self->{'outhandle'};
+	print $outhandle "Read permission denied for $filename\n" if $self->{'verbosity'};
+	return;
+    }
+
+    ##handle ascii marc
+    #test whether this is ascii marc file 
+    if (open (FILE, $filename)) {
+	while (defined (my $line = <FILE>)) {
+	    $$textref .= $line;
+	   if ($line =~ /\[\w+\]Record type:/){
+	       undef $/;
+	       $$textref .= <FILE>;
+	       $/ = "\n";
+	       $self->{'type'} = "ascii";
+	       close FILE;
+	       return;
+	   }
+	}
+	close FILE;	
+    }
+
+      
+    $$textref = "";
+    my @marc_entries = ();
+ 
+    my $batch = new MARC::Batch( 'USMARC', $filename );
+    while ( my $marc = $batch->next ) 
+    {
+      	push(@marc_entries,$marc);
+	$$textref .= $marc->as_formatted();
+	$$textref .= "\n\n"; # for SplitPlug - see default_split_exp above...
+    }
+
+    $self->{'marc_entries'}->{$filename} = \@marc_entries;
+}
+
+
+
+# do plugin specific processing of doc_obj
+# This gets done for each record found by SplitPlug in marc files.
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+    my $filename = &util::filename_cat($base_dir, $file);
+
+    if (! defined($self->{'metadata_mapping'}))
+    {
+	print $outhandle "MARCPlug: no metadata file! Can't process $file\n";
+	return undef;
+    }
+
+    print STDERR "<Processing n='$file' p='MARCPlug'>\n" if ($gli);
+    print $outhandle "MARCPlug: processing $file\n"
+	if $self->{'verbosity'} > 1;
+
+    my $cursection = $doc_obj->get_top_section();
+
+    # Add fileFormat as the metadata
+    $doc_obj->add_metadata($cursection, "FileFormat", "MARC");
+    
+    my $marc_entries = $self->{'marc_entries'}->{$filename};
+    my $marc = shift(@$marc_entries);
+
+    my $encoding = $self->{'readfile_encoding'}->{$filename};
+
+    if ($self->{'type'} ne "ascii" ){   
+       	$self->extract_metadata ($marc, $metadata, $encoding, $doc_obj, $cursection);
+    }
+    else{
+	$self->extract_ascii_metadata ($$textref,$metadata,$doc_obj, $cursection);
+    }
+
+    # add spaces after the sub-field markers, for word boundaries
+    $$textref =~ s/^(.{6} _\w)/$1 /gm;
+
+    # add text to document object
+    $$textref =~ s/</&lt;/g;
+    $$textref =~ s/>/&gt;/g;
+
+    $$textref = $self->to_utf8($encoding,$$textref);
+
+    print $outhandle "  Adding Marc Record:\n",substr($$textref,0,40), " ...\n"
+	if $self->{'verbosity'} > 2;
+
+    # line wrapping
+    $$textref = &wrap_text_in_columns($$textref, 64);
+    $$textref = "<pre>\n" . $$textref . "</pre>\n"; # HTML formatting...
+
+    $doc_obj->add_utf8_text($cursection, $$textref);
+
+    return 1;
+}
+
+sub wrap_text_in_columns
+{
+    my ($text, $columnwidth) = @_;
+    my $newtext = "";
+    my $linelength = 0;
+    
+    # Break the text into words, and display one at a time
+    my @words = split(/ /, $text);
+
+    foreach my $word (@words) {
+	# If printing this word would exceed the column end, start a new line
+	if (($linelength + length($word)) >= $columnwidth) {
+	    $newtext .= "\n";
+	    $linelength = 0;
+	}
+	
+	# Write the word
+	$newtext .= " $word";
+	if ($word =~ /\n/) {
+	    $linelength = 0;
+	} else {
+	    $linelength = $linelength + length(" $word");
+	}
+    }
+
+    $newtext .= "\n";
+    return $newtext;
+}
+
+
+sub extract_metadata 
+{
+    my $self = shift (@_);
+    my ($marc, $metadata, $encoding, $doc_obj, $section) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    if (!defined $marc){
+	return;
+    }
+
+    my $metadata_mapping = $self->{'metadata_mapping'};
+    my $mm;
+
+    foreach $mm ( @$metadata_mapping )
+    {
+	my $marc_field = $mm->{'marc'};
+
+	my @metavalues = $marc->field($marc_field);
+
+	if (scalar(@metavalues)>0)
+	{
+	    my $metaname = $mm->{'gsdl'};
+	    my $metavalue;
+	    foreach $metavalue ( @metavalues )
+	    {
+		my $metavalue_str = $self->to_utf8($encoding,$metavalue->as_string());
+		$doc_obj->add_utf8_metadata ($section, $metaname, $metavalue_str);
+	    }
+	}
+    }
+}
+
+sub extract_ascii_metadata 
+{
+    my $self = shift (@_);
+    my ($text, $metadata,$doc_obj, $section) = @_;
+    my $outhandle = $self->{'outhandle'};
+    my $metadata_mapping = $self->{'metadata_mapping'};
+    ## get fields
+    my @fields = split(/[\n\r]+/,$text);
+    my $marc_mapping ={};
+
+    foreach my $field (@fields){
+	if ($field ne ""){
+	    $field =~ /^(\d\d\d)\s/;
+	    my $code = $1;
+	    $field = $';
+	    ##get subfields
+	    my @subfields = split(/\$/,$field);
+	    my $i=0;
+	    $marc_mapping->{$code} = [];  
+	    foreach my $subfield (@subfields){
+		if ($i == 0){
+		    ##print STDERR $subfield."\n";
+		    push(@{$marc_mapping->{$code}},"info");
+		    push(@{$marc_mapping->{$code}},$subfield);
+		    	 
+		    $i++;
+		} 
+		 else{
+		     $subfield =~ /(\w)\s/;
+		     ##print STDERR "$1=>$'\n";
+		     push(@{$marc_mapping->{$code}},$1);
+                     push(@{$marc_mapping->{$code}},$'); 
+		 }
+	    }
+	}
+    }
+
+
+     foreach my $mm ( @$metadata_mapping )
+    {
+	my $marc_field = $mm->{'marc'};
+		
+	my $matched_field = $marc_mapping->{$marc_field};
+ 	my $subfield = undef;
+
+	if (defined $matched_field){
+	    ## test whether this field has subfield
+	    if ($marc_field =~ /\d\d\d(\w)/){
+		$subfield = $1;
+	    }
+	    my $metaname = $mm->{'gsdl'};
+ 
+	    my $metavalue;
+	    if (defined $subfield){
+		my %mapped_subfield = {@$matched_field};
+		$metavalue = $mapped_subfield{$subfield};
+	    }
+	    else{ ## get all values except info
+		my $i =0;
+		foreach my $value (@$matched_field){
+		    if ($i%2 != 0 and $i != 1){
+			$metavalue .= $value." ";
+		    }
+		    $i++;
+		}
+	    }
+	    
+	    ## escape [ and ]
+	    $metavalue =~ s/\[/\\\[/g;
+	    $metavalue =~ s/\]/\\\]/g;
+	    ##print STDERR  "$metaname=$metavalue\n";
+   	    $doc_obj->add_metadata ($section, $metaname, $metavalue) ;		 	
+	}
+       
+    }
+
+}
+
+
+1;
Index: dl/trunk/perllib/plugins/MARCXMLPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/MARCXMLPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,591 +1,0 @@
-###########################################################################
-#
-# MARCXMLPlug.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 MARCXML documents. Note that this plugin does no
-# syntax checking (though the XML::Parser module tests for
-# well-formedness).
-
-package MARCXMLPlug;
-
-use XMLPlug;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @MARCXMLPlug::ISA = ('XMLPlug');
-}
-
-my $arguments = [{'name' => "metadata_mapping_file",
-		  'desc' => "{MARCXMLPlug.metadata_mapping_file}",
-		  'type' => "string",
-		  'deft' => "marctodc.txt",
-		  'reqd' => "no" }];
-
-my $options = { 'name'     => "MARCXMLPlug",
-		'desc'     => "{MARCXMLPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments 
-		};
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-    
-    my $self = new XMLPlug($pluginlist, $inputargs, $hashArgOptLists);
-    
-    $self->{'content'} = "";
-    $self->{'xmlcontent'} = "";
-    $self->{'record_count'} = 1;
-    $self->{'language'} = "";
-    $self->{'encoding'} = "";
-    $self->{'marc_mapping'} = {};
-    $self->{'current_code'} = "";
-    $self->{'current_tag'} = "";
-    $self->{'current_element'} = "";
-    $self->{'metadata_mapping'} = undef;
-    $self->{'num_processed'} = 0;
-    $self->{'indent'} = 0;
-
-    return bless $self, $class;
-}
-
-sub get_doctype {
-    my $self = shift(@_);
-    
-    return "collection";
-}
-
-
-sub _parse_marc_metadata_mapping
-{
-    my $self = shift(@_);
-    my ($mm_file,$metadata_mapping) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-
-    if (open(MMIN, "<$mm_file"))
-    {
-	my $l=0;
-	my $line;
-	while (defined($line=<MMIN>))
-	{
-	    $l++;
-	    chomp $line;
-	    $line =~ s/#.*$//; # strip out any comments, including end of line
-	    next if ($line =~ m/^\s*$/); 
-	    $line =~ s/\s+$//; # remove any white space at end of line
-
-	    my $parse_error_count = 0;
-	    if ($line =~ m/^-(\d+)\s*$/) {
-		# special "remove" rule syntax
-		my $marc_info = $1;
-		if (defined $metadata_mapping->{$marc_info}) {
-		    delete $metadata_mapping->{$marc_info};
-		}
-		else {
-		    print $outhandle "Parse Warning: Did not file pre-existing rule $marc_info to remove";
-		    print $outhandle " on line $l of $mm_file:\n";
-		    print $outhandle "  $line\n";
-		}
-	    }
-	    elsif ($line =~ m/^(.*?)->\s*([\w\^]+)$/)
-	    {
-		my $lhs = $1;
-		my $gsdl_info = $2;
-
-		my @fields = split(/,\s*/,$lhs);
-		my $f;
-		while ($f  = shift (@fields)) {
-		    $f =~ s/\s+$//; # remove any white space at end of line
-
-		    if ($f =~ m/^(\d+)\-(\d+)$/) {
-			# number range => genrate number in range and
-			# push on to array
-			push(@fields,$1..$2);
-			next;
-		    }
-
-		    if ($f =~ m/^(\d+)((?:(?:\$|\^)\w)*)\s*$/) {
-
-			my $marc_info = $1;
-			my $opt_sub_fields = $2;
-
-			if ($opt_sub_fields ne "") {			
-			    my @sub_fields = split(/\$|\^/,$opt_sub_fields);
-			    shift @sub_fields; # skip first entry, which is blank
-
-			    foreach my $sub_field (@sub_fields) {
-				$metadata_mapping->{$marc_info."\$".$sub_field} = $gsdl_info;
-			    }
-			}
-			else {
-			    # no subfields to worry about
-			    $marc_info =~ s/\^/\$/;
-			    $metadata_mapping->{$marc_info} = $gsdl_info;
-			}
-		    }
-		    else {
-			$parse_error_count++;
-		    }
-		}
-	    }
-	    else
-	    {
-		$parse_error_count++;
-	    }
-
-	    if ($parse_error_count>0) {
-		
-		print $outhandle "Parse Error: $parse_error_count syntax error(s) on line $l of $mm_file:\n";
-		print $outhandle "  $line\n";
-	    }
-	}
-	close(MMIN);
-    }
-    else
-    {
-	print STDERR "Unable to open $mm_file: $!\n";
-    }
-}
-
-
-sub parse_marc_metadata_mapping
-{
-    my $self = shift(@_);
-    my ($mm_file_or_files) = @_;
-
-    my $metadata_mapping = {};
-
-    if (ref ($mm_file_or_files) eq 'SCALAR') {
-	my $mm_file = $mm_file_or_files;
-	$self->_parse_marc_metadata_mapping($mm_file,$metadata_mapping);
-    }
-    else {
-	my $mm_files = $mm_file_or_files;
-	
-	# Need to process files in reverse order.  This is so in the
-	# case where we have both a "collect" and "main" version,
-	# the "collect" one tops up the main one
-
-	my $mm_file;
-	while ($mm_file = pop(@$mm_files)) {
-	    $self->_parse_marc_metadata_mapping($mm_file,$metadata_mapping);
-	}
-    }
-
-    return $metadata_mapping;
-}
-
-
-sub init {
-    my $self = shift (@_);
-    my ($verbosity, $outhandle, $failhandle) = @_;
-    
-    ## the mapping file has already been loaded
-    if (defined $self->{'metadata_mapping'} ){ 
-	$self->SUPER::init(@_);
-	return;
-    }
-
-    # read in the metadata mapping file
-    my $mm_files = &util::locate_config_files($self->{'metadata_mapping_file'}); 
-
-
-    if (scalar(@$mm_files)==0)
-    {
-	my $msg = "MARCXMLPlug ERROR: Can't locate mapping file \"" .
-	    $self->{'metadata_mapping_file'} . "\".\n " .
-		"    No marc files can be processed.\n";
-
-	print $outhandle $msg;
-	print $failhandle $msg;
-	$self->{'metadata_mapping'} = undef;
-	# We pick up the error in process() if there is no $mm_file
-	# If we exit here, then pluginfo.pl will exit too!
-    }
-    else {
-	$self->{'metadata_mapping'} = $self->parse_marc_metadata_mapping($mm_files);
-    }
-
-
-    ##map { print STDERR $_."=>".$metadata_mapping->{$_}."\n"; } keys %$metadata_mapping;
-
-    $self->SUPER::init(@_);
-}
-
-# Called for DOCTYPE declarations - use die to bail out if this doctype
-# is not meant for this plugin
-sub xml_doctype {
-    my $self = shift(@_);
-
-    my ($expat, $name, $sysid, $pubid, $internal) = @_;
-   return;
-
-}
-
-
-sub xml_start_document {
-    my $self = shift(@_);
-
-    my ($expat, $name, $sysid, $pubid, $internal) = @_;
-
-      
-    my $file = $self->{'file'};
-    my $filename = $self->{'filename'};
-       
-    my ($language, $encoding) = $self->textcat_get_language_encoding ($filename);
-
-    $self->{'language'} = $language;
-    $self->{'encoding'} = $encoding;
-    $self->{'element_count'} = 1;
-    $self->{'indent'} = 0;
-    my $outhandle = $self->{'outhandle'};
-    print $outhandle "MARCXMLPlug: processing $self->{'file'}\n" if $self->{'verbosity'} > 1;
-    print STDERR "<Processing n='$self->{'file'}' p='MARCXMLPlug'>\n" if $self->{'gli'};
- 
-}
-
-sub xml_end_document {
-
-}
-
-sub xml_start_tag {
-    my $self = shift;
-    my $expat = shift;
-    my $element = shift;  
-
-    my $text = $_;
-    my $escaped_text =  $self->escape_text($_); 
-  
-    $self->{'current_element'} = $element;
-
-    ##get all atributes of this element and store it in a map name=>value    
-    my %attr_map = (); 
-    my $attrstring = $_;
-    while ($attrstring =~ /(\w+)=\"(\w+)\"/){
-	$attr_map{$1}=$2;
-	$attrstring = $'; #'
-    }
-
-
-    my $processor = $self->{'processor'};
-  
-    ##create a new document for each record 
-    if ($element eq "record") {
-        my $filename = $self->{'filename'};
-	my $language = $self->{'language'};
-        my $encoding = $self->{'encoding'};
-	my $file = $self->{'file'};
-	my $doc_obj = new doc($filename);
-	$doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
-	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Language", $language);
-	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Encoding", $encoding);
-	my ($filemeta) = $file =~ /([^\\\/]+)$/;
-	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Source", &ghtml::dmsafe($filemeta));
-	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "SourceSegment", "$self->{'record_count'}");
-        if ($self->{'cover_image'}) {
-	    $self->associate_cover_image($doc_obj, $filename);
-	}
-	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
-	$doc_obj->add_metadata($doc_obj->get_top_section(), "FileFormat", "XML");
-
-	my $outhandle = $self->{'outhandle'};
-	print $outhandle "Record $self->{'record_count'} - MARCXMLPlug: processing $self->{'file'}\n" if $self->{'verbosity'} > 1;
-
-        $self->{'record_count'}++;
-        $self->{'doc_obj'} = $doc_obj;       
-	$self->{'num_processed'}++;
-
-    }
-    
-    ## get the marc code, for example 520
-     if ($element eq "datafield") {
-    	 if (defined $attr_map{'tag'} and $attr_map{'tag'} ne ""){
-	     $self->{'current_tag'} = $attr_map{tag};  
-	 }
-     }
-
-
-    ## append the subcode to the marc code for example 520a or 520b 
-    if ($element eq "subfield"){
-   	if (defined $attr_map{'code'} and $attr_map{'code'} ne "" and $self->{'current_tag'} ne ""){
-	    $self->{'current_code'} = $attr_map{'code'};
-	}
-    }
-
-   if ($element eq "record"){
-        $self->{'indent'} = 0;
-        $self->{'content'} = "";
-        $self->{'xmlcontent'} = "";
-    }
-    else {
-         if ($element ne "subfield"){
-              $self->{'indent'} = 1;
-         }
-         else{
-           $self->{'indent'} = 2;
-         }
-    }
-    
-
-    if ($element eq "collection") {
-	# remember the full start tag for <collection ...>
-	# This is needed to wrap around each <record> when generating its associate MARCXML file
-
-        $self->{'xmlcollectiontag'} = $text;
-    }
-    else {
-        $self->{'content'} .= "<br/>" if ($element ne "record");
-        $self->{'content'} .= $self->calculate_indent($self->{'indent'}).$escaped_text;
-        $self->{'xmlcontent'} .= $text;
-   }
-    
-}
-
-
-
-sub xml_end_tag {
-    my $self = shift(@_);
-    my ($expat, $element) = @_;
-
-    my $text = $_;
-    my $escaped_text =  $self->escape_text($_); 
- 
-    if ($element eq "record" and defined $self->{'doc_obj'}) {
-	# process the document
-	my $processor = $self->{'processor'};
-	my $doc_obj = $self->{'doc_obj'};
-        $self->{'content'} .= "<br/>".$escaped_text;
-        $self->{'xmlcontent'} .= $text;
-      
-
-	my $top_section = $doc_obj->get_top_section();
-
-	my $tmp_marcxml_filename = &util::get_tmp_filename().".xml";
-	if (open (XMLOUT,">$tmp_marcxml_filename")) {
-
-	    print XMLOUT "<?xml-stylesheet type=\"text/xsl\" href=\"MARC21slim2English.xsl\"?>\n";	    
-	    my $xml_content = $self->{'xmlcontent'};
-
-	    $xml_content = $self->{'xmlcollectiontag'}.$xml_content."</collection>";
-
-	    print XMLOUT $xml_content;
-
-	    close(XMLOUT);
-
-	    $doc_obj->associate_file($tmp_marcxml_filename,"marcxml.xml","text/xml", $top_section);
-	    
-	    # assicate xsl style file for presentation as HTML
-	    my $xsl_filename = &util::filename_cat($ENV{'GSDLHOME'},"etc","MARC21slim2English.xsl");
-	    $doc_obj->associate_file($xsl_filename,"MARC21slim2English.xsl","text/xml", $top_section);
-
-	}
-	else {
-	    my $outhandle = $self->{'outhandle'};
-	    print $outhandle "Warning: Unable for write out associated MARCXML file $tmp_marcxml_filename\n";
-	}
-	
-	# include any metadata passed in from previous plugins 
-	# note that this metadata is associated with the top level section
-	
-	$self->extra_metadata ($doc_obj, 
-			       $doc_obj->get_top_section(), 
-			       $self->{'metadata'});
-	
-
-	$self->add_OID($doc_obj,  $self->{'record_count'});
-
-	$doc_obj->add_utf8_text($doc_obj->get_top_section(),$self->{'content'});
-        $processor->process($doc_obj);
-
-        ##clean up
-	$self->{'content'} = "";  
-	$self->{'xmlcontent'} = "";  
-	$self->{'doc_obj'} = undef;
-        return;
-    }
-
-    ## map the xmlmarc to gsdl metadata
-    if ($element eq "datafield" and defined $self->{'doc_obj'} and defined $self->{'marc_mapping'}){
-	my $metadata_mapping = $self->{'metadata_mapping'};
-	my $marc_mapping = $self->{'marc_mapping'};
-	my $doc_obj = $self->{'doc_obj'};
-
-##	print STDERR "**** Marc Record\n";
-##      map { print STDERR $_."=>".$marc_mapping->{$_}."\n"; } keys %$marc_mapping;
-##	print STDERR "**** Metadata Mapping\n";
-##      map { print STDERR $_."=>".$metadata_mapping->{$_}."\n"; } keys %$metadata_mapping;
-
-
-	foreach my $marc_field (keys %$metadata_mapping){
-
-	    ## test whether this field has subfield
-	    my $subfield = undef;
-	    if ($marc_field =~ /(\d\d\d)(?:\$|\^)?(\w)/){
-		$marc_field = $1;
-		$subfield = $2;
-	    }
-
-	    my $matched_field = $marc_mapping->{$marc_field}; 
-
-	    if (defined $matched_field) {
-
-		my $meta_name  = undef;
-		my $meta_value = undef;
-
-		if (defined $subfield){
-		    $meta_name = $metadata_mapping->{$marc_field."\$".$subfield};
-
-		    $meta_value = $matched_field->{$subfield};
-		    
-		    if (!defined $meta_value) {
-			# record read in does not have the specified subfield
-			next;
-		    }
-		}
-		else {
-		    $meta_name = $metadata_mapping->{$marc_field};
-		    
-		    # no subfield => get all the values
-		    foreach my $value (sort keys %{$matched_field}) {
-			$meta_value .= $matched_field->{$value} ." ";
-		    }
-
-		}
-		
-		## escape [ and ]
-		$meta_value =~ s/\[/\\\[/g;
-		$meta_value =~ s/\]/\\\]/g;
-		##print STDERR  "$meta_name=$meta_value\n";
-		$doc_obj->add_utf8_metadata($doc_obj->get_top_section(),$meta_name, $meta_value);
-		
-	    }		    
-			
-	}
-
-	##clean up
-	$self->{'marc_mapping'} = undef;
-	$self->{'current_tag'} = "";
-    }
-  
-   if ($element eq "datafield"){
-       $self->{'indent'} = 1;
-       $self->{'content'} .= "<br/>".$self->calculate_indent($self->{'indent'}).$escaped_text;
-       $self->{'xmlcontent'} .= $text;
-   }
-    else{
-	$self->{'content'} .= $escaped_text;   
-	$self->{'xmlcontent'} .= $text;   
-    }
-     
-}
-
-
-sub set_OID {
-    my $self = shift (@_);
-    my ($doc_obj, $record_number) = @_;
-    
-    # first set it to generate hash value
-    $doc_obj->set_OID(); 
-
-    # then top it up with an "r" + record-number suffix
-    my $id = $doc_obj->get_OID();
-    $doc_obj->set_OID($id . "r" . $record_number);
-}
-
-sub xml_text {
-    my $self = shift(@_);
-    my ($expat) = @_;
-
-    my $text = $_;
-    my $escaped_text = $self->escape_text($_);
-
-    # protect against & in raw text file
-    $text =~ s/&/&amp;/g; # can't have & in raw form, even in 'raw' xml text
-
-    ## store the text of a marc code, for exapmle 520a=>A poem about....
-    if ($self->{'current_element'} eq "subfield" and $self->{'current_code'} ne "" and $_ ne "" ){
-	##stored it in the marc_mapping 
-
-	my $current_tag  = $self->{'current_tag'};
-	my $current_code = $self->{'current_code'};
-
-     	$self->{'marc_mapping'}->{$current_tag}->{$current_code} .= $_;
-
-	$self->{'current_code'} = "";
-    }
-    
-    $self->{'content'} .= $escaped_text;
-    $self->{'xmlcontent'} .= $text;
-   
-}
-
-sub calculate_indent{
-   my ($self,$num) = @_;
-
-   my $indent ="";
-  
-   for (my $i=0; $i<$num;$i++){
-       $indent .= "&nbsp;&nbsp;&nbsp;&nbsp;";
-    } 
- 
-   return $indent;
-
-}
-
-sub escape_text {
-    my ($self,$text) = @_;
-    # special characters in the xml encoding
-    $text =~ s/&/&amp;/g; # this has to be first...
-    $text =~ s/</&lt;/g;
-    $text =~ s/>/&gt;/g;
-    $text =~ s/\"/&quot;/g;
-
-    return $text;
-}
-
-
-sub unescape_text {
-    my ($self,$text) = @_;
-    # special characters in the xml encoding
-    $text =~ s/&lt;/</g;
-    $text =~ s/&gt;/>/g;
-    $text =~ s/&quot;/\"/g;
-
-    $text =~ s/&/&amp;/g; # can't have & in raw form, even in unescaped xml!
-
-    return $text;
-}
-
-
-1;
-
-
Index: /gsdl/trunk/perllib/plugins/MARCXMLPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/MARCXMLPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/MARCXMLPlugin.pm	(revision 15865)
@@ -0,0 +1,591 @@
+###########################################################################
+#
+# MARCXMLPlug.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 MARCXML documents. Note that this plugin does no
+# syntax checking (though the XML::Parser module tests for
+# well-formedness).
+
+package MARCXMLPlug;
+
+use XMLPlug;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @MARCXMLPlug::ISA = ('XMLPlug');
+}
+
+my $arguments = [{'name' => "metadata_mapping_file",
+		  'desc' => "{MARCXMLPlug.metadata_mapping_file}",
+		  'type' => "string",
+		  'deft' => "marctodc.txt",
+		  'reqd' => "no" }];
+
+my $options = { 'name'     => "MARCXMLPlug",
+		'desc'     => "{MARCXMLPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments 
+		};
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+    
+    my $self = new XMLPlug($pluginlist, $inputargs, $hashArgOptLists);
+    
+    $self->{'content'} = "";
+    $self->{'xmlcontent'} = "";
+    $self->{'record_count'} = 1;
+    $self->{'language'} = "";
+    $self->{'encoding'} = "";
+    $self->{'marc_mapping'} = {};
+    $self->{'current_code'} = "";
+    $self->{'current_tag'} = "";
+    $self->{'current_element'} = "";
+    $self->{'metadata_mapping'} = undef;
+    $self->{'num_processed'} = 0;
+    $self->{'indent'} = 0;
+
+    return bless $self, $class;
+}
+
+sub get_doctype {
+    my $self = shift(@_);
+    
+    return "collection";
+}
+
+
+sub _parse_marc_metadata_mapping
+{
+    my $self = shift(@_);
+    my ($mm_file,$metadata_mapping) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+
+    if (open(MMIN, "<$mm_file"))
+    {
+	my $l=0;
+	my $line;
+	while (defined($line=<MMIN>))
+	{
+	    $l++;
+	    chomp $line;
+	    $line =~ s/#.*$//; # strip out any comments, including end of line
+	    next if ($line =~ m/^\s*$/); 
+	    $line =~ s/\s+$//; # remove any white space at end of line
+
+	    my $parse_error_count = 0;
+	    if ($line =~ m/^-(\d+)\s*$/) {
+		# special "remove" rule syntax
+		my $marc_info = $1;
+		if (defined $metadata_mapping->{$marc_info}) {
+		    delete $metadata_mapping->{$marc_info};
+		}
+		else {
+		    print $outhandle "Parse Warning: Did not file pre-existing rule $marc_info to remove";
+		    print $outhandle " on line $l of $mm_file:\n";
+		    print $outhandle "  $line\n";
+		}
+	    }
+	    elsif ($line =~ m/^(.*?)->\s*([\w\^]+)$/)
+	    {
+		my $lhs = $1;
+		my $gsdl_info = $2;
+
+		my @fields = split(/,\s*/,$lhs);
+		my $f;
+		while ($f  = shift (@fields)) {
+		    $f =~ s/\s+$//; # remove any white space at end of line
+
+		    if ($f =~ m/^(\d+)\-(\d+)$/) {
+			# number range => genrate number in range and
+			# push on to array
+			push(@fields,$1..$2);
+			next;
+		    }
+
+		    if ($f =~ m/^(\d+)((?:(?:\$|\^)\w)*)\s*$/) {
+
+			my $marc_info = $1;
+			my $opt_sub_fields = $2;
+
+			if ($opt_sub_fields ne "") {			
+			    my @sub_fields = split(/\$|\^/,$opt_sub_fields);
+			    shift @sub_fields; # skip first entry, which is blank
+
+			    foreach my $sub_field (@sub_fields) {
+				$metadata_mapping->{$marc_info."\$".$sub_field} = $gsdl_info;
+			    }
+			}
+			else {
+			    # no subfields to worry about
+			    $marc_info =~ s/\^/\$/;
+			    $metadata_mapping->{$marc_info} = $gsdl_info;
+			}
+		    }
+		    else {
+			$parse_error_count++;
+		    }
+		}
+	    }
+	    else
+	    {
+		$parse_error_count++;
+	    }
+
+	    if ($parse_error_count>0) {
+		
+		print $outhandle "Parse Error: $parse_error_count syntax error(s) on line $l of $mm_file:\n";
+		print $outhandle "  $line\n";
+	    }
+	}
+	close(MMIN);
+    }
+    else
+    {
+	print STDERR "Unable to open $mm_file: $!\n";
+    }
+}
+
+
+sub parse_marc_metadata_mapping
+{
+    my $self = shift(@_);
+    my ($mm_file_or_files) = @_;
+
+    my $metadata_mapping = {};
+
+    if (ref ($mm_file_or_files) eq 'SCALAR') {
+	my $mm_file = $mm_file_or_files;
+	$self->_parse_marc_metadata_mapping($mm_file,$metadata_mapping);
+    }
+    else {
+	my $mm_files = $mm_file_or_files;
+	
+	# Need to process files in reverse order.  This is so in the
+	# case where we have both a "collect" and "main" version,
+	# the "collect" one tops up the main one
+
+	my $mm_file;
+	while ($mm_file = pop(@$mm_files)) {
+	    $self->_parse_marc_metadata_mapping($mm_file,$metadata_mapping);
+	}
+    }
+
+    return $metadata_mapping;
+}
+
+
+sub init {
+    my $self = shift (@_);
+    my ($verbosity, $outhandle, $failhandle) = @_;
+    
+    ## the mapping file has already been loaded
+    if (defined $self->{'metadata_mapping'} ){ 
+	$self->SUPER::init(@_);
+	return;
+    }
+
+    # read in the metadata mapping file
+    my $mm_files = &util::locate_config_files($self->{'metadata_mapping_file'}); 
+
+
+    if (scalar(@$mm_files)==0)
+    {
+	my $msg = "MARCXMLPlug ERROR: Can't locate mapping file \"" .
+	    $self->{'metadata_mapping_file'} . "\".\n " .
+		"    No marc files can be processed.\n";
+
+	print $outhandle $msg;
+	print $failhandle $msg;
+	$self->{'metadata_mapping'} = undef;
+	# We pick up the error in process() if there is no $mm_file
+	# If we exit here, then pluginfo.pl will exit too!
+    }
+    else {
+	$self->{'metadata_mapping'} = $self->parse_marc_metadata_mapping($mm_files);
+    }
+
+
+    ##map { print STDERR $_."=>".$metadata_mapping->{$_}."\n"; } keys %$metadata_mapping;
+
+    $self->SUPER::init(@_);
+}
+
+# Called for DOCTYPE declarations - use die to bail out if this doctype
+# is not meant for this plugin
+sub xml_doctype {
+    my $self = shift(@_);
+
+    my ($expat, $name, $sysid, $pubid, $internal) = @_;
+   return;
+
+}
+
+
+sub xml_start_document {
+    my $self = shift(@_);
+
+    my ($expat, $name, $sysid, $pubid, $internal) = @_;
+
+      
+    my $file = $self->{'file'};
+    my $filename = $self->{'filename'};
+       
+    my ($language, $encoding) = $self->textcat_get_language_encoding ($filename);
+
+    $self->{'language'} = $language;
+    $self->{'encoding'} = $encoding;
+    $self->{'element_count'} = 1;
+    $self->{'indent'} = 0;
+    my $outhandle = $self->{'outhandle'};
+    print $outhandle "MARCXMLPlug: processing $self->{'file'}\n" if $self->{'verbosity'} > 1;
+    print STDERR "<Processing n='$self->{'file'}' p='MARCXMLPlug'>\n" if $self->{'gli'};
+ 
+}
+
+sub xml_end_document {
+
+}
+
+sub xml_start_tag {
+    my $self = shift;
+    my $expat = shift;
+    my $element = shift;  
+
+    my $text = $_;
+    my $escaped_text =  $self->escape_text($_); 
+  
+    $self->{'current_element'} = $element;
+
+    ##get all atributes of this element and store it in a map name=>value    
+    my %attr_map = (); 
+    my $attrstring = $_;
+    while ($attrstring =~ /(\w+)=\"(\w+)\"/){
+	$attr_map{$1}=$2;
+	$attrstring = $'; #'
+    }
+
+
+    my $processor = $self->{'processor'};
+  
+    ##create a new document for each record 
+    if ($element eq "record") {
+        my $filename = $self->{'filename'};
+	my $language = $self->{'language'};
+        my $encoding = $self->{'encoding'};
+	my $file = $self->{'file'};
+	my $doc_obj = new doc($filename);
+	$doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
+	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Language", $language);
+	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Encoding", $encoding);
+	my ($filemeta) = $file =~ /([^\\\/]+)$/;
+	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Source", &ghtml::dmsafe($filemeta));
+	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "SourceSegment", "$self->{'record_count'}");
+        if ($self->{'cover_image'}) {
+	    $self->associate_cover_image($doc_obj, $filename);
+	}
+	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
+	$doc_obj->add_metadata($doc_obj->get_top_section(), "FileFormat", "XML");
+
+	my $outhandle = $self->{'outhandle'};
+	print $outhandle "Record $self->{'record_count'} - MARCXMLPlug: processing $self->{'file'}\n" if $self->{'verbosity'} > 1;
+
+        $self->{'record_count'}++;
+        $self->{'doc_obj'} = $doc_obj;       
+	$self->{'num_processed'}++;
+
+    }
+    
+    ## get the marc code, for example 520
+     if ($element eq "datafield") {
+    	 if (defined $attr_map{'tag'} and $attr_map{'tag'} ne ""){
+	     $self->{'current_tag'} = $attr_map{tag};  
+	 }
+     }
+
+
+    ## append the subcode to the marc code for example 520a or 520b 
+    if ($element eq "subfield"){
+   	if (defined $attr_map{'code'} and $attr_map{'code'} ne "" and $self->{'current_tag'} ne ""){
+	    $self->{'current_code'} = $attr_map{'code'};
+	}
+    }
+
+   if ($element eq "record"){
+        $self->{'indent'} = 0;
+        $self->{'content'} = "";
+        $self->{'xmlcontent'} = "";
+    }
+    else {
+         if ($element ne "subfield"){
+              $self->{'indent'} = 1;
+         }
+         else{
+           $self->{'indent'} = 2;
+         }
+    }
+    
+
+    if ($element eq "collection") {
+	# remember the full start tag for <collection ...>
+	# This is needed to wrap around each <record> when generating its associate MARCXML file
+
+        $self->{'xmlcollectiontag'} = $text;
+    }
+    else {
+        $self->{'content'} .= "<br/>" if ($element ne "record");
+        $self->{'content'} .= $self->calculate_indent($self->{'indent'}).$escaped_text;
+        $self->{'xmlcontent'} .= $text;
+   }
+    
+}
+
+
+
+sub xml_end_tag {
+    my $self = shift(@_);
+    my ($expat, $element) = @_;
+
+    my $text = $_;
+    my $escaped_text =  $self->escape_text($_); 
+ 
+    if ($element eq "record" and defined $self->{'doc_obj'}) {
+	# process the document
+	my $processor = $self->{'processor'};
+	my $doc_obj = $self->{'doc_obj'};
+        $self->{'content'} .= "<br/>".$escaped_text;
+        $self->{'xmlcontent'} .= $text;
+      
+
+	my $top_section = $doc_obj->get_top_section();
+
+	my $tmp_marcxml_filename = &util::get_tmp_filename().".xml";
+	if (open (XMLOUT,">$tmp_marcxml_filename")) {
+
+	    print XMLOUT "<?xml-stylesheet type=\"text/xsl\" href=\"MARC21slim2English.xsl\"?>\n";	    
+	    my $xml_content = $self->{'xmlcontent'};
+
+	    $xml_content = $self->{'xmlcollectiontag'}.$xml_content."</collection>";
+
+	    print XMLOUT $xml_content;
+
+	    close(XMLOUT);
+
+	    $doc_obj->associate_file($tmp_marcxml_filename,"marcxml.xml","text/xml", $top_section);
+	    
+	    # assicate xsl style file for presentation as HTML
+	    my $xsl_filename = &util::filename_cat($ENV{'GSDLHOME'},"etc","MARC21slim2English.xsl");
+	    $doc_obj->associate_file($xsl_filename,"MARC21slim2English.xsl","text/xml", $top_section);
+
+	}
+	else {
+	    my $outhandle = $self->{'outhandle'};
+	    print $outhandle "Warning: Unable for write out associated MARCXML file $tmp_marcxml_filename\n";
+	}
+	
+	# include any metadata passed in from previous plugins 
+	# note that this metadata is associated with the top level section
+	
+	$self->extra_metadata ($doc_obj, 
+			       $doc_obj->get_top_section(), 
+			       $self->{'metadata'});
+	
+
+	$self->add_OID($doc_obj,  $self->{'record_count'});
+
+	$doc_obj->add_utf8_text($doc_obj->get_top_section(),$self->{'content'});
+        $processor->process($doc_obj);
+
+        ##clean up
+	$self->{'content'} = "";  
+	$self->{'xmlcontent'} = "";  
+	$self->{'doc_obj'} = undef;
+        return;
+    }
+
+    ## map the xmlmarc to gsdl metadata
+    if ($element eq "datafield" and defined $self->{'doc_obj'} and defined $self->{'marc_mapping'}){
+	my $metadata_mapping = $self->{'metadata_mapping'};
+	my $marc_mapping = $self->{'marc_mapping'};
+	my $doc_obj = $self->{'doc_obj'};
+
+##	print STDERR "**** Marc Record\n";
+##      map { print STDERR $_."=>".$marc_mapping->{$_}."\n"; } keys %$marc_mapping;
+##	print STDERR "**** Metadata Mapping\n";
+##      map { print STDERR $_."=>".$metadata_mapping->{$_}."\n"; } keys %$metadata_mapping;
+
+
+	foreach my $marc_field (keys %$metadata_mapping){
+
+	    ## test whether this field has subfield
+	    my $subfield = undef;
+	    if ($marc_field =~ /(\d\d\d)(?:\$|\^)?(\w)/){
+		$marc_field = $1;
+		$subfield = $2;
+	    }
+
+	    my $matched_field = $marc_mapping->{$marc_field}; 
+
+	    if (defined $matched_field) {
+
+		my $meta_name  = undef;
+		my $meta_value = undef;
+
+		if (defined $subfield){
+		    $meta_name = $metadata_mapping->{$marc_field."\$".$subfield};
+
+		    $meta_value = $matched_field->{$subfield};
+		    
+		    if (!defined $meta_value) {
+			# record read in does not have the specified subfield
+			next;
+		    }
+		}
+		else {
+		    $meta_name = $metadata_mapping->{$marc_field};
+		    
+		    # no subfield => get all the values
+		    foreach my $value (sort keys %{$matched_field}) {
+			$meta_value .= $matched_field->{$value} ." ";
+		    }
+
+		}
+		
+		## escape [ and ]
+		$meta_value =~ s/\[/\\\[/g;
+		$meta_value =~ s/\]/\\\]/g;
+		##print STDERR  "$meta_name=$meta_value\n";
+		$doc_obj->add_utf8_metadata($doc_obj->get_top_section(),$meta_name, $meta_value);
+		
+	    }		    
+			
+	}
+
+	##clean up
+	$self->{'marc_mapping'} = undef;
+	$self->{'current_tag'} = "";
+    }
+  
+   if ($element eq "datafield"){
+       $self->{'indent'} = 1;
+       $self->{'content'} .= "<br/>".$self->calculate_indent($self->{'indent'}).$escaped_text;
+       $self->{'xmlcontent'} .= $text;
+   }
+    else{
+	$self->{'content'} .= $escaped_text;   
+	$self->{'xmlcontent'} .= $text;   
+    }
+     
+}
+
+
+sub set_OID {
+    my $self = shift (@_);
+    my ($doc_obj, $record_number) = @_;
+    
+    # first set it to generate hash value
+    $doc_obj->set_OID(); 
+
+    # then top it up with an "r" + record-number suffix
+    my $id = $doc_obj->get_OID();
+    $doc_obj->set_OID($id . "r" . $record_number);
+}
+
+sub xml_text {
+    my $self = shift(@_);
+    my ($expat) = @_;
+
+    my $text = $_;
+    my $escaped_text = $self->escape_text($_);
+
+    # protect against & in raw text file
+    $text =~ s/&/&amp;/g; # can't have & in raw form, even in 'raw' xml text
+
+    ## store the text of a marc code, for exapmle 520a=>A poem about....
+    if ($self->{'current_element'} eq "subfield" and $self->{'current_code'} ne "" and $_ ne "" ){
+	##stored it in the marc_mapping 
+
+	my $current_tag  = $self->{'current_tag'};
+	my $current_code = $self->{'current_code'};
+
+     	$self->{'marc_mapping'}->{$current_tag}->{$current_code} .= $_;
+
+	$self->{'current_code'} = "";
+    }
+    
+    $self->{'content'} .= $escaped_text;
+    $self->{'xmlcontent'} .= $text;
+   
+}
+
+sub calculate_indent{
+   my ($self,$num) = @_;
+
+   my $indent ="";
+  
+   for (my $i=0; $i<$num;$i++){
+       $indent .= "&nbsp;&nbsp;&nbsp;&nbsp;";
+    } 
+ 
+   return $indent;
+
+}
+
+sub escape_text {
+    my ($self,$text) = @_;
+    # special characters in the xml encoding
+    $text =~ s/&/&amp;/g; # this has to be first...
+    $text =~ s/</&lt;/g;
+    $text =~ s/>/&gt;/g;
+    $text =~ s/\"/&quot;/g;
+
+    return $text;
+}
+
+
+sub unescape_text {
+    my ($self,$text) = @_;
+    # special characters in the xml encoding
+    $text =~ s/&lt;/</g;
+    $text =~ s/&gt;/>/g;
+    $text =~ s/&quot;/\"/g;
+
+    $text =~ s/&/&amp;/g; # can't have & in raw form, even in unescaped xml!
+
+    return $text;
+}
+
+
+1;
+
+
Index: dl/trunk/perllib/plugins/METSPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/METSPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,325 +1,0 @@
-###########################################################################
-#
-# METSPlug.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 METS 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 METSPlug;
-
-use ghtml;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-use XMLPlug;
-use XML::XPath;
-use XML::XPath::XMLParser;
-
-sub BEGIN {
-    @METSPlug::ISA = ('XMLPlug');
-}
-
-my $arguments = [
-		 ];
-my $options = { 'name'     => "METSPlug",
-		'desc'     => "{METSPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes" };
-
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)docmets\.xml$^;
-}
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new XMLPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    $self->{'section'} = "";
-    $self->{'section_level'} = 0;
-    $self->{'metadata_name'} = "";
-    $self->{'metadata_value'} = "";
-    $self->{'content'} = "";
-
-    return bless $self, $class;
-}
-
-sub xml_start_document {
-    my $self = shift (@_);
-    my ($expat, $element) =  @_;
-
-    $self->{'section'} = "";
-    $self->{'section_level'} = 0;
-    $self->{'metadata_name'} = "";
-    $self->{'metadata_value'} = "";
-    $self->{'content'} = "";
-
-    #**defined a dmdSection Table
-    $self->{'dmdSec_table'}={};
-
-    #**defined a fileSection Table
-    $self->{'fileSec_table'}={};
-
-    #***open doctxt.xml and read the data in 
-    my $filename = $self->{'filename'};
-    
-    $filename =~ s/docmets.xml$/doctxt.xml/;
-   
-    if (!open (FILEIN,"<$filename")){
-   	print STDERR "Warning: unable to open the $filename\n";
-	$self->{'xmltxt'} = "";
-    }
-    else {
-	my $xml_text = "";
-	while (defined (my $line = <FILEIN>)) {
-	    if ($line !~ m/^<!DOCTYPE.*>/) {
-		$xml_text .= $line;
-	    }
-	}
-        my $xml_parser = XML::XPath->new (xml=> $xml_text);
-	#my $xml_tree = $xml_parser->parse ($xml_text);
-
-	#eval {$self->{'parser_text'}->parse};
-	$self->{'parsed_xml'} = $xml_parser;
-    }
-    my $outhandle = $self->{'outhandle'};
-    print $outhandle "METSPlug: processing $self->{'file'}\n" if $self->{'verbosity'} > 1;
-    print STDERR "<Processing n='$self->{'file'}' p='METSPlug'>\n" if ($self->{'gli'});
-
-}
-
-sub xml_end_document {
-}
-
-sub xml_doctype {
-}
-
-sub xml_start_tag {
-    my $self = shift(@_);
-    my ($expat, $element) = @_;
-
-    $self->{'element'} = $element;
-
-    #**deal with dmdSection
-    if ($element eq "mets:dmdSec" || $element eq "gsdl3:Metadata"){    
-	$self->xml_dmd_start_tag (@_);
-    } elsif ($element eq "mets:file") {
-	$_{'ID'} =~ m/FILE(.*)/;
-	$self->{'file_Id'} = $1;
-    } elsif ($element eq "mets:FLocat"){
-	#***deal with fileSection
-	$self->xml_fileloc_start_tag (@_);
-    } elsif ($element eq "mets:div"){
-	#***deal with StrucMap Section
-	$self->xml_strucMap_start_tag (@_);
-    }
-}
-
-sub xml_dmd_start_tag {
-    my $self = shift (@_);
-    my ($expat, $element) = @_;
-
-    if ($element eq "mets:dmdSec"){
-  	my ($section_num) = ($_{'ID'} =~ m/DM(.*)/);
-	$self->{'dmdSec_table'}->{"$section_num"}=[];
-	$self->{'dmdSec_table'}->{'section_num'}=$section_num;
-    } elsif ($element eq "gsdl3:Metadata") {
-	$self->{'metadata_name'} = $_{'name'};
-    }
-}
-
-sub xml_fileloc_start_tag {
-    my $self = shift (@_);
-    my ($expat, $element) = @_;
-
-    my $xlink = $_{'xlink:href'};
-    #my ($section_num) = ($_{'ID'} =~ m/^FLOCAT(.*)$/);
-    my $section_num = $self->{'file_Id'};
-
-    return if (!defined $section_num); 
-    #**return if the section_num is not defined or not deal with the whole section (ID="default.*")
-    
-    $self->{'fileSec_table'}->{"$section_num"}=[];
-    $self->{'fileSec_table'}->{'section_num'}=$section_num;
-    
-    my ($filename,$xpath_expr)=($xlink =~ m/^file:(.*)\#xpointer\((.*)\)$/);
-    
-    my $nodeset = $self->{'parsed_xml'}->findnodes ($xpath_expr);
-    my $node_size= $nodeset->size;
-    
-    if ($node_size==0) {
-	print STDERR "Warning: no text associated with XPATH $xpath_expr\n";
-    }
-    else {
-	foreach my $node ($nodeset->get_nodelist) {
-	    my $xml_content = XML::XPath::XMLParser::as_string($node);
-	    my $unescaped_xml_content = &ghtml::unescape_html($xml_content);
-
-	    my $section_content={'section_content'=> $unescaped_xml_content};
-	    
-	    my $content_list = $self->{'fileSec_table'}->{"$section_num"};
-	    push (@$content_list, $section_content);
-	}
-    }
-}
-
-sub xml_strucMap_start_tag {
-    my $self = shift (@_);
-    my ($expat, $element) = @_;
-
-
-    my ($section_num) = ($_{'ID'} =~ m/DS(.*)/);
-
-    if ($_{'ID'} ne "DSAll"){
-	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'}++;
-	
-	#***Add metadata from dmdSection
-	my $md_list = $self->{'dmdSec_table'}->{"$section_num"};
-	
-	foreach my $md_pair (@$md_list){
-	    my $metadata_name = $md_pair->{'metadata_name'};
-	    my $metadata_value = $md_pair->{'metadata_value'};
-	    $self->{'doc_obj'}->add_utf8_metadata($self->{'section'}, $metadata_name, $metadata_value);
-	}
-	
-	#*** Add content from fileSection
-	my $content_list = $self->{'fileSec_table'}->{"$section_num"};
-	
-	foreach my $section_content (@$content_list){
-	    my $content = $section_content->{'section_content'};
-	    $self->{'doc_obj'}->add_utf8_text($self->{'section'},$content);
-	}
-    }
-}
-
-sub get_doctype {
-    my $self = shift(@_);
-    
-    return "mets:mets";
-}
-
-sub xml_end_tag {
-    my $self = shift(@_);
-    my ($expat, $element) = @_;
-
-    if ($element eq "gsdl3:Metadata") {
-	my $section_num = $self->{'dmdSec_table'}->{'section_num'};
-	my $metadata_name=$self->{'metadata_name'};
-	my $metadata_value=$self->{'metadata_value'};
-
-	my $md_pair={'metadata_name' => $metadata_name,
-		     'metadata_value'=> $metadata_value};
-
-	my $md_list = $self->{'dmdSec_table'}->{"$section_num"};
-
-	push(@$md_list,$md_pair);
-      
-	$self->{'metadata_name'} = "";
-	$self->{'metadata_value'} = "";
-    } elsif ($element eq "mets:file"){
-	$self->{'file_id'} = "";
-    }
-    
-    
-    #*** StrucMap Section
-    if ($element eq "mets:div") {
-	$self->{'section_level'}--;
-	$self->{'section'} = $self->{'doc_obj'}->get_parent_section($self->{'section'});
-	$self->close_document() if $self->{'section_level'}==0;
-    }
-    $self->{'element'} = "";
-}
-
-sub xml_text {
-    my $self = shift(@_);
-    my ($expat) = @_; 
-
-    if ($self->{'element'} eq "gsdl3:Metadata") {
-   	$self->{'metadata_value'} .= $_;
-    }
-}
-
-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;
-
Index: /gsdl/trunk/perllib/plugins/METSPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/METSPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/METSPlugin.pm	(revision 15865)
@@ -0,0 +1,325 @@
+###########################################################################
+#
+# METSPlug.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 METS 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 METSPlug;
+
+use ghtml;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+use XMLPlug;
+use XML::XPath;
+use XML::XPath::XMLParser;
+
+sub BEGIN {
+    @METSPlug::ISA = ('XMLPlug');
+}
+
+my $arguments = [
+		 ];
+my $options = { 'name'     => "METSPlug",
+		'desc'     => "{METSPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes" };
+
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)docmets\.xml$^;
+}
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new XMLPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    $self->{'section'} = "";
+    $self->{'section_level'} = 0;
+    $self->{'metadata_name'} = "";
+    $self->{'metadata_value'} = "";
+    $self->{'content'} = "";
+
+    return bless $self, $class;
+}
+
+sub xml_start_document {
+    my $self = shift (@_);
+    my ($expat, $element) =  @_;
+
+    $self->{'section'} = "";
+    $self->{'section_level'} = 0;
+    $self->{'metadata_name'} = "";
+    $self->{'metadata_value'} = "";
+    $self->{'content'} = "";
+
+    #**defined a dmdSection Table
+    $self->{'dmdSec_table'}={};
+
+    #**defined a fileSection Table
+    $self->{'fileSec_table'}={};
+
+    #***open doctxt.xml and read the data in 
+    my $filename = $self->{'filename'};
+    
+    $filename =~ s/docmets.xml$/doctxt.xml/;
+   
+    if (!open (FILEIN,"<$filename")){
+   	print STDERR "Warning: unable to open the $filename\n";
+	$self->{'xmltxt'} = "";
+    }
+    else {
+	my $xml_text = "";
+	while (defined (my $line = <FILEIN>)) {
+	    if ($line !~ m/^<!DOCTYPE.*>/) {
+		$xml_text .= $line;
+	    }
+	}
+        my $xml_parser = XML::XPath->new (xml=> $xml_text);
+	#my $xml_tree = $xml_parser->parse ($xml_text);
+
+	#eval {$self->{'parser_text'}->parse};
+	$self->{'parsed_xml'} = $xml_parser;
+    }
+    my $outhandle = $self->{'outhandle'};
+    print $outhandle "METSPlug: processing $self->{'file'}\n" if $self->{'verbosity'} > 1;
+    print STDERR "<Processing n='$self->{'file'}' p='METSPlug'>\n" if ($self->{'gli'});
+
+}
+
+sub xml_end_document {
+}
+
+sub xml_doctype {
+}
+
+sub xml_start_tag {
+    my $self = shift(@_);
+    my ($expat, $element) = @_;
+
+    $self->{'element'} = $element;
+
+    #**deal with dmdSection
+    if ($element eq "mets:dmdSec" || $element eq "gsdl3:Metadata"){    
+	$self->xml_dmd_start_tag (@_);
+    } elsif ($element eq "mets:file") {
+	$_{'ID'} =~ m/FILE(.*)/;
+	$self->{'file_Id'} = $1;
+    } elsif ($element eq "mets:FLocat"){
+	#***deal with fileSection
+	$self->xml_fileloc_start_tag (@_);
+    } elsif ($element eq "mets:div"){
+	#***deal with StrucMap Section
+	$self->xml_strucMap_start_tag (@_);
+    }
+}
+
+sub xml_dmd_start_tag {
+    my $self = shift (@_);
+    my ($expat, $element) = @_;
+
+    if ($element eq "mets:dmdSec"){
+  	my ($section_num) = ($_{'ID'} =~ m/DM(.*)/);
+	$self->{'dmdSec_table'}->{"$section_num"}=[];
+	$self->{'dmdSec_table'}->{'section_num'}=$section_num;
+    } elsif ($element eq "gsdl3:Metadata") {
+	$self->{'metadata_name'} = $_{'name'};
+    }
+}
+
+sub xml_fileloc_start_tag {
+    my $self = shift (@_);
+    my ($expat, $element) = @_;
+
+    my $xlink = $_{'xlink:href'};
+    #my ($section_num) = ($_{'ID'} =~ m/^FLOCAT(.*)$/);
+    my $section_num = $self->{'file_Id'};
+
+    return if (!defined $section_num); 
+    #**return if the section_num is not defined or not deal with the whole section (ID="default.*")
+    
+    $self->{'fileSec_table'}->{"$section_num"}=[];
+    $self->{'fileSec_table'}->{'section_num'}=$section_num;
+    
+    my ($filename,$xpath_expr)=($xlink =~ m/^file:(.*)\#xpointer\((.*)\)$/);
+    
+    my $nodeset = $self->{'parsed_xml'}->findnodes ($xpath_expr);
+    my $node_size= $nodeset->size;
+    
+    if ($node_size==0) {
+	print STDERR "Warning: no text associated with XPATH $xpath_expr\n";
+    }
+    else {
+	foreach my $node ($nodeset->get_nodelist) {
+	    my $xml_content = XML::XPath::XMLParser::as_string($node);
+	    my $unescaped_xml_content = &ghtml::unescape_html($xml_content);
+
+	    my $section_content={'section_content'=> $unescaped_xml_content};
+	    
+	    my $content_list = $self->{'fileSec_table'}->{"$section_num"};
+	    push (@$content_list, $section_content);
+	}
+    }
+}
+
+sub xml_strucMap_start_tag {
+    my $self = shift (@_);
+    my ($expat, $element) = @_;
+
+
+    my ($section_num) = ($_{'ID'} =~ m/DS(.*)/);
+
+    if ($_{'ID'} ne "DSAll"){
+	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'}++;
+	
+	#***Add metadata from dmdSection
+	my $md_list = $self->{'dmdSec_table'}->{"$section_num"};
+	
+	foreach my $md_pair (@$md_list){
+	    my $metadata_name = $md_pair->{'metadata_name'};
+	    my $metadata_value = $md_pair->{'metadata_value'};
+	    $self->{'doc_obj'}->add_utf8_metadata($self->{'section'}, $metadata_name, $metadata_value);
+	}
+	
+	#*** Add content from fileSection
+	my $content_list = $self->{'fileSec_table'}->{"$section_num"};
+	
+	foreach my $section_content (@$content_list){
+	    my $content = $section_content->{'section_content'};
+	    $self->{'doc_obj'}->add_utf8_text($self->{'section'},$content);
+	}
+    }
+}
+
+sub get_doctype {
+    my $self = shift(@_);
+    
+    return "mets:mets";
+}
+
+sub xml_end_tag {
+    my $self = shift(@_);
+    my ($expat, $element) = @_;
+
+    if ($element eq "gsdl3:Metadata") {
+	my $section_num = $self->{'dmdSec_table'}->{'section_num'};
+	my $metadata_name=$self->{'metadata_name'};
+	my $metadata_value=$self->{'metadata_value'};
+
+	my $md_pair={'metadata_name' => $metadata_name,
+		     'metadata_value'=> $metadata_value};
+
+	my $md_list = $self->{'dmdSec_table'}->{"$section_num"};
+
+	push(@$md_list,$md_pair);
+      
+	$self->{'metadata_name'} = "";
+	$self->{'metadata_value'} = "";
+    } elsif ($element eq "mets:file"){
+	$self->{'file_id'} = "";
+    }
+    
+    
+    #*** StrucMap Section
+    if ($element eq "mets:div") {
+	$self->{'section_level'}--;
+	$self->{'section'} = $self->{'doc_obj'}->get_parent_section($self->{'section'});
+	$self->close_document() if $self->{'section_level'}==0;
+    }
+    $self->{'element'} = "";
+}
+
+sub xml_text {
+    my $self = shift(@_);
+    my ($expat) = @_; 
+
+    if ($self->{'element'} eq "gsdl3:Metadata") {
+   	$self->{'metadata_value'} .= $_;
+    }
+}
+
+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;
+
Index: dl/trunk/perllib/plugins/MP3Plug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/MP3Plug.pm	(revision 15864)
+++ 	(revision )
@@ -1,401 +1,0 @@
-###########################################################################
-#
-# MP3Plug.pm -- Plugin for MP3 files (MPEG audio layer 3).
-#
-# 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.
-#
-###########################################################################
-
-
-package MP3Plug;
-
-use UnknownPlug;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-use MP3::Info;
-
-require giget;
-
-sub BEGIN {
-    @MP3Plug::ISA = ('UnknownPlug');
-}
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" },
-      { 'name' => "assoc_images",
-        'desc' => "{MP3Plug.assoc_images}",
-        'type' => "flag",
-        'deft' => "",
-        'reqd' => "no" },
-      { 'name' => "applet_metadata",
-	'desc' => "{MP3Plug.applet_metadata}",
-	'type' => "flag",
-	'deft' => "" },
-      { 'name' => "metadata_fields",
-	'desc' => "{MP3Plug.metadata_fields}",
-	'type' => "string",
-	'deft' => "Title,Artist,Genre" } ];
-
-my $options = { 'name'     => "MP3Plug",
-		'desc'     => "{MP3Plug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new UnknownPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-sub get_default_process_exp {
-    return q^(?i)\.mp3$^;
-}
-
-sub gen_mp3applet {
-
-    my ($mp3_filename) = @_;
-
-    my $applet_html = '
-<OBJECT classid="clsid:8AD9C840-044E-11D1-B3E9-00805F499D93"
-        WIDTH = "59"
-        HEIGHT = "32"
-        codebase="http://java.sun.com/products/plugin/1.3/jinstall-13-win32.cab#Version=1,3,0,0">
-<PARAM NAME = CODE VALUE = "javazoom.jlGui.TinyPlayer" >
-<PARAM NAME = ARCHIVE VALUE = "_httpcollection_/tinyplayer.jar,_httpcollection_/jl10.jar" >
-<PARAM NAME="type" VALUE="application/x-java-applet;version=1.3">
-<PARAM NAME="scriptable" VALUE="false">
-<PARAM NAME = "skin" VALUE ="_httpcollection_/skins/Digitalized">
-<PARAM NAME = "autoplay" VALUE ="yes">
-<PARAM NAME = "bgcolor" VALUE ="638182">
-<PARAM NAME = "audioURL" VALUE ="MP3FILENAME">
-<COMMENT>
-<EMBED type="application/x-java-applet;version=1.3"
-       CODE = "javazoom.jlGui.TinyPlayer"
-       ARCHIVE = "_httpcollection_/tinyplayer.jar,_httpcollection_/jl10.jar"
-       WIDTH = "59"
-       HEIGHT = "32"
-       skin = "_httpcollection_/skins/Digitalized"
-       autoplay = "yes"
-       bgcolor = "638182"
-       audioURL = "MP3FILENAME"
-       scriptable=false
-       pluginspage="http://java.sun.com/products/plugin/1.3/plugin-install.html">
-<NOEMBED>
-</COMMENT>
-</NOEMBED></EMBED>
-</OBJECT>
-';
-
-    $applet_html =~ s/MP3FILENAME/$mp3_filename/g;
-
-    return $applet_html;
-}
-
-
-
-# Associate the mp3 file with the new document
-
-sub associate_mp3_file {
-    my $self = shift (@_);
-    my $filename = shift (@_);   # filename with full path
-    my $file = shift (@_);       # filename without path
-    my $doc_obj = shift (@_);
-    
-    my $verbosity = $self->{'verbosity'};
-    my $outhandle = $self->{'outhandle'};
-
-    # check the filename is okay
-    return 0 if ($file eq "" || $filename eq "");
-
-    # Add the file metadata
-    my $assoc_url = $file;
-#    $assoc_url =~ s/ /%20/g; # probably need to do more escaping than this!!
-    $assoc_url =~ s/ /_/g; # workaround for now
-    my $dst_file = $file;
-    $dst_file =~ s/ /_/g;
-
-    # Add the file as an associated file ...
-    my $section = $doc_obj->get_top_section();
-    my $mime_type = $self->{'mime_type'} || "audio/mp3";
-    my $assoc_field = $self->{'assoc_field'} || "mp3";
-    my $assoc_name = $file;
-    $assoc_name =~ s/\.mp3$//;
-
-    $doc_obj->associate_file($filename, $dst_file, $mime_type, $section);
-    $doc_obj->add_metadata ($section, "Source", $file);
-    $doc_obj->add_metadata ($section, $assoc_field, $assoc_name);
-    $doc_obj->add_metadata ($section, "srcurl", $assoc_url);
-    $doc_obj->add_metadata ($section, "NoText",    "1");
-
-    my $mp3_info = get_mp3info($filename);
-    my $mp3_tags = get_mp3tag($filename);
-
-    my $metadata_fields = $self->{'metadata_fields'};
-
-    if ($metadata_fields eq "*") {
-	# Locate all info and tag metadata
-
-	foreach my $ki ( keys %$mp3_info ) {
-	    my $mp3_metavalue = $mp3_info->{$ki};
-
-	    if ($mp3_metavalue !~ m/^\s*$/s) {
-		my $mp3_metaname = "mp3:".lc($ki);
-		$doc_obj->add_metadata ($section, $mp3_metaname, $mp3_metavalue);
-	    }
-	}
-
-	foreach my $kt ( keys %$mp3_tags ) {
-	    my $mp3_metavalue = $mp3_tags->{$kt};
-	    
-	    if ($mp3_metavalue !~ m/^\s*$/s) {
-		my $kt_len = length($kt);
-		my $kt_initial_cap = uc(substr($kt,0,1)).lc(substr($kt,1,$kt_len-1));
-		my $mp3_metaname = "mp3:".$kt_initial_cap;
-		
-		$doc_obj->add_metadata ($section, $mp3_metaname, $mp3_metavalue);
-	    }
-	}
-    }
-    else {
-
-	# Restrict metadata to that specifically given
-	foreach my $field (split /,/, $metadata_fields) {
-
-	    # check info
-	    if (defined $mp3_info->{$field}) {
-
-		my $mp3i_metavalue = $mp3_info->{$field};
-		
-		if ($mp3i_metavalue !~ m/^\s*$/s) {
-		    my $mp3i_metaname = "mp3:".lc($field);
-		    $doc_obj->add_metadata ($section, $mp3i_metaname, $mp3i_metavalue);
-		}
-	    }
-
-	    # check tags
-	    if (defined $mp3_tags->{uc($field)}) {
-
-		my $mp3t_metavalue = $mp3_tags->{uc($field)};
-		
-		if ($mp3t_metavalue !~ m/^\s*$/s) {
-		    my $mp3t_metaname = "mp3:".$field;
-		    
-		    $doc_obj->add_metadata ($section, $mp3t_metaname, $mp3t_metavalue);
-		}
-	    }
-	    
-	}
-    }
-
-    $doc_obj->add_metadata ($section, "FileFormat", "MP3");
-    
-    $doc_obj->add_metadata ($section, "srclink", 
-			    "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[srcurl]\">");
-    $doc_obj->add_metadata ($section, "srcicon", "_iconmp3_");
-    $doc_obj->add_metadata ($section, "/srclink", "</a>");
-
-    my $applet_metadata = $self->{'applet_metadata'};
-    if (defined $applet_metadata && $applet_metadata ) {
-	my $applet_html 
-	    = gen_mp3applet("_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[srcurl]");
-	$doc_obj->add_metadata ($section, "mp3applet", $applet_html);
-    }
-
-    my $assoc_images = $self->{'assoc_images'};
-    if (defined $assoc_images && $assoc_images) {
-	my @search_terms = ();
-
-	my $title  = $mp3_tags->{'TITLE'};
-	my $artist = $mp3_tags->{'ARTIST'};
-
-	if (defined $title && $title ne "") {
-
-	    push(@search_terms,$title);
-
-	    if (defined $artist && $artist ne "") {
-		push(@search_terms,$artist);
-	    }
-	}
-	else {
-	    push(@search_terms,$assoc_name);
-	}
-
-	push(@search_terms,"song");
-
-	my $output_dir = $filename;
-	$output_dir =~ s/\.\w+$//;
-
-	my ($imgref_urls) = giget(\@search_terms,$output_dir);
-
-	my $gi_base = gi_url_base();
-	my $gi_query_url = gi_query_url(\@search_terms);
-
-	$doc_obj->add_metadata ($section, "giquery", "<a href=\"$gi_base$gi_query_url\" target=giwindow>");
-	$doc_obj->add_metadata ($section, "/giquery", "</a>");
-
-	for (my $i=1; $i<=2; $i++) {
-	    my $img_filename = "$output_dir/img_$i.jpg";
-	    my $dst_file = "img_$i.jpg";
-
-	    if (-e $img_filename) {
-		$doc_obj->associate_file($img_filename, $dst_file, "image/jpeg", $section);
-
-		my $srcurl = "src=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/$dst_file\"";
-
-		$doc_obj->add_metadata ($section, "img$i", 
-					"<img $srcurl>");
-		$doc_obj->add_metadata ($section, "smallimg$i", 
-					"<img $srcurl width=100>");
-
-		my $imgref_url = $imgref_urls->[$i-1];
-
-		$doc_obj->add_metadata ($section, "imgref$i", "<a href=\"$imgref_url\" target=giwindow>");
-		$doc_obj->add_metadata ($section, "/imgref$i", "</a>");
-	    }
-
-	}
-
-
-    }
-
-    return 1;
-}
-
-
-
-# The MP3Plug read() function is based on UnknownPlug read().  This
-# function does all the right things to make general options work for
-# a given plugin. 
-
-my $mp3_doc_count = 0; ## is this used anywhere now !!???
-
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-
-    #check for associate_ext, blocking etc
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-
-    print STDERR "<Processing n='$file' p='MP3Plug'>\n" if ($gli);
-    print $outhandle "MP3Plug processing \"$filename\"\n"
-	    if $self->{'verbosity'} > 1;
-
-    #if there's a leading directory name, eat it...
-    $file =~ s/^.*[\/\\]//;
-    
-    # create a new document
-    my $doc_obj = new doc ($filename, "indexed_doc");
-    $mp3_doc_count++;
-    
-##    $doc_obj->set_OIDtype ($processor->{'OIDtype'});  
-    if ($processor->{'OIDtype'} =~ /^(assigned|dirname)$/) {
-	$doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
-    }
-    else {
-	$doc_obj->set_OIDtype ("incremental");    # this is done to avoid hashing content of file
-    }
-    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
-    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "FileSize", (-s $filename));
-
-    # associate the file with the document
-    if (associate_mp3_file($self, $filename, $file, $doc_obj) != 1)
-    {
-	print "MP3Plug: couldn't process \"$filename\"\n";
-	return 0;
-    }
-
-    #create an empty text string so we don't break downstream plugins 
-    my $text = &gsprintf::lookup_string("{BasPlug.dummy_text}",1);
-    if ($self->{'assoc_images'}) {
-	$text .= "[img1]<br>";
-	$text .= "[img2]<br>";
-    }
-    # include any metadata passed in from previous plugins 
-    my $section = $doc_obj->get_top_section();
-    $self->extra_metadata ($doc_obj, $section, $metadata);
-
-    $self->title_fallback($doc_obj,$section,$file);
-
-    # do plugin specific processing of doc_obj
-    return undef unless defined ($self->process (\$text, $pluginfo, $base_dir, 
-						 $file, $metadata, $doc_obj));
-
-    # do any automatic metadata extraction
-    $self->auto_extract_metadata ($doc_obj);
-
-    # add an OID
-    $doc_obj->set_OID();
-    $doc_obj->add_utf8_text($section, $text);
-
-    # process the document
-    $processor->process($doc_obj);
-
-    $self->{'num_processed'} ++;
-    return 1;
-}
-
-
-sub title_fallback
-{
-    my $self = shift (@_);
-    my ($doc_obj,$section,$file) = @_;
-
-    if (!defined $doc_obj->get_metadata_element ($section, "Title")) {
-	my $mp3_title = $doc_obj->get_metadata_element ($section, "mp3:Title");
-	if (defined $mp3_title) {
-	    $doc_obj->add_metadata ($section, "Title", $mp3_title);
-	}
-	else {
-	    &BasPlug::title_fallback($self, $doc_obj, $section, $file);
-	}
-    }
-}
-
-
-1;
-
-
-
-
-
-
-
-
-
-
-
Index: /gsdl/trunk/perllib/plugins/MP3Plugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/MP3Plugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/MP3Plugin.pm	(revision 15865)
@@ -0,0 +1,401 @@
+###########################################################################
+#
+# MP3Plug.pm -- Plugin for MP3 files (MPEG audio layer 3).
+#
+# 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.
+#
+###########################################################################
+
+
+package MP3Plug;
+
+use UnknownPlug;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+use MP3::Info;
+
+require giget;
+
+sub BEGIN {
+    @MP3Plug::ISA = ('UnknownPlug');
+}
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" },
+      { 'name' => "assoc_images",
+        'desc' => "{MP3Plug.assoc_images}",
+        'type' => "flag",
+        'deft' => "",
+        'reqd' => "no" },
+      { 'name' => "applet_metadata",
+	'desc' => "{MP3Plug.applet_metadata}",
+	'type' => "flag",
+	'deft' => "" },
+      { 'name' => "metadata_fields",
+	'desc' => "{MP3Plug.metadata_fields}",
+	'type' => "string",
+	'deft' => "Title,Artist,Genre" } ];
+
+my $options = { 'name'     => "MP3Plug",
+		'desc'     => "{MP3Plug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new UnknownPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+sub get_default_process_exp {
+    return q^(?i)\.mp3$^;
+}
+
+sub gen_mp3applet {
+
+    my ($mp3_filename) = @_;
+
+    my $applet_html = '
+<OBJECT classid="clsid:8AD9C840-044E-11D1-B3E9-00805F499D93"
+        WIDTH = "59"
+        HEIGHT = "32"
+        codebase="http://java.sun.com/products/plugin/1.3/jinstall-13-win32.cab#Version=1,3,0,0">
+<PARAM NAME = CODE VALUE = "javazoom.jlGui.TinyPlayer" >
+<PARAM NAME = ARCHIVE VALUE = "_httpcollection_/tinyplayer.jar,_httpcollection_/jl10.jar" >
+<PARAM NAME="type" VALUE="application/x-java-applet;version=1.3">
+<PARAM NAME="scriptable" VALUE="false">
+<PARAM NAME = "skin" VALUE ="_httpcollection_/skins/Digitalized">
+<PARAM NAME = "autoplay" VALUE ="yes">
+<PARAM NAME = "bgcolor" VALUE ="638182">
+<PARAM NAME = "audioURL" VALUE ="MP3FILENAME">
+<COMMENT>
+<EMBED type="application/x-java-applet;version=1.3"
+       CODE = "javazoom.jlGui.TinyPlayer"
+       ARCHIVE = "_httpcollection_/tinyplayer.jar,_httpcollection_/jl10.jar"
+       WIDTH = "59"
+       HEIGHT = "32"
+       skin = "_httpcollection_/skins/Digitalized"
+       autoplay = "yes"
+       bgcolor = "638182"
+       audioURL = "MP3FILENAME"
+       scriptable=false
+       pluginspage="http://java.sun.com/products/plugin/1.3/plugin-install.html">
+<NOEMBED>
+</COMMENT>
+</NOEMBED></EMBED>
+</OBJECT>
+';
+
+    $applet_html =~ s/MP3FILENAME/$mp3_filename/g;
+
+    return $applet_html;
+}
+
+
+
+# Associate the mp3 file with the new document
+
+sub associate_mp3_file {
+    my $self = shift (@_);
+    my $filename = shift (@_);   # filename with full path
+    my $file = shift (@_);       # filename without path
+    my $doc_obj = shift (@_);
+    
+    my $verbosity = $self->{'verbosity'};
+    my $outhandle = $self->{'outhandle'};
+
+    # check the filename is okay
+    return 0 if ($file eq "" || $filename eq "");
+
+    # Add the file metadata
+    my $assoc_url = $file;
+#    $assoc_url =~ s/ /%20/g; # probably need to do more escaping than this!!
+    $assoc_url =~ s/ /_/g; # workaround for now
+    my $dst_file = $file;
+    $dst_file =~ s/ /_/g;
+
+    # Add the file as an associated file ...
+    my $section = $doc_obj->get_top_section();
+    my $mime_type = $self->{'mime_type'} || "audio/mp3";
+    my $assoc_field = $self->{'assoc_field'} || "mp3";
+    my $assoc_name = $file;
+    $assoc_name =~ s/\.mp3$//;
+
+    $doc_obj->associate_file($filename, $dst_file, $mime_type, $section);
+    $doc_obj->add_metadata ($section, "Source", $file);
+    $doc_obj->add_metadata ($section, $assoc_field, $assoc_name);
+    $doc_obj->add_metadata ($section, "srcurl", $assoc_url);
+    $doc_obj->add_metadata ($section, "NoText",    "1");
+
+    my $mp3_info = get_mp3info($filename);
+    my $mp3_tags = get_mp3tag($filename);
+
+    my $metadata_fields = $self->{'metadata_fields'};
+
+    if ($metadata_fields eq "*") {
+	# Locate all info and tag metadata
+
+	foreach my $ki ( keys %$mp3_info ) {
+	    my $mp3_metavalue = $mp3_info->{$ki};
+
+	    if ($mp3_metavalue !~ m/^\s*$/s) {
+		my $mp3_metaname = "mp3:".lc($ki);
+		$doc_obj->add_metadata ($section, $mp3_metaname, $mp3_metavalue);
+	    }
+	}
+
+	foreach my $kt ( keys %$mp3_tags ) {
+	    my $mp3_metavalue = $mp3_tags->{$kt};
+	    
+	    if ($mp3_metavalue !~ m/^\s*$/s) {
+		my $kt_len = length($kt);
+		my $kt_initial_cap = uc(substr($kt,0,1)).lc(substr($kt,1,$kt_len-1));
+		my $mp3_metaname = "mp3:".$kt_initial_cap;
+		
+		$doc_obj->add_metadata ($section, $mp3_metaname, $mp3_metavalue);
+	    }
+	}
+    }
+    else {
+
+	# Restrict metadata to that specifically given
+	foreach my $field (split /,/, $metadata_fields) {
+
+	    # check info
+	    if (defined $mp3_info->{$field}) {
+
+		my $mp3i_metavalue = $mp3_info->{$field};
+		
+		if ($mp3i_metavalue !~ m/^\s*$/s) {
+		    my $mp3i_metaname = "mp3:".lc($field);
+		    $doc_obj->add_metadata ($section, $mp3i_metaname, $mp3i_metavalue);
+		}
+	    }
+
+	    # check tags
+	    if (defined $mp3_tags->{uc($field)}) {
+
+		my $mp3t_metavalue = $mp3_tags->{uc($field)};
+		
+		if ($mp3t_metavalue !~ m/^\s*$/s) {
+		    my $mp3t_metaname = "mp3:".$field;
+		    
+		    $doc_obj->add_metadata ($section, $mp3t_metaname, $mp3t_metavalue);
+		}
+	    }
+	    
+	}
+    }
+
+    $doc_obj->add_metadata ($section, "FileFormat", "MP3");
+    
+    $doc_obj->add_metadata ($section, "srclink", 
+			    "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[srcurl]\">");
+    $doc_obj->add_metadata ($section, "srcicon", "_iconmp3_");
+    $doc_obj->add_metadata ($section, "/srclink", "</a>");
+
+    my $applet_metadata = $self->{'applet_metadata'};
+    if (defined $applet_metadata && $applet_metadata ) {
+	my $applet_html 
+	    = gen_mp3applet("_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[srcurl]");
+	$doc_obj->add_metadata ($section, "mp3applet", $applet_html);
+    }
+
+    my $assoc_images = $self->{'assoc_images'};
+    if (defined $assoc_images && $assoc_images) {
+	my @search_terms = ();
+
+	my $title  = $mp3_tags->{'TITLE'};
+	my $artist = $mp3_tags->{'ARTIST'};
+
+	if (defined $title && $title ne "") {
+
+	    push(@search_terms,$title);
+
+	    if (defined $artist && $artist ne "") {
+		push(@search_terms,$artist);
+	    }
+	}
+	else {
+	    push(@search_terms,$assoc_name);
+	}
+
+	push(@search_terms,"song");
+
+	my $output_dir = $filename;
+	$output_dir =~ s/\.\w+$//;
+
+	my ($imgref_urls) = giget(\@search_terms,$output_dir);
+
+	my $gi_base = gi_url_base();
+	my $gi_query_url = gi_query_url(\@search_terms);
+
+	$doc_obj->add_metadata ($section, "giquery", "<a href=\"$gi_base$gi_query_url\" target=giwindow>");
+	$doc_obj->add_metadata ($section, "/giquery", "</a>");
+
+	for (my $i=1; $i<=2; $i++) {
+	    my $img_filename = "$output_dir/img_$i.jpg";
+	    my $dst_file = "img_$i.jpg";
+
+	    if (-e $img_filename) {
+		$doc_obj->associate_file($img_filename, $dst_file, "image/jpeg", $section);
+
+		my $srcurl = "src=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/$dst_file\"";
+
+		$doc_obj->add_metadata ($section, "img$i", 
+					"<img $srcurl>");
+		$doc_obj->add_metadata ($section, "smallimg$i", 
+					"<img $srcurl width=100>");
+
+		my $imgref_url = $imgref_urls->[$i-1];
+
+		$doc_obj->add_metadata ($section, "imgref$i", "<a href=\"$imgref_url\" target=giwindow>");
+		$doc_obj->add_metadata ($section, "/imgref$i", "</a>");
+	    }
+
+	}
+
+
+    }
+
+    return 1;
+}
+
+
+
+# The MP3Plug read() function is based on UnknownPlug read().  This
+# function does all the right things to make general options work for
+# a given plugin. 
+
+my $mp3_doc_count = 0; ## is this used anywhere now !!???
+
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+
+    #check for associate_ext, blocking etc
+    my ($block_status,$filename) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+
+    print STDERR "<Processing n='$file' p='MP3Plug'>\n" if ($gli);
+    print $outhandle "MP3Plug processing \"$filename\"\n"
+	    if $self->{'verbosity'} > 1;
+
+    #if there's a leading directory name, eat it...
+    $file =~ s/^.*[\/\\]//;
+    
+    # create a new document
+    my $doc_obj = new doc ($filename, "indexed_doc");
+    $mp3_doc_count++;
+    
+##    $doc_obj->set_OIDtype ($processor->{'OIDtype'});  
+    if ($processor->{'OIDtype'} =~ /^(assigned|dirname)$/) {
+	$doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
+    }
+    else {
+	$doc_obj->set_OIDtype ("incremental");    # this is done to avoid hashing content of file
+    }
+    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
+    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "FileSize", (-s $filename));
+
+    # associate the file with the document
+    if (associate_mp3_file($self, $filename, $file, $doc_obj) != 1)
+    {
+	print "MP3Plug: couldn't process \"$filename\"\n";
+	return 0;
+    }
+
+    #create an empty text string so we don't break downstream plugins 
+    my $text = &gsprintf::lookup_string("{BasPlug.dummy_text}",1);
+    if ($self->{'assoc_images'}) {
+	$text .= "[img1]<br>";
+	$text .= "[img2]<br>";
+    }
+    # include any metadata passed in from previous plugins 
+    my $section = $doc_obj->get_top_section();
+    $self->extra_metadata ($doc_obj, $section, $metadata);
+
+    $self->title_fallback($doc_obj,$section,$file);
+
+    # do plugin specific processing of doc_obj
+    return undef unless defined ($self->process (\$text, $pluginfo, $base_dir, 
+						 $file, $metadata, $doc_obj));
+
+    # do any automatic metadata extraction
+    $self->auto_extract_metadata ($doc_obj);
+
+    # add an OID
+    $doc_obj->set_OID();
+    $doc_obj->add_utf8_text($section, $text);
+
+    # process the document
+    $processor->process($doc_obj);
+
+    $self->{'num_processed'} ++;
+    return 1;
+}
+
+
+sub title_fallback
+{
+    my $self = shift (@_);
+    my ($doc_obj,$section,$file) = @_;
+
+    if (!defined $doc_obj->get_metadata_element ($section, "Title")) {
+	my $mp3_title = $doc_obj->get_metadata_element ($section, "mp3:Title");
+	if (defined $mp3_title) {
+	    $doc_obj->add_metadata ($section, "Title", $mp3_title);
+	}
+	else {
+	    &BasPlug::title_fallback($self, $doc_obj, $section, $file);
+	}
+    }
+}
+
+
+1;
+
+
+
+
+
+
+
+
+
+
+
Index: dl/trunk/perllib/plugins/MediaWikiPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/MediaWikiPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,666 +1,0 @@
-###########################################################################
-#
-# MediaWikiPlug.pm -- html plugin with extra facilities for wiki page 
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999 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.
-#
-###########################################################################
-# This plugin is to process an HTML file from a MediaWiki website which downloaded by 
-# the MediaWikiDownload plug. This plugin will trim MediaWiki functional sections like 
-# login, discussion, history, etc. Only the navigation and search section could be preserved. 
-# Searchbox will be modified to search the Greenstone collection instead of the website.
-# It also can automatically add the table of contents on the website's Main_Page to the 
-# collection's Home page. 
-
-package MediaWikiPlug;
-
-use HTMLPlug;
-# use ImagePlug;
-# use File::Copy;
-use unicode;
-
-
-#use strict; # every perl program should have this!
-#no strict 'refs'; # make an exception so we can use variables as filehandles
-
-sub BEGIN {
-    @MediaWikiPlug::ISA = ('HTMLPlug');        
-}
-
-my $arguments = 
-    [          
-     # show the table of contents on collection's home page
-     { 'name' => "show_toc",
-       'desc' => "{MediaWikiPlug.show_toc}",
-       'type' => "flag",
-       'reqd' => "no"},
-     # set to delete the table of contents section on each MediaWiki page
-     { 'name' => "delete_toc",
-       'desc' => "{MediaWikiPlug.delete_toc}",
-       'type' => "flag",
-       'reqd' => "no"},
-     # regexp to match the table of contents
-     { 'name' => "toc_exp",
-       'desc' => "{MediaWikiPlug.toc_exp}",
-       'type' => "regexp",
-       'reqd' => "no",
-       'deft' => "<table([^>]*)id=(\\\"|')toc(\\\"|')(.|\\n)*?</table>\\n" },        
-     # set to delete the navigation section
-     { 'name' => "delete_nav",
-       'desc' => "{MediaWikiPlug.delete_nav}",
-       'type' => "flag",
-       'reqd' => "no",
-       'deft' => ""}, 
-     # regexp to match the navigation section    
-     { 'name' => "nav_div_exp",
-       'desc' => "{MediaWikiPlug.nav_div_exp}",
-       'type' => "regexp",
-       'reqd' => "no",
-       'deft' => "<div([^>]*)id=(\\\"|')p-navigation(\\\"|')(.|\\n)*?<\/div>" },
-     # set to delete the searchbox section
-     { 'name' => "delete_searchbox",
-       'desc' => "{MediaWikiPlug.delete_searchbox}",
-       'type' => "flag",
-       'reqd' => "no",
-       'deft' => ""},
-     # regexp to match the searchbox section
-     { 'name' => "searchbox_div_exp",
-       'desc' => "{MediaWikiPlug.searchbox_div_exp}",
-       'type' => "regexp",
-       'reqd' => "no",
-       'deft' => "<div([^>]*)id=(\\\"|')p-search(\\\"|')(.|\\n)*?<\/div>"},     
-     # regexp to match title suffix
-     # can't use the title_sub option in HTMLPlug instead
-     # because title_sub always matches from the begining      
-     { 'name' => "remove_title_suffix_exp",
-       'desc' => "{MediaWikiPlug.remove_title_suffix_exp}",
-       'type' => "regexp",
-       'reqd' => "no",
-       'deft' => ""}
-     ];
-
-my $options = { 'name'     => "MediaWikiPlug",
-		'desc'     => "{MediaWikiPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-    
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-    
-    my $self = new HTMLPlug($pluginlist, $inputargs, $hashArgOptLists);    
-    return bless $self, $class;
-}
-
-
-
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    print $outhandle "MediaWikiPlug: processing $file\n" if $self->{'verbosity'} > 1;
-          
-    my @head_and_body = split(/<body/i,$$textref);
-    my $head = shift(@head_and_body);
-    my $body_text = join("<body", @head_and_body);      
-    
-    $head =~ m/<title>(.+)<\/title>/i;
-    my $doctitle = $1 if defined $1;    
-    
-    if (defined $self->{'metadata_fields'} && $self->{'metadata_fields'}=~ /\S/) {
-	my @doc_properties = split(/<xml>/i,$head);
-	my $doc_heading = shift(@doc_properties);
-	my $rest_doc_properties = join(" ", @doc_properties);
-	
-	my @extracted_metadata = split(/<\/xml>/i, $rest_doc_properties);
-	my $extracted_metadata = shift (@extracted_metadata);
-	$self->extract_metadata($extracted_metadata, $metadata, $doc_obj);
-    }
-    
-    # set the title here if we haven't found it yet
-    if (!defined $doc_obj->get_metadata_element ($doc_obj->get_top_section(), "Title")) {    
-	if (defined $doctitle && $doctitle =~ /\S/) {        	    
-            # remove suffix in title if required
-            my $remove_suffix_exp = $self->{'remove_title_suffix_exp'};
-	    if (defined $remove_suffix_exp && $remove_suffix_exp =~ /\S/){
-	       $doctitle =~ s/$remove_suffix_exp//i;
-	    }	    
-	    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Title", $doctitle);
-	} else {
-	    $self->title_fallback($doc_obj,$doc_obj->get_top_section(),$file);
-	}
-    }
-
-    # we are only interested in the column-contents div <div id="column-content">
-    # remove header section, it may contain header images or additional search boxes
-    my $header_exp = "<div([^>]*)id=(\"|')container(\"|')([^>]*)>(.|\\n)*<div([^>]*)id=(\"|')column-content";
-    if($body_text =~ /$header_exp/){
-	    $body_text =~ s/$header_exp/<div$1id='container'$4><div$6id='column-content/isg;
-	} else {				
-		$header_exp = "(.|\\n)*?<div([^>]*)?id=(\"|')column-content";
-                if($body_text =~ /$header_exp/){
-                  $body_text =~ s/$header_exp/<div$2id='column-content/i;                
-                }
-	}
-    
-    # remove timeline
-    $body_text =~ s/<div([^>]*)class=("|')smwtimeline("|')[\s\S]*?<\/div>//mg;
-    
-    # remove extra bits
-    my $extra_bits = "Retrieved from(.+)</a>\"";
-    $body_text =~ s/$extra_bits//isg;
-    
-    $body_text =~ s/(<p[^>]*><span[^>]*><o:p>&nbsp;<\/o:p><\/span><\/p>)//isg;
-    $body_text =~ s/(<p[^>]*><o:p>&nbsp;<\/o:p><\/p>)//isg;
-    $body_text =~ s/<!\[if !vml\]>/<![if vml]>/g; 
-    $body_text =~ s/(&nbsp;)+/&nbsp;/sg;
-    
-    # get rid of the [edit] buttons
-    $body_text =~ s/\[<a([^>]*)>edit<\/a>]//g;
-    # get rid of the last time edit information at the bottom
-    $body_text =~ s/<a href="([^>]*)edit([^>]*)"([^>]*?)>(\w+)<\/a> \d\d:\d\d,([\s|\w]*?)\(PST\)//g;    
-    # get rid of the (Redirected from ...)
-    $body_text =~ s/\(Redirected from <a ([^>]*)>(\w|\s)*?<\/a>\)//isg;  
-    
-    # escape texts macros
-    $body_text =~ s/_([^\s]*)_/_<span>$1<\/span>_/isg;
-    # may change the links, like Greenstone_Documentation_All.html, then change back
-    $body_text =~ s/<a([^>]*)_<span>([^>]*)<\/span>_/<a$1_$2_/isg;
-    
-    # define file delimiter for different platforms
-    my $file_delimiter;
-    if ($ENV{'GSDLOS'} =~ /^windows$/i) {
-       $file_delimiter = "\\";
-    } else {
-       $file_delimiter = "/";	        
-    }    
-    
-    # IMPORTANT: different delimiter for $base_dir and $file
-    # $base_dir use forward slash for both windows and linux
-    # print "\nbase_dir : $base_dir\n\n"; # windows: C:/Program Files/Greenstone2.73/collect/wiki/import    
-                                        # linux: /research/lh92/greenstone/greenstone2.73/collect/wiki/import
-    # $file use different delimiters : forward slash for linux; backward slash for windows
-    # print "\nfile : $file\n\n";         # windows: greenstone.sourceforge.net\wiki\index.php\Access_Processing_using_DBPlug.html    
-                                        # linux: greenstone.sourceforge.net/wiki/index.php/Using_GreenstoneWiki.html
-    
-    # get the base url for the MediaWiki website
-    my $safe_delimiter = &safe_escape_regexp($file_delimiter);
-    my @url_dirs=split($safe_delimiter, $file);
-    my $url_base = $url_dirs[0];    
-        
-    # Re-check css files associated with MediaWiki pages
-    if(defined $base_dir && $base_dir ne ""){ 	
-	my @css_files;
-	my $css_file_count = 0;
-	
-	# find all the stylesheets imported with @import statement	
-	while($head =~ m"<style type=\"text/css\"(.+)import \"(.+)\""ig){
-	    $css_files[$css_file_count++] = $2 if defined $2;
-	}
-	    
-	# download the stylesheets if we haven't downloaded them yet
-        # add prefix to each style elmement, comment out the body element
-        # and copy the files to collection's images folder 
-	for ($css_file_count = 0; $css_file_count < scalar(@css_files); $css_file_count++) {	    
-	    
-	    my $css_file = $css_files[$css_file_count];	      
-	    
-	    # remove prefix gli/cache directory	                
-            $css_file =~ s/^(.+)gli(\\|\/)cache(\\|\/)//i;
-                        
-            # change the \ delimiter in $css_file to / for consistency
-            $css_file =~ s/\\/\//isg;
-            if($css_file !~ /$url_base/) {
-              $css_file = $url_base . $css_file;  
-            }
-            
-            # trim the ? mark append to the end of a stylesheet
-	    $css_file =~ s/\?(.+)$//isg;  
-	   
-            my $css_file_path = &util::filename_cat($base_dir, $css_file);	    
-	    
-	    # do nothing if we have already downloaded the css files
-	    if (! -e $css_file_path) {		
-	     
-             # check the stylesheet's directory in the import folder
-             # if the directory doesn't exist, create one            
-	     my @dirs = split(/\//i,$css_file);	    
-	     my $path_check = "$base_dir/";            
-	     for (my $i = 0; $i < (scalar(@dirs)-1); $i++) {
-		$path_check .= $dirs[$i] . "/";	
-		mkdir($path_check) if (! -d $path_check );
-	     }
-	     
-             # NOTE: wget needs configuration to directly access Internet
-             # These files should already downloaded if we used the MediaWikiDownload             
-	     # downloading            
-	     $css_file = "http://$css_file";	    
-             print "\ndownloading : " . $css_file . "\n\n";
-	     system("wget", "--non-verbose", "$css_file", "--output-document=$css_file_path");
-	     if ($? != 0) {
-              print "[ERROR] Download Failed! Make sure WGet connects to Internet directly \n";
-              print "[ERROR] OR ues the MediaWikiDownload in the GLI DownloadPanel to download from a MediaWiki website\n";
-              unlink("$css_file_path");
-             }
-            } # done with download
-		
-	    # add a prefix "#wikispecificstyle" to each element
-	    # because we want to preserve this website's formats and don't want to mess up with Greenstone formats
-            # so we will wrap the web page with a div with id = wikispecificstyle
-            my $css_content;
-	    if(open(INPUT, "<$css_file_path")){		
-		while(my $line = <INPUT>){
-                    # comment out the body element because we change the body to div
-                    $line =~ s/^(\s*)body(\s*){(\s*)$/$1\/*body$2*\/{$3/isg;
-                    
-                    if($line =~ m/^(.+)\{/i || $line =~ m/^(\s)*#/i){                    
-                      if($line !~ m/wikispecificstyle/i){
-                        $line = "#wikispecificstyle " . $line;
-                      } 
-                    }
-                    
-		    $css_content .= $line;
-		}
-		close(INPUT);			
-		open(OUTPUT, ">$css_file_path");
-		print OUTPUT $css_content;
-		close(OUTPUT);
-	    }
-            
-            # Copy the modified stylesheets to collection's images folder
-            # for future customization
-            my $images_dir = $base_dir;
-            $images_dir =~ s/import$/images/;
-            $css_file =~ m/(.*)\/(.*)$/;
-            $images_dir = &util::filename_cat($images_dir, $2);            
-            
-            if(open(OUTPUT, ">$images_dir")){	
-              print OUTPUT $css_content;
-              close(OUTPUT);
-            }
-	}
-    }    
-    
-    
-    # by default, only preserve navigation box and search box
-    # others like toolbox, interaction, languages box, will be removed  
-    
-    # extract the larger part -- footer section
-    my $print_footer = "<div class=\"printfooter\">(.|\n)+</body>";
-    $body_text =~ /$print_footer/;
-    my $footer = "";
-    $footer = $& if defined $&;
-    $footer =~ s/<\/body>//isg;
-    
-    # trim the comments first    
-    $footer =~ s/<!--[\s\S]*?--[ \t\n\r]*>//isg;
-    
-    # contain sections that are to be preserved
-    my $preserve_sections = "";   
-    
-    # process the navigation section    
-    my $nav_match_exp = "<div([^>]*)id=(\"|')p-navigation(\"|')(.|\n)*?<\/div>";
-    if (defined $self->{'nav_div_exp'}) {
-      $nav_match_exp = $self->{'nav_div_exp'} if ($self->{'nav_div_exp'} =~ /\S/) ;
-    }
-        
-    if (defined $self->{'delete_nav'} && ($self->{'delete_nav'} eq "1")) {	
-        # do nothing	
-    } else {      
-      if ($footer =~ m/$nav_match_exp/ig) {
-        $preserve_sections = $& ;
-      } else {
-        print $outhandle "Can't find the navigation section with : $nav_match_exp\n";
-      }
-      # if($preserve_sections =~/\S/){
-      #  $preserve_sections .= "</div>";
-      # }            
-    }          
-            
-    # process the searchbox section        
-    my $searchbox_exp = "<div([^>]*)id=(\"|')p-search(\"|')(.|\\n)*?<\/div>";
-    if(defined $self->{'searchbox_div_exp'}) {                
-        $searchbox_exp = $self->{'searchbox_div_exp'} if ($self->{'searchbox_div_exp'} =~ /\S/);
-    }    
-                        
-    my $searchbox_section = "";    
-    $footer =~ m/$searchbox_exp/ig;
-    $searchbox_section = $& if defined $&;    
-    
-    # make the searchbox form work in Greenstone
-    if($searchbox_section =~ /\S/){        
-        # replace action
-        $searchbox_section =~ s/action="([^>]*)"/action="_gwcgi_"/isg;
-                
-        # remove buttons
-        $searchbox_section =~ s/name="search"/name="q"/isg;
-        $searchbox_section =~ s/name="go"//isg;
-        $searchbox_section =~ s/name="fulltext"//isg;
-                
-        # get collection name from $base_dir for c param        
-        $base_dir =~ m/\/collect\/(.+)\//i;
-        my $collection_name = "";
-        $collection_name = $1 if defined $1;
-        
-        # add Greenstone search params
-        my $hidden_params = "<input type=\"hidden\" name=\"a\" value=\"q\"/>\n" 
-            ."<input type=\"hidden\" name=\"c\" value=\"$collection_name\"/>\n";
-            # ."<input type=\"hidden\" name=\"fqf\" value=\"TX\"/>\n"
-            # ."<input type=\"hidden\" name=\"r\" value=\"1\">\n";
-        
-        $searchbox_section =~ s/<form([^>]*)>/<form$1>\n$hidden_params/isg;         
-        
-        # $searchbox_section .= "</div>";
-    } else {
-      print $outhandle "Can't find the searchbox section with : $searchbox_section\n";
-    }        
-    
-    # either delete or replace the searchbox 
-    if(defined $self->{'delete_searchbox'} && $self->{'delete_searchbox'} eq "1") {
-        # do nothing        
-    } else {
-        $preserve_sections .= "\n$searchbox_section\n";
-    } 
-    
-    if($preserve_sections ne ""){
-      $preserve_sections = "<div id=\"column-one\">\n" . $preserve_sections . "\n</div>\n";
-    }
-    $preserve_sections = "</div></div></div>\n" . $preserve_sections . "\n</body>";   
-            
-    $body_text =~ s/$print_footer/$preserve_sections/isg;
-    
-    
-    # delete other forms in the page
-    my @forms;
-    my $form_count = 0;
-    while($body_text =~ m/<form([^>]*)name=("|')([^>"']*)?("|')/isg){
-        next if($3 eq "searchform");
-        $forms[$form_count++] = $&;        
-    }
-    foreach my $form (@forms) {      
-      $body_text =~ s/$form[\s\S]*?<\/form>//m;
-    }
-    
-    # process links. 
-    # because current WGET 1.10 the -k and -E option doesn't work together
-    # need to 'manually' convert the links to relative links
-    # Dealing with 3 types of links:
-    # -- outgoing links
-    #   -- if we have downloaded the target files, link to the internal version (relative link)
-    #   -- otherwise, link to the external version (absolute links)
-    # -- in-page links (relative link)
-    
-    # NOTE: (important)
-    #   must use the MediaWikiDownload in GLI Download Panel to download files from a MediaWiki website
-    #   otherwise, the internal links may have problems
-    
-    # remove the title attribute of <a> tag
-    $body_text =~ s/<a([^>]*)title="(.*?)"/<a$1/isg;
-    
-    # extract all the links
-    my @links;
-    my $link_count = 0;    
-    while($body_text =~ m/(href|src)="([^>\s]*)$url_base\/([^>\s]*)"/ig){        
-        $links[$link_count++] = "$1=\"$2$url_base/$3\"";		
-    }
-    
-    foreach my $cur_link (@links) {     
-        # escape greedy match + character
-        $cur_link =~ s/\+/\\+/isg;
-        
-        $cur_link =~ m/(.+)"([^>]*)$url_base\/([^>\s]*)"/;          
-        my $external_file_path = "$1\"http://$url_base/$3\"";
-           
-        $body_text =~ s/$cur_link/$external_file_path/i; 
-    }
-             
-    # tag links to new wiki pages as red    
-    $body_text =~ s/<a([^>]*)class="new"([^>]*)>/<a$1style="color:red"$2)>/gi;
-    
-    # tag links to pages external of the MediaWiki website as blue
-    $body_text =~ s/<a([^>]*)class='external text'([^>]*)>/<a$1style="color:blue"$2)>/gi;
-        
-    
-    # process the table-of-contents section
-    # if 'show_toc' is set, add Main_Page's toc to the collection's About page, change extra.dm file     
-    # 1. read _content_ macro from about.dm
-    # 2. append the toc, change all links to the Greenstone internal format for relative links 
-    # 3. write to the extra.dm
-    # TODO: we assume the _about:content_ hasn't been specified before
-    #	    so needs to add function to handle when the macro is already in the extra.dm	   
-    if($self->{'show_toc'}==1 && $file =~ m/Main_Page.(html|htm)$/){
-    
-      # extract toc of the Main_Page           	 
-      my $mainpage_toc = "";  
-      my $toc_exp = "<table([^>]*)id=(\"|')toc(\"|')(.|\\n)*</table>\\n";
-      if($self->{'toc_exp'} =~ /\S/){
-         $toc_exp = $self->{'toc_exp'};	     
-      }
-      if($body_text =~ /$toc_exp/){                      	
-        $mainpage_toc = $&;
-      }
-        
-      if($mainpage_toc =~ /\S/) {
-        
-        # change the in-page links to relative links, for example, change <a href="#section1"> to 
-        # <a href="_httpquery_&a=extlink&rl=1&href=http://www.mediawikisite.com/Main_Page.html#section1">           
-        my $file_url_format = $file;
-        $file_url_format =~ s/\\/\//isg; 
-	$file_url_format = "http://" . $file_url_format;
-	   
-        # encode as URL, otherwise doesn't work on Windows
-        $file_url_format =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
-	$mainpage_toc =~ s/<a href="([^>"#]*)#([^>"]*)"/<a href="_httpquery_&a=extlink&rl=1&href=$file_url_format#$2"/isg;
-        
-        
-        # read the collection's extra.dm    
-        my $macro_path = $base_dir;
-        $macro_path =~ s/import$/macros/;    	
-    	my $extradm_file = &util::filename_cat($macro_path, "extra.dm");        
-        
-        my $extra_dm = "";
-        if(open(INPUT, "<$extradm_file")){    	            
-	    while(my $line = <INPUT>){
-		$extra_dm .= $line;
-	    }	    	
-        } else {
-            print $outhandle "can't open file $extradm_file\n";
-        }
-        close(INPUT);
-        
-        # check whether we have changed the macros
-        my @packages = split("package ", $extra_dm);
-        my $about_package = "";
-        foreach my $package (@packages) {
-          $about_package = "package " . $package if($package =~ /^about/);
-        }      
-                
-        my $update_extra_dm = 0;        
-        
-        if( $about_package =~ /\S/ && $about_package =~ m/_content_(\s*){/ && $about_package =~ m/$mainpage_toc/){  
-	   print $outhandle "_content_ macro already changed!!!!\n";
-	}
-        # if extra.dm doesn't have an "about package"
-        elsif ($about_package !~ /\S/) {          
-          # read _content_ macro from $GSDLHOME/macros/about.dm file          
-	  my $global_about_package = &read_content_from_about_dm();	    
-            
-          # create the extra _content_ macro for this collection           
-          # add the original content of the _content_ macro
-          $global_about_package =~ m/{(.|\n)*<\/div>\n\n/;
-          
-          # append the new about package to extra.dm
-          $extra_dm .= "\n\npackage about\n_content_$&\n\n";
-          $extra_dm .= "<div class=\"section\">\n$mainpage_toc\n</div>\n</div>\n}";
-          
-          $update_extra_dm = 1;
-        } 
-        # the about package exists, but either doesn't have the _content_ macro or 
-        # the _content_ macro doesn't contain the toc
-        else {        
-          # check if there is a content macro   
-          my $content_macro_existed = 0;
-          $content_macro_existed = ($about_package =~ /(\s*|\n)_content_(\s*){/);
-            
-          # if there is one
-          # append a new section div for toc to the end of the document section                    
-          if($content_macro_existed ==1) {
-            $about_package =~ /(\s*|\n)_content_(\s*){(.|\n)*?}/;
-            my $content_macro = $&;                          
-            my $new_content_macro = $content_macro;
-            $new_content_macro =~ s/<div[^>]*class="document">(.|\n)*<\/div>/<div$1class="document">$2\n\n<div class="section">\n$mainpage_toc\n<\/div>\n<\/div>/;              
-            $extra_dm =~ s/$content_macro/$new_content_macro/mg;                                    
-          }
-          # otherwise, append _content_ macro to the about package
-          else {
-            my $new_about_package = $about_package;            
-            $content_macro = &read_content_from_about_dm();
-            $content_macro =~ m/{(.|\n)*<\/div>\n\n/;            
-            
-            $new_about_package .= "\n\n_content_$&\n\n";
-            $new_about_package .= "<div class=\"section\">\n$mainpage_toc\n</div>\n</div>\n}";              
-            $extra_dm =~ s/$about_package/$new_about_package/mg;   
-          } 
-          
-          # either the case, we need to update the extra.dm         
-          $update_extra_dm = 1;
-         }          
-                  
-         if($update_extra_dm==1){
-            # write to the extra.dm file of the collection
-            if (open(OUTPUT, ">$extradm_file")) {
-                print OUTPUT $extra_dm;
-            } else {
-                print "can't open $extradm_file\n";
-            }
-            close(OUTPUT);
-         }
-      } else {
-        print $outhandle "Main_Page doesn't have a table-of-contents section\n";
-      }
-    }
-	
-    # If delete_toc is set, remove toc and tof contents.    
-    if (defined $self->{'delete_toc'} && ($self->{'delete_toc'} == 1)){
-	if (defined $self->{'toc_exp'} && $self->{'toc_exp'} =~ /\S/){		
-          # print "\nit matches toc_exp !!\n" if $body_text =~ /$self->{'toc_exp'}/;
-          if ($body_text =~ /$self->{'toc_exp'}/) {
-	    $body_text =~ s/$self->{'toc_exp'}//i;	    
-          }
-	}
-    }        
-    
-    $$textref = "<body" . $body_text;
-    
-    # Wrap the whole page with <div id="wikispecificstyle"></div>
-    # keep the style of this website and don't mess up with the Greenstone styles
-    $$textref =~ s/<body([^>]*)>/$&\n<div id="wikispecificstyle">\n/is;
-    $$textref =~ s/<\/body>/<\/div><\/body>/is;     
-	       
-    $self->SUPER::process(@_);
-    
-    return 1;
-}
-
-
-sub extract_metadata 
-{
-    my $self = shift (@_);
-    my ($textref, $metadata, $doc_obj) = @_;
-    my $outhandle = $self->{'outhandle'};
-    
-    return if (!defined $textref);
-
-    # metadata fields to extract/save. 'key' is the (lowercase) name of the
-    # html meta, 'value' is the metadata name for greenstone to use
-    my %find_fields = ();
-    my ($tag,$value);
-
-    my $orig_field = "";
-    foreach my $field (split /,/, $self->{'metadata_fields'}) {
-	# support tag<tagname>
-	if ($field =~ /^(.*?)<(.*?)>$/) {
-	    # "$2" is the user's preferred gs metadata name
-	    $find_fields{lc($1)}=$2; # lc = lowercase
-	    $orig_field = $1;
-	} else { # no <tagname> for mapping
-	    # "$field" is the user's preferred gs metadata name
-	    $find_fields{lc($field)}=$field; # lc = lowercase
-	    $orig_field = $field;
-	}
-
-	if ($textref =~ m/<o:$orig_field>(.*)<\/o:$orig_field>/i){
-	    $tag = $orig_field;
-	    $value = $1;
-	    if (!defined $value || !defined $tag){
-		#print $outhandle "StructuredHTMLPlug: can't find VALUE in \"$tag\"\n";
-		next;
-	    } else {
-		# clean up and add
-		chomp($value); # remove trailing \n, if any
-		$tag = $find_fields{lc($tag)};
-		#print $outhandle " extracted \"$tag\" metadata \"$value\"\n" 
-		#    if ($self->{'verbosity'} > 2);
-		$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), $tag, $value);
-	    }
-	}
-    }
-}
-
-sub safe_escape_regexp
-{
-  my $regexp = shift (@_);
-  
-  # if ($ENV{'GSDLOS'} =~ /^windows$/i) {
-    $regexp =~ s/\\/\\\\/isg;    
-  #} else {
-    $regexp =~ s/\//\\\//isg;         
-  #}
-  return $regexp;
-}
-
-sub read_content_from_about_dm
-{
-  my $about_macro_file = &util::filename_cat($ENV{'GSDLHOME'}, "macros", "about.dm");
-  my $about_page_content = "";
-  if (open(INPUT, "<$about_macro_file")){
-    while (my $line=<INPUT>){
-      $about_page_content .= $line;
-    }
-  } else {
-    print $outhandle "can't open file $about_macro_file\n";
-  }    		
-  close(INPUT);
-            
-  # extract the _content_ macro
-  $about_page_content =~ m/_content_ {(.|\n)*<\/div>\n\n<\/div>\n}/i;
-  $about_page_content = $&;
-  
-  return $about_page_content;
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/MediaWikiPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/MediaWikiPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/MediaWikiPlugin.pm	(revision 15865)
@@ -0,0 +1,666 @@
+###########################################################################
+#
+# MediaWikiPlug.pm -- html plugin with extra facilities for wiki page 
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999 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.
+#
+###########################################################################
+# This plugin is to process an HTML file from a MediaWiki website which downloaded by 
+# the MediaWikiDownload plug. This plugin will trim MediaWiki functional sections like 
+# login, discussion, history, etc. Only the navigation and search section could be preserved. 
+# Searchbox will be modified to search the Greenstone collection instead of the website.
+# It also can automatically add the table of contents on the website's Main_Page to the 
+# collection's Home page. 
+
+package MediaWikiPlug;
+
+use HTMLPlug;
+# use ImagePlug;
+# use File::Copy;
+use unicode;
+
+
+#use strict; # every perl program should have this!
+#no strict 'refs'; # make an exception so we can use variables as filehandles
+
+sub BEGIN {
+    @MediaWikiPlug::ISA = ('HTMLPlug');        
+}
+
+my $arguments = 
+    [          
+     # show the table of contents on collection's home page
+     { 'name' => "show_toc",
+       'desc' => "{MediaWikiPlug.show_toc}",
+       'type' => "flag",
+       'reqd' => "no"},
+     # set to delete the table of contents section on each MediaWiki page
+     { 'name' => "delete_toc",
+       'desc' => "{MediaWikiPlug.delete_toc}",
+       'type' => "flag",
+       'reqd' => "no"},
+     # regexp to match the table of contents
+     { 'name' => "toc_exp",
+       'desc' => "{MediaWikiPlug.toc_exp}",
+       'type' => "regexp",
+       'reqd' => "no",
+       'deft' => "<table([^>]*)id=(\\\"|')toc(\\\"|')(.|\\n)*?</table>\\n" },        
+     # set to delete the navigation section
+     { 'name' => "delete_nav",
+       'desc' => "{MediaWikiPlug.delete_nav}",
+       'type' => "flag",
+       'reqd' => "no",
+       'deft' => ""}, 
+     # regexp to match the navigation section    
+     { 'name' => "nav_div_exp",
+       'desc' => "{MediaWikiPlug.nav_div_exp}",
+       'type' => "regexp",
+       'reqd' => "no",
+       'deft' => "<div([^>]*)id=(\\\"|')p-navigation(\\\"|')(.|\\n)*?<\/div>" },
+     # set to delete the searchbox section
+     { 'name' => "delete_searchbox",
+       'desc' => "{MediaWikiPlug.delete_searchbox}",
+       'type' => "flag",
+       'reqd' => "no",
+       'deft' => ""},
+     # regexp to match the searchbox section
+     { 'name' => "searchbox_div_exp",
+       'desc' => "{MediaWikiPlug.searchbox_div_exp}",
+       'type' => "regexp",
+       'reqd' => "no",
+       'deft' => "<div([^>]*)id=(\\\"|')p-search(\\\"|')(.|\\n)*?<\/div>"},     
+     # regexp to match title suffix
+     # can't use the title_sub option in HTMLPlug instead
+     # because title_sub always matches from the begining      
+     { 'name' => "remove_title_suffix_exp",
+       'desc' => "{MediaWikiPlug.remove_title_suffix_exp}",
+       'type' => "regexp",
+       'reqd' => "no",
+       'deft' => ""}
+     ];
+
+my $options = { 'name'     => "MediaWikiPlug",
+		'desc'     => "{MediaWikiPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+    
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+    
+    my $self = new HTMLPlug($pluginlist, $inputargs, $hashArgOptLists);    
+    return bless $self, $class;
+}
+
+
+
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    print $outhandle "MediaWikiPlug: processing $file\n" if $self->{'verbosity'} > 1;
+          
+    my @head_and_body = split(/<body/i,$$textref);
+    my $head = shift(@head_and_body);
+    my $body_text = join("<body", @head_and_body);      
+    
+    $head =~ m/<title>(.+)<\/title>/i;
+    my $doctitle = $1 if defined $1;    
+    
+    if (defined $self->{'metadata_fields'} && $self->{'metadata_fields'}=~ /\S/) {
+	my @doc_properties = split(/<xml>/i,$head);
+	my $doc_heading = shift(@doc_properties);
+	my $rest_doc_properties = join(" ", @doc_properties);
+	
+	my @extracted_metadata = split(/<\/xml>/i, $rest_doc_properties);
+	my $extracted_metadata = shift (@extracted_metadata);
+	$self->extract_metadata($extracted_metadata, $metadata, $doc_obj);
+    }
+    
+    # set the title here if we haven't found it yet
+    if (!defined $doc_obj->get_metadata_element ($doc_obj->get_top_section(), "Title")) {    
+	if (defined $doctitle && $doctitle =~ /\S/) {        	    
+            # remove suffix in title if required
+            my $remove_suffix_exp = $self->{'remove_title_suffix_exp'};
+	    if (defined $remove_suffix_exp && $remove_suffix_exp =~ /\S/){
+	       $doctitle =~ s/$remove_suffix_exp//i;
+	    }	    
+	    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Title", $doctitle);
+	} else {
+	    $self->title_fallback($doc_obj,$doc_obj->get_top_section(),$file);
+	}
+    }
+
+    # we are only interested in the column-contents div <div id="column-content">
+    # remove header section, it may contain header images or additional search boxes
+    my $header_exp = "<div([^>]*)id=(\"|')container(\"|')([^>]*)>(.|\\n)*<div([^>]*)id=(\"|')column-content";
+    if($body_text =~ /$header_exp/){
+	    $body_text =~ s/$header_exp/<div$1id='container'$4><div$6id='column-content/isg;
+	} else {				
+		$header_exp = "(.|\\n)*?<div([^>]*)?id=(\"|')column-content";
+                if($body_text =~ /$header_exp/){
+                  $body_text =~ s/$header_exp/<div$2id='column-content/i;                
+                }
+	}
+    
+    # remove timeline
+    $body_text =~ s/<div([^>]*)class=("|')smwtimeline("|')[\s\S]*?<\/div>//mg;
+    
+    # remove extra bits
+    my $extra_bits = "Retrieved from(.+)</a>\"";
+    $body_text =~ s/$extra_bits//isg;
+    
+    $body_text =~ s/(<p[^>]*><span[^>]*><o:p>&nbsp;<\/o:p><\/span><\/p>)//isg;
+    $body_text =~ s/(<p[^>]*><o:p>&nbsp;<\/o:p><\/p>)//isg;
+    $body_text =~ s/<!\[if !vml\]>/<![if vml]>/g; 
+    $body_text =~ s/(&nbsp;)+/&nbsp;/sg;
+    
+    # get rid of the [edit] buttons
+    $body_text =~ s/\[<a([^>]*)>edit<\/a>]//g;
+    # get rid of the last time edit information at the bottom
+    $body_text =~ s/<a href="([^>]*)edit([^>]*)"([^>]*?)>(\w+)<\/a> \d\d:\d\d,([\s|\w]*?)\(PST\)//g;    
+    # get rid of the (Redirected from ...)
+    $body_text =~ s/\(Redirected from <a ([^>]*)>(\w|\s)*?<\/a>\)//isg;  
+    
+    # escape texts macros
+    $body_text =~ s/_([^\s]*)_/_<span>$1<\/span>_/isg;
+    # may change the links, like Greenstone_Documentation_All.html, then change back
+    $body_text =~ s/<a([^>]*)_<span>([^>]*)<\/span>_/<a$1_$2_/isg;
+    
+    # define file delimiter for different platforms
+    my $file_delimiter;
+    if ($ENV{'GSDLOS'} =~ /^windows$/i) {
+       $file_delimiter = "\\";
+    } else {
+       $file_delimiter = "/";	        
+    }    
+    
+    # IMPORTANT: different delimiter for $base_dir and $file
+    # $base_dir use forward slash for both windows and linux
+    # print "\nbase_dir : $base_dir\n\n"; # windows: C:/Program Files/Greenstone2.73/collect/wiki/import    
+                                        # linux: /research/lh92/greenstone/greenstone2.73/collect/wiki/import
+    # $file use different delimiters : forward slash for linux; backward slash for windows
+    # print "\nfile : $file\n\n";         # windows: greenstone.sourceforge.net\wiki\index.php\Access_Processing_using_DBPlug.html    
+                                        # linux: greenstone.sourceforge.net/wiki/index.php/Using_GreenstoneWiki.html
+    
+    # get the base url for the MediaWiki website
+    my $safe_delimiter = &safe_escape_regexp($file_delimiter);
+    my @url_dirs=split($safe_delimiter, $file);
+    my $url_base = $url_dirs[0];    
+        
+    # Re-check css files associated with MediaWiki pages
+    if(defined $base_dir && $base_dir ne ""){ 	
+	my @css_files;
+	my $css_file_count = 0;
+	
+	# find all the stylesheets imported with @import statement	
+	while($head =~ m"<style type=\"text/css\"(.+)import \"(.+)\""ig){
+	    $css_files[$css_file_count++] = $2 if defined $2;
+	}
+	    
+	# download the stylesheets if we haven't downloaded them yet
+        # add prefix to each style elmement, comment out the body element
+        # and copy the files to collection's images folder 
+	for ($css_file_count = 0; $css_file_count < scalar(@css_files); $css_file_count++) {	    
+	    
+	    my $css_file = $css_files[$css_file_count];	      
+	    
+	    # remove prefix gli/cache directory	                
+            $css_file =~ s/^(.+)gli(\\|\/)cache(\\|\/)//i;
+                        
+            # change the \ delimiter in $css_file to / for consistency
+            $css_file =~ s/\\/\//isg;
+            if($css_file !~ /$url_base/) {
+              $css_file = $url_base . $css_file;  
+            }
+            
+            # trim the ? mark append to the end of a stylesheet
+	    $css_file =~ s/\?(.+)$//isg;  
+	   
+            my $css_file_path = &util::filename_cat($base_dir, $css_file);	    
+	    
+	    # do nothing if we have already downloaded the css files
+	    if (! -e $css_file_path) {		
+	     
+             # check the stylesheet's directory in the import folder
+             # if the directory doesn't exist, create one            
+	     my @dirs = split(/\//i,$css_file);	    
+	     my $path_check = "$base_dir/";            
+	     for (my $i = 0; $i < (scalar(@dirs)-1); $i++) {
+		$path_check .= $dirs[$i] . "/";	
+		mkdir($path_check) if (! -d $path_check );
+	     }
+	     
+             # NOTE: wget needs configuration to directly access Internet
+             # These files should already downloaded if we used the MediaWikiDownload             
+	     # downloading            
+	     $css_file = "http://$css_file";	    
+             print "\ndownloading : " . $css_file . "\n\n";
+	     system("wget", "--non-verbose", "$css_file", "--output-document=$css_file_path");
+	     if ($? != 0) {
+              print "[ERROR] Download Failed! Make sure WGet connects to Internet directly \n";
+              print "[ERROR] OR ues the MediaWikiDownload in the GLI DownloadPanel to download from a MediaWiki website\n";
+              unlink("$css_file_path");
+             }
+            } # done with download
+		
+	    # add a prefix "#wikispecificstyle" to each element
+	    # because we want to preserve this website's formats and don't want to mess up with Greenstone formats
+            # so we will wrap the web page with a div with id = wikispecificstyle
+            my $css_content;
+	    if(open(INPUT, "<$css_file_path")){		
+		while(my $line = <INPUT>){
+                    # comment out the body element because we change the body to div
+                    $line =~ s/^(\s*)body(\s*){(\s*)$/$1\/*body$2*\/{$3/isg;
+                    
+                    if($line =~ m/^(.+)\{/i || $line =~ m/^(\s)*#/i){                    
+                      if($line !~ m/wikispecificstyle/i){
+                        $line = "#wikispecificstyle " . $line;
+                      } 
+                    }
+                    
+		    $css_content .= $line;
+		}
+		close(INPUT);			
+		open(OUTPUT, ">$css_file_path");
+		print OUTPUT $css_content;
+		close(OUTPUT);
+	    }
+            
+            # Copy the modified stylesheets to collection's images folder
+            # for future customization
+            my $images_dir = $base_dir;
+            $images_dir =~ s/import$/images/;
+            $css_file =~ m/(.*)\/(.*)$/;
+            $images_dir = &util::filename_cat($images_dir, $2);            
+            
+            if(open(OUTPUT, ">$images_dir")){	
+              print OUTPUT $css_content;
+              close(OUTPUT);
+            }
+	}
+    }    
+    
+    
+    # by default, only preserve navigation box and search box
+    # others like toolbox, interaction, languages box, will be removed  
+    
+    # extract the larger part -- footer section
+    my $print_footer = "<div class=\"printfooter\">(.|\n)+</body>";
+    $body_text =~ /$print_footer/;
+    my $footer = "";
+    $footer = $& if defined $&;
+    $footer =~ s/<\/body>//isg;
+    
+    # trim the comments first    
+    $footer =~ s/<!--[\s\S]*?--[ \t\n\r]*>//isg;
+    
+    # contain sections that are to be preserved
+    my $preserve_sections = "";   
+    
+    # process the navigation section    
+    my $nav_match_exp = "<div([^>]*)id=(\"|')p-navigation(\"|')(.|\n)*?<\/div>";
+    if (defined $self->{'nav_div_exp'}) {
+      $nav_match_exp = $self->{'nav_div_exp'} if ($self->{'nav_div_exp'} =~ /\S/) ;
+    }
+        
+    if (defined $self->{'delete_nav'} && ($self->{'delete_nav'} eq "1")) {	
+        # do nothing	
+    } else {      
+      if ($footer =~ m/$nav_match_exp/ig) {
+        $preserve_sections = $& ;
+      } else {
+        print $outhandle "Can't find the navigation section with : $nav_match_exp\n";
+      }
+      # if($preserve_sections =~/\S/){
+      #  $preserve_sections .= "</div>";
+      # }            
+    }          
+            
+    # process the searchbox section        
+    my $searchbox_exp = "<div([^>]*)id=(\"|')p-search(\"|')(.|\\n)*?<\/div>";
+    if(defined $self->{'searchbox_div_exp'}) {                
+        $searchbox_exp = $self->{'searchbox_div_exp'} if ($self->{'searchbox_div_exp'} =~ /\S/);
+    }    
+                        
+    my $searchbox_section = "";    
+    $footer =~ m/$searchbox_exp/ig;
+    $searchbox_section = $& if defined $&;    
+    
+    # make the searchbox form work in Greenstone
+    if($searchbox_section =~ /\S/){        
+        # replace action
+        $searchbox_section =~ s/action="([^>]*)"/action="_gwcgi_"/isg;
+                
+        # remove buttons
+        $searchbox_section =~ s/name="search"/name="q"/isg;
+        $searchbox_section =~ s/name="go"//isg;
+        $searchbox_section =~ s/name="fulltext"//isg;
+                
+        # get collection name from $base_dir for c param        
+        $base_dir =~ m/\/collect\/(.+)\//i;
+        my $collection_name = "";
+        $collection_name = $1 if defined $1;
+        
+        # add Greenstone search params
+        my $hidden_params = "<input type=\"hidden\" name=\"a\" value=\"q\"/>\n" 
+            ."<input type=\"hidden\" name=\"c\" value=\"$collection_name\"/>\n";
+            # ."<input type=\"hidden\" name=\"fqf\" value=\"TX\"/>\n"
+            # ."<input type=\"hidden\" name=\"r\" value=\"1\">\n";
+        
+        $searchbox_section =~ s/<form([^>]*)>/<form$1>\n$hidden_params/isg;         
+        
+        # $searchbox_section .= "</div>";
+    } else {
+      print $outhandle "Can't find the searchbox section with : $searchbox_section\n";
+    }        
+    
+    # either delete or replace the searchbox 
+    if(defined $self->{'delete_searchbox'} && $self->{'delete_searchbox'} eq "1") {
+        # do nothing        
+    } else {
+        $preserve_sections .= "\n$searchbox_section\n";
+    } 
+    
+    if($preserve_sections ne ""){
+      $preserve_sections = "<div id=\"column-one\">\n" . $preserve_sections . "\n</div>\n";
+    }
+    $preserve_sections = "</div></div></div>\n" . $preserve_sections . "\n</body>";   
+            
+    $body_text =~ s/$print_footer/$preserve_sections/isg;
+    
+    
+    # delete other forms in the page
+    my @forms;
+    my $form_count = 0;
+    while($body_text =~ m/<form([^>]*)name=("|')([^>"']*)?("|')/isg){
+        next if($3 eq "searchform");
+        $forms[$form_count++] = $&;        
+    }
+    foreach my $form (@forms) {      
+      $body_text =~ s/$form[\s\S]*?<\/form>//m;
+    }
+    
+    # process links. 
+    # because current WGET 1.10 the -k and -E option doesn't work together
+    # need to 'manually' convert the links to relative links
+    # Dealing with 3 types of links:
+    # -- outgoing links
+    #   -- if we have downloaded the target files, link to the internal version (relative link)
+    #   -- otherwise, link to the external version (absolute links)
+    # -- in-page links (relative link)
+    
+    # NOTE: (important)
+    #   must use the MediaWikiDownload in GLI Download Panel to download files from a MediaWiki website
+    #   otherwise, the internal links may have problems
+    
+    # remove the title attribute of <a> tag
+    $body_text =~ s/<a([^>]*)title="(.*?)"/<a$1/isg;
+    
+    # extract all the links
+    my @links;
+    my $link_count = 0;    
+    while($body_text =~ m/(href|src)="([^>\s]*)$url_base\/([^>\s]*)"/ig){        
+        $links[$link_count++] = "$1=\"$2$url_base/$3\"";		
+    }
+    
+    foreach my $cur_link (@links) {     
+        # escape greedy match + character
+        $cur_link =~ s/\+/\\+/isg;
+        
+        $cur_link =~ m/(.+)"([^>]*)$url_base\/([^>\s]*)"/;          
+        my $external_file_path = "$1\"http://$url_base/$3\"";
+           
+        $body_text =~ s/$cur_link/$external_file_path/i; 
+    }
+             
+    # tag links to new wiki pages as red    
+    $body_text =~ s/<a([^>]*)class="new"([^>]*)>/<a$1style="color:red"$2)>/gi;
+    
+    # tag links to pages external of the MediaWiki website as blue
+    $body_text =~ s/<a([^>]*)class='external text'([^>]*)>/<a$1style="color:blue"$2)>/gi;
+        
+    
+    # process the table-of-contents section
+    # if 'show_toc' is set, add Main_Page's toc to the collection's About page, change extra.dm file     
+    # 1. read _content_ macro from about.dm
+    # 2. append the toc, change all links to the Greenstone internal format for relative links 
+    # 3. write to the extra.dm
+    # TODO: we assume the _about:content_ hasn't been specified before
+    #	    so needs to add function to handle when the macro is already in the extra.dm	   
+    if($self->{'show_toc'}==1 && $file =~ m/Main_Page.(html|htm)$/){
+    
+      # extract toc of the Main_Page           	 
+      my $mainpage_toc = "";  
+      my $toc_exp = "<table([^>]*)id=(\"|')toc(\"|')(.|\\n)*</table>\\n";
+      if($self->{'toc_exp'} =~ /\S/){
+         $toc_exp = $self->{'toc_exp'};	     
+      }
+      if($body_text =~ /$toc_exp/){                      	
+        $mainpage_toc = $&;
+      }
+        
+      if($mainpage_toc =~ /\S/) {
+        
+        # change the in-page links to relative links, for example, change <a href="#section1"> to 
+        # <a href="_httpquery_&a=extlink&rl=1&href=http://www.mediawikisite.com/Main_Page.html#section1">           
+        my $file_url_format = $file;
+        $file_url_format =~ s/\\/\//isg; 
+	$file_url_format = "http://" . $file_url_format;
+	   
+        # encode as URL, otherwise doesn't work on Windows
+        $file_url_format =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
+	$mainpage_toc =~ s/<a href="([^>"#]*)#([^>"]*)"/<a href="_httpquery_&a=extlink&rl=1&href=$file_url_format#$2"/isg;
+        
+        
+        # read the collection's extra.dm    
+        my $macro_path = $base_dir;
+        $macro_path =~ s/import$/macros/;    	
+    	my $extradm_file = &util::filename_cat($macro_path, "extra.dm");        
+        
+        my $extra_dm = "";
+        if(open(INPUT, "<$extradm_file")){    	            
+	    while(my $line = <INPUT>){
+		$extra_dm .= $line;
+	    }	    	
+        } else {
+            print $outhandle "can't open file $extradm_file\n";
+        }
+        close(INPUT);
+        
+        # check whether we have changed the macros
+        my @packages = split("package ", $extra_dm);
+        my $about_package = "";
+        foreach my $package (@packages) {
+          $about_package = "package " . $package if($package =~ /^about/);
+        }      
+                
+        my $update_extra_dm = 0;        
+        
+        if( $about_package =~ /\S/ && $about_package =~ m/_content_(\s*){/ && $about_package =~ m/$mainpage_toc/){  
+	   print $outhandle "_content_ macro already changed!!!!\n";
+	}
+        # if extra.dm doesn't have an "about package"
+        elsif ($about_package !~ /\S/) {          
+          # read _content_ macro from $GSDLHOME/macros/about.dm file          
+	  my $global_about_package = &read_content_from_about_dm();	    
+            
+          # create the extra _content_ macro for this collection           
+          # add the original content of the _content_ macro
+          $global_about_package =~ m/{(.|\n)*<\/div>\n\n/;
+          
+          # append the new about package to extra.dm
+          $extra_dm .= "\n\npackage about\n_content_$&\n\n";
+          $extra_dm .= "<div class=\"section\">\n$mainpage_toc\n</div>\n</div>\n}";
+          
+          $update_extra_dm = 1;
+        } 
+        # the about package exists, but either doesn't have the _content_ macro or 
+        # the _content_ macro doesn't contain the toc
+        else {        
+          # check if there is a content macro   
+          my $content_macro_existed = 0;
+          $content_macro_existed = ($about_package =~ /(\s*|\n)_content_(\s*){/);
+            
+          # if there is one
+          # append a new section div for toc to the end of the document section                    
+          if($content_macro_existed ==1) {
+            $about_package =~ /(\s*|\n)_content_(\s*){(.|\n)*?}/;
+            my $content_macro = $&;                          
+            my $new_content_macro = $content_macro;
+            $new_content_macro =~ s/<div[^>]*class="document">(.|\n)*<\/div>/<div$1class="document">$2\n\n<div class="section">\n$mainpage_toc\n<\/div>\n<\/div>/;              
+            $extra_dm =~ s/$content_macro/$new_content_macro/mg;                                    
+          }
+          # otherwise, append _content_ macro to the about package
+          else {
+            my $new_about_package = $about_package;            
+            $content_macro = &read_content_from_about_dm();
+            $content_macro =~ m/{(.|\n)*<\/div>\n\n/;            
+            
+            $new_about_package .= "\n\n_content_$&\n\n";
+            $new_about_package .= "<div class=\"section\">\n$mainpage_toc\n</div>\n</div>\n}";              
+            $extra_dm =~ s/$about_package/$new_about_package/mg;   
+          } 
+          
+          # either the case, we need to update the extra.dm         
+          $update_extra_dm = 1;
+         }          
+                  
+         if($update_extra_dm==1){
+            # write to the extra.dm file of the collection
+            if (open(OUTPUT, ">$extradm_file")) {
+                print OUTPUT $extra_dm;
+            } else {
+                print "can't open $extradm_file\n";
+            }
+            close(OUTPUT);
+         }
+      } else {
+        print $outhandle "Main_Page doesn't have a table-of-contents section\n";
+      }
+    }
+	
+    # If delete_toc is set, remove toc and tof contents.    
+    if (defined $self->{'delete_toc'} && ($self->{'delete_toc'} == 1)){
+	if (defined $self->{'toc_exp'} && $self->{'toc_exp'} =~ /\S/){		
+          # print "\nit matches toc_exp !!\n" if $body_text =~ /$self->{'toc_exp'}/;
+          if ($body_text =~ /$self->{'toc_exp'}/) {
+	    $body_text =~ s/$self->{'toc_exp'}//i;	    
+          }
+	}
+    }        
+    
+    $$textref = "<body" . $body_text;
+    
+    # Wrap the whole page with <div id="wikispecificstyle"></div>
+    # keep the style of this website and don't mess up with the Greenstone styles
+    $$textref =~ s/<body([^>]*)>/$&\n<div id="wikispecificstyle">\n/is;
+    $$textref =~ s/<\/body>/<\/div><\/body>/is;     
+	       
+    $self->SUPER::process(@_);
+    
+    return 1;
+}
+
+
+sub extract_metadata 
+{
+    my $self = shift (@_);
+    my ($textref, $metadata, $doc_obj) = @_;
+    my $outhandle = $self->{'outhandle'};
+    
+    return if (!defined $textref);
+
+    # metadata fields to extract/save. 'key' is the (lowercase) name of the
+    # html meta, 'value' is the metadata name for greenstone to use
+    my %find_fields = ();
+    my ($tag,$value);
+
+    my $orig_field = "";
+    foreach my $field (split /,/, $self->{'metadata_fields'}) {
+	# support tag<tagname>
+	if ($field =~ /^(.*?)<(.*?)>$/) {
+	    # "$2" is the user's preferred gs metadata name
+	    $find_fields{lc($1)}=$2; # lc = lowercase
+	    $orig_field = $1;
+	} else { # no <tagname> for mapping
+	    # "$field" is the user's preferred gs metadata name
+	    $find_fields{lc($field)}=$field; # lc = lowercase
+	    $orig_field = $field;
+	}
+
+	if ($textref =~ m/<o:$orig_field>(.*)<\/o:$orig_field>/i){
+	    $tag = $orig_field;
+	    $value = $1;
+	    if (!defined $value || !defined $tag){
+		#print $outhandle "StructuredHTMLPlug: can't find VALUE in \"$tag\"\n";
+		next;
+	    } else {
+		# clean up and add
+		chomp($value); # remove trailing \n, if any
+		$tag = $find_fields{lc($tag)};
+		#print $outhandle " extracted \"$tag\" metadata \"$value\"\n" 
+		#    if ($self->{'verbosity'} > 2);
+		$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), $tag, $value);
+	    }
+	}
+    }
+}
+
+sub safe_escape_regexp
+{
+  my $regexp = shift (@_);
+  
+  # if ($ENV{'GSDLOS'} =~ /^windows$/i) {
+    $regexp =~ s/\\/\\\\/isg;    
+  #} else {
+    $regexp =~ s/\//\\\//isg;         
+  #}
+  return $regexp;
+}
+
+sub read_content_from_about_dm
+{
+  my $about_macro_file = &util::filename_cat($ENV{'GSDLHOME'}, "macros", "about.dm");
+  my $about_page_content = "";
+  if (open(INPUT, "<$about_macro_file")){
+    while (my $line=<INPUT>){
+      $about_page_content .= $line;
+    }
+  } else {
+    print $outhandle "can't open file $about_macro_file\n";
+  }    		
+  close(INPUT);
+            
+  # extract the _content_ macro
+  $about_page_content =~ m/_content_ {(.|\n)*<\/div>\n\n<\/div>\n}/i;
+  $about_page_content = $&;
+  
+  return $about_page_content;
+}
+
+1;
Index: dl/trunk/perllib/plugins/MetadataCSVPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/MetadataCSVPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,178 +1,0 @@
-###########################################################################
-#
-# MetadataCSVPlug.pm -- A plugin for metadata in comma-separated value format
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright 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 MetadataCSVPlug;
-
-
-use BasPlug;
-use strict;
-
-
-sub BEGIN {
-    @MetadataCSVPlug::ISA = ('BasPlug');
-}
-
-
-my $arguments =
-    [ { 'name' => "block_exp",
-	'desc' => "{BasPlug.block_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_block_exp() } ];
-
-
-my $options = { 'name'     => "MetadataCSVPlug",
-		'desc'     => "{MetadataCSVPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-
-sub new
-{
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-
-# Not used, just here to prevent a warning
-sub get_default_process_exp
-{
-    return q^(?i)\.csv$^;
-}
-
-
-# We don't want any other plugins to see .csv files
-sub get_default_block_exp
-{
-    return q^(?i)\.csv$^;
-}
-
-
-sub metadata_read
-{
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli) = @_;
-
-    # Read metadata from CSV files
-    my $filename = &util::filename_cat($base_dir, $file);
-    if ($filename !~ /\.csv$/ || !-f $filename) {
-	return undef;
-    }
-    print STDERR "\n<Processing n='$file' p='MetadataCSVPlug'>\n" if ($gli);
-    print STDERR "MetadataCSVPlug: processing $file\n" if ($self->{'verbosity'}) > 1;
-
-    # Read the CSV file to get the metadata
-    my $csv_file_content;
-    open(CSV_FILE, "$filename");
-    my $csv_file_reader = new multiread();
-    $csv_file_reader->set_handle('MetadataCSVPlug::CSV_FILE');
-    $csv_file_reader->read_file(\$csv_file_content);
-    close(CSV_FILE);
-
-    # Split the file into lines and read the first line (contains the metadata names)
-    $csv_file_content =~ s/\r/\n/g;  # Handle non-Unix line endings
-    $csv_file_content =~ s/\n+/\n/g;
-    my @csv_file_lines = split(/\n/, $csv_file_content);
-    my $csv_file_field_line = shift(@csv_file_lines);
-    my @csv_file_fields = split(/\,/, $csv_file_field_line);
-    my $found_filename_field = 0;
-    for (my $i = 0; $i < scalar(@csv_file_fields); $i++) {
-	# Remove any spaces from the field names
-	$csv_file_fields[$i] =~ s/ //g;
-	if ($csv_file_fields[$i] eq "Filename") {
-	    $found_filename_field = 1;
-	}
-    }
-
-    if (!$found_filename_field) {
-	print STDERR "MetadataCSVPlug Error: No Filename field in CSV file: $filename\n";
-	return -1; # error
-    }
-    # Read each line of the file and assign the metadata appropriately
-    foreach my $csv_line (@csv_file_lines) {
-	# Ignore lines containing only whitespace
-	next if ($csv_line =~ /^\s*$/);
-	my $orig_csv_line = $csv_line;
-	# Build a hash of metadata name to metadata value for this line
-	my %csv_line_metadata;
-	my $i = 0;
-	$csv_line .= ",";  # To make the regular expressions simpler
-	while ($csv_line ne "") {
-	    # Metadata values containing commas are quoted
-	    if ($csv_line =~ s/^\"(.*?)\"\,//) {
-		# Only bother with non-empty values
-		if ($1 ne "" && defined($csv_file_fields[$i])) {
-		    if (!defined $csv_line_metadata{$csv_file_fields[$i]}) {
-			$csv_line_metadata{$csv_file_fields[$i]} = [];
-		    }
-		    push (@{$csv_line_metadata{$csv_file_fields[$i]}}, $1);
-		}
-	    }
-	    # Normal comma-separated case
-	    elsif ($csv_line =~ s/^(.*?)\,//) {
-		# Only bother with non-empty values
-		if ($1 ne "" && defined($csv_file_fields[$i])) {
-		    if (!defined $csv_line_metadata{$csv_file_fields[$i]}) {
-			$csv_line_metadata{$csv_file_fields[$i]} = [];
-		    }
-		    push (@{$csv_line_metadata{$csv_file_fields[$i]}}, $1);
-		}
-	    }
-	    # The line must be formatted incorrectly
-	    else {
-		print STDERR "MetadataCSVPlug Error: Badly formatted CSV line: $csv_line.\n";
-		last;
-	    }
-
-	    $i++;
-	}
-
-	# We can't associate any metadata without knowing the file to associate it with
-	my $csv_line_filename_array = $csv_line_metadata{"Filename"};
-	if (!defined $csv_line_filename_array) {
-	    print STDERR "MetadataCSVPlug Error: No Filename metadata in CSV line: $orig_csv_line\n";
-	    next;
-	}
-	my $csv_line_filename = shift(@$csv_line_filename_array);
-	delete $csv_line_metadata{"Filename"};
-
- 	# Associate the metadata now
- 	$extrametadata->{$csv_line_filename} = \%csv_line_metadata;
- 	push(@$extrametakeys, $csv_line_filename);
-    }
-}
-
-
-1;
Index: /gsdl/trunk/perllib/plugins/MetadataCSVPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/MetadataCSVPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/MetadataCSVPlugin.pm	(revision 15865)
@@ -0,0 +1,178 @@
+###########################################################################
+#
+# MetadataCSVPlug.pm -- A plugin for metadata in comma-separated value format
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright 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 MetadataCSVPlug;
+
+
+use BasPlug;
+use strict;
+
+
+sub BEGIN {
+    @MetadataCSVPlug::ISA = ('BasPlug');
+}
+
+
+my $arguments =
+    [ { 'name' => "block_exp",
+	'desc' => "{BasPlug.block_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_block_exp() } ];
+
+
+my $options = { 'name'     => "MetadataCSVPlug",
+		'desc'     => "{MetadataCSVPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+
+sub new
+{
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+
+# Not used, just here to prevent a warning
+sub get_default_process_exp
+{
+    return q^(?i)\.csv$^;
+}
+
+
+# We don't want any other plugins to see .csv files
+sub get_default_block_exp
+{
+    return q^(?i)\.csv$^;
+}
+
+
+sub metadata_read
+{
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli) = @_;
+
+    # Read metadata from CSV files
+    my $filename = &util::filename_cat($base_dir, $file);
+    if ($filename !~ /\.csv$/ || !-f $filename) {
+	return undef;
+    }
+    print STDERR "\n<Processing n='$file' p='MetadataCSVPlug'>\n" if ($gli);
+    print STDERR "MetadataCSVPlug: processing $file\n" if ($self->{'verbosity'}) > 1;
+
+    # Read the CSV file to get the metadata
+    my $csv_file_content;
+    open(CSV_FILE, "$filename");
+    my $csv_file_reader = new multiread();
+    $csv_file_reader->set_handle('MetadataCSVPlug::CSV_FILE');
+    $csv_file_reader->read_file(\$csv_file_content);
+    close(CSV_FILE);
+
+    # Split the file into lines and read the first line (contains the metadata names)
+    $csv_file_content =~ s/\r/\n/g;  # Handle non-Unix line endings
+    $csv_file_content =~ s/\n+/\n/g;
+    my @csv_file_lines = split(/\n/, $csv_file_content);
+    my $csv_file_field_line = shift(@csv_file_lines);
+    my @csv_file_fields = split(/\,/, $csv_file_field_line);
+    my $found_filename_field = 0;
+    for (my $i = 0; $i < scalar(@csv_file_fields); $i++) {
+	# Remove any spaces from the field names
+	$csv_file_fields[$i] =~ s/ //g;
+	if ($csv_file_fields[$i] eq "Filename") {
+	    $found_filename_field = 1;
+	}
+    }
+
+    if (!$found_filename_field) {
+	print STDERR "MetadataCSVPlug Error: No Filename field in CSV file: $filename\n";
+	return -1; # error
+    }
+    # Read each line of the file and assign the metadata appropriately
+    foreach my $csv_line (@csv_file_lines) {
+	# Ignore lines containing only whitespace
+	next if ($csv_line =~ /^\s*$/);
+	my $orig_csv_line = $csv_line;
+	# Build a hash of metadata name to metadata value for this line
+	my %csv_line_metadata;
+	my $i = 0;
+	$csv_line .= ",";  # To make the regular expressions simpler
+	while ($csv_line ne "") {
+	    # Metadata values containing commas are quoted
+	    if ($csv_line =~ s/^\"(.*?)\"\,//) {
+		# Only bother with non-empty values
+		if ($1 ne "" && defined($csv_file_fields[$i])) {
+		    if (!defined $csv_line_metadata{$csv_file_fields[$i]}) {
+			$csv_line_metadata{$csv_file_fields[$i]} = [];
+		    }
+		    push (@{$csv_line_metadata{$csv_file_fields[$i]}}, $1);
+		}
+	    }
+	    # Normal comma-separated case
+	    elsif ($csv_line =~ s/^(.*?)\,//) {
+		# Only bother with non-empty values
+		if ($1 ne "" && defined($csv_file_fields[$i])) {
+		    if (!defined $csv_line_metadata{$csv_file_fields[$i]}) {
+			$csv_line_metadata{$csv_file_fields[$i]} = [];
+		    }
+		    push (@{$csv_line_metadata{$csv_file_fields[$i]}}, $1);
+		}
+	    }
+	    # The line must be formatted incorrectly
+	    else {
+		print STDERR "MetadataCSVPlug Error: Badly formatted CSV line: $csv_line.\n";
+		last;
+	    }
+
+	    $i++;
+	}
+
+	# We can't associate any metadata without knowing the file to associate it with
+	my $csv_line_filename_array = $csv_line_metadata{"Filename"};
+	if (!defined $csv_line_filename_array) {
+	    print STDERR "MetadataCSVPlug Error: No Filename metadata in CSV line: $orig_csv_line\n";
+	    next;
+	}
+	my $csv_line_filename = shift(@$csv_line_filename_array);
+	delete $csv_line_metadata{"Filename"};
+
+ 	# Associate the metadata now
+ 	$extrametadata->{$csv_line_filename} = \%csv_line_metadata;
+ 	push(@$extrametakeys, $csv_line_filename);
+    }
+}
+
+
+1;
Index: dl/trunk/perllib/plugins/MetadataXMLPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/MetadataXMLPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,293 +1,0 @@
-###########################################################################
-#
-# MetadataXMLPlug.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) 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.
-#
-###########################################################################
-
-# MetadataXMLPlug process metadata.xml files in a collection
-
-# Here's an example of a metadata file that uses three FileSet structures
-# (ignore the # characters):
-
-#<?xml version="1.0" encoding="UTF-8" standalone="no"?>
-#<!DOCTYPE DirectoryMetadata SYSTEM "http://greenstone.org/dtd/DirectoryMetadata/1.0/DirectoryMetadata.dtd">
-#<DirectoryMetadata>
-#  <FileSet>
-#    <FileName>nugget.*</FileName>
-#    <Description>
-#      <Metadata name="Title">Nugget Point, The Catlins</Metadata>
-#      <Metadata name="Place" mode="accumulate">Nugget Point</Metadata>
-#    </Description>
-#  </FileSet>
-#  <FileSet>
-#    <FileName>nugget-point-1.jpg</FileName>
-#    <Description>
-#      <Metadata name="Title">Nugget Point Lighthouse, The Catlins</Metadata>
-#      <Metadata name="Subject">Lighthouse</Metadata>
-#    </Description>
-#  </FileSet>
-#  <FileSet>
-#    <FileName>kaka-point-dir</FileName>
-#    <Description>
-#      <Metadata name="Title">Kaka Point, The Catlins</Metadata>
-#    </Description>
-#  </FileSet>
-#</DirectoryMetadata>
-
-# Metadata elements are read and applied to files in the order they appear
-# in the file.
-#
-# The FileName element describes the subfiles in the directory that the
-# metadata applies to as a perl regular expression (a FileSet group may
-# contain multiple FileName elements). So, <FileName>nugget.*</FileName>
-# indicates that the metadata records in the following Description block
-# apply to every subfile that starts with "nugget".  For these files, a
-# Title metadata element is set, overriding any old value that the Title
-# might have had.
-#
-# Occasionally, we want to have multiple metadata values applied to a
-# document; in this case we use the "mode=accumulate" attribute of the
-# particular Metadata element.  In the second metadata element of the first
-# FileSet above, the "Place" metadata is accumulating, and may therefore be
-# given several values.  If we wanted to override these values and use a
-# single metadata element again, we could set the mode attribute to
-# "override" instead.  Remember: every element is assumed to be in override
-# mode unless you specify otherwise, so if you want to accumulate metadata
-# for some field, every occurance must have "mode=accumulate" specified.
-#
-# The second FileSet element above applies to a specific file, called
-# nugget-point-1.jpg.  This element overrides the Title metadata set in the
-# first FileSet, and adds a "Subject" metadata field.
-#
-# The third and final FileSet sets metadata for a subdirectory rather than
-# a file.  The metadata specified (a Title) will be passed into the
-# subdirectory and applied to every file that occurs in the subdirectory
-# (and to every subsubdirectory and its contents, and so on) unless the
-# metadata is explictly overridden later in the import.
-
-package MetadataXMLPlug;
-
-use strict;
-no strict 'refs';
-use BasPlug;
-use util;
-use metadatautil;
-
-sub BEGIN {
-    @MetadataXMLPlug::ISA = ('BasPlug');
-    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
-}
-
-use XMLParser;
-
-my $arguments = [
-      { 'name' => "block_exp",
-	'desc' => "{BasPlug.block_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_block_exp() }
-];
-
-my $options = { 'name'     => "MetadataXMLPlug",
-		'desc'     => "{MetadataXMLPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-my ($self);
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    if ($self->{'info_only'}) {
-	# don't worry about any options or initialisations etc
-	return bless $self, $class;
-    }
-	
-    # create XML::Parser object for parsing metadata.xml files
-    my $parser;
-    if ($]<5.008) {
-	# Perl 5.6
-	$parser = new XML::Parser('Style' => 'Stream',
-				  'Handlers' => {'Char' => \&Char,
-						 'Doctype' => \&Doctype
-						 });
-    }
-    else {
-	# Perl 5.8
-	$parser = new XML::Parser('Style' => 'Stream',
-				  'ProtocolEncoding' => 'ISO-8859-1',
-				  'Handlers' => {'Char' => \&Char,
-						 'Doctype' => \&Doctype
-						 });
-    }
-
-    $self->{'parser'} = $parser;
-    $self->{'in_filename'} = 0;
-    
-    
-    return bless $self, $class;
-}
-
-
-sub get_default_process_exp
-{
-    return q^metadata\.xml$^;
-}
-
-# We don't want any other plugins to see metadata.xml files
-# block exp are currently only used in the read bit
-sub get_default_block_exp
-{
-    return q^metadata\.xml$^;
-}
-
-sub metadata_read
-{
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata,
-$processor, $maxdocs, $gli) = @_;
-
-    my $filename = &util::filename_cat($base_dir, $file);
-    if ($filename !~ /metadata\.xml$/ || !-f $filename) {
-        return undef;
-    }
-
-    print STDERR "\n<Processing n='$file' p='MetadataXMLPlug'>\n" if ($gli);
-    print STDERR "MetadataXMLPlug: processing $file\n" if ($self->{'verbosity'})> 1;
-
-    $self->{'metadataref'} = $extrametadata;
-    $self->{'metakeysref'} = $extrametakeys;
-    
-    eval {
-	$self->{'parser'}->parsefile($filename);
-    };
-
-    if ($@) {
-	my $outhandle = $self->{'outhandle'};
-	my $plugin_name = ref ($self);
-	print $outhandle "$plugin_name failed to process $file ($@)\n";
-	
-	return -1; #error
-    }
-    return 1;
-
-}
-
-sub Doctype {
-    my ($expat, $name, $sysid, $pubid, $internal) = @_;
-
-    # allow the short-lived and badly named "GreenstoneDirectoryMetadata" files 
-    # to be processed as well as the "DirectoryMetadata" files which should now
-    # be created by import.pl
-    die if ($name !~ /^(Greenstone)?DirectoryMetadata$/);
-}
-
-sub StartTag {
-    my ($expat, $element) = @_;
-
-    if ($element eq "FileSet") {
-	$self->{'saved_targets'} = [];
-	$self->{'saved_metadata'} = {};
-    }
-    elsif ($element eq "FileName") {
-	$self->{'in_filename'} = 1;
-    }
-    elsif ($element eq "Metadata") {
-	$self->{'metadata_name'} = $_{'name'};
-	$self->{'metadata_value'} = "";
-	if ((defined $_{'mode'}) && ($_{'mode'} eq "accumulate")) {
-	    $self->{'metadata_accumulate'} = 1;
-	} else {
-	    $self->{'metadata_accumulate'} = 0;
-	}
-    }
-}
-
-sub EndTag {
-    my ($expat, $element) = @_;
-
-    if ($element eq "FileSet") {
-	foreach my $target (@{$self->{'saved_targets'}}) {
-	    my $file_metadata = $self->{'metadataref'}->{$target};
-	    my $saved_metadata = $self->{'saved_metadata'};
-	    if (!defined $file_metadata) {
-		$self->{'metadataref'}->{$target} = $saved_metadata;
-
-		# not had target before
-		push (@{$self->{'metakeysref'}}, $target);
-	    }
-	    else {
-		&metadatautil::combine_metadata_structures($file_metadata,$saved_metadata);
-	    }
-	}
-    }
-    elsif ($element eq "FileName") {
-	$self->{'in_filename'} = 0;
-    }
-    elsif ($element eq "Metadata") {
-	&metadatautil::store_saved_metadata($self,$self->{'metadata_name'}, $self->{'metadata_value'}, $self->{'metadata_accumulate'});
-	$self->{'metadata_name'} = "";
-    }
-
-}
-
-sub Text {
-
-    if ($self->{'in_filename'}) {
-	# $_ == FileName content
-	push (@{$self->{'saved_targets'}}, $_);
-    }
-    elsif (defined ($self->{'metadata_name'}) && $self->{'metadata_name'} ne "") {
-	# $_ == Metadata content
-	$self->{'metadata_value'} = $_;
-    }
-}
-
-# This Char function overrides the one in XML::Parser::Stream to overcome a
-# problem where $expat->{Text} is treated as the return value, slowing
-# things down significantly in some cases.
-sub Char {
-    if ($]<5.008) {
-	use bytes;  # Necessary to prevent encoding issues with XML::Parser 2.31+ and Perl 5.6
-    }
-    $_[0]->{'Text'} .= $_[1];
-    return undef;
-}
-
-#sub combine_metadata_structures
-#{
-#    my $self = shift(@_);
-#
-#    my ($mdref1, $mdref2) = @_;
-#    &metadatautil::combine_metadata_structures($mdref1, $mdref2);
-#}
-
-
-1;
Index: /gsdl/trunk/perllib/plugins/MetadataXMLPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/MetadataXMLPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/MetadataXMLPlugin.pm	(revision 15865)
@@ -0,0 +1,293 @@
+###########################################################################
+#
+# MetadataXMLPlug.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) 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.
+#
+###########################################################################
+
+# MetadataXMLPlug process metadata.xml files in a collection
+
+# Here's an example of a metadata file that uses three FileSet structures
+# (ignore the # characters):
+
+#<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+#<!DOCTYPE DirectoryMetadata SYSTEM "http://greenstone.org/dtd/DirectoryMetadata/1.0/DirectoryMetadata.dtd">
+#<DirectoryMetadata>
+#  <FileSet>
+#    <FileName>nugget.*</FileName>
+#    <Description>
+#      <Metadata name="Title">Nugget Point, The Catlins</Metadata>
+#      <Metadata name="Place" mode="accumulate">Nugget Point</Metadata>
+#    </Description>
+#  </FileSet>
+#  <FileSet>
+#    <FileName>nugget-point-1.jpg</FileName>
+#    <Description>
+#      <Metadata name="Title">Nugget Point Lighthouse, The Catlins</Metadata>
+#      <Metadata name="Subject">Lighthouse</Metadata>
+#    </Description>
+#  </FileSet>
+#  <FileSet>
+#    <FileName>kaka-point-dir</FileName>
+#    <Description>
+#      <Metadata name="Title">Kaka Point, The Catlins</Metadata>
+#    </Description>
+#  </FileSet>
+#</DirectoryMetadata>
+
+# Metadata elements are read and applied to files in the order they appear
+# in the file.
+#
+# The FileName element describes the subfiles in the directory that the
+# metadata applies to as a perl regular expression (a FileSet group may
+# contain multiple FileName elements). So, <FileName>nugget.*</FileName>
+# indicates that the metadata records in the following Description block
+# apply to every subfile that starts with "nugget".  For these files, a
+# Title metadata element is set, overriding any old value that the Title
+# might have had.
+#
+# Occasionally, we want to have multiple metadata values applied to a
+# document; in this case we use the "mode=accumulate" attribute of the
+# particular Metadata element.  In the second metadata element of the first
+# FileSet above, the "Place" metadata is accumulating, and may therefore be
+# given several values.  If we wanted to override these values and use a
+# single metadata element again, we could set the mode attribute to
+# "override" instead.  Remember: every element is assumed to be in override
+# mode unless you specify otherwise, so if you want to accumulate metadata
+# for some field, every occurance must have "mode=accumulate" specified.
+#
+# The second FileSet element above applies to a specific file, called
+# nugget-point-1.jpg.  This element overrides the Title metadata set in the
+# first FileSet, and adds a "Subject" metadata field.
+#
+# The third and final FileSet sets metadata for a subdirectory rather than
+# a file.  The metadata specified (a Title) will be passed into the
+# subdirectory and applied to every file that occurs in the subdirectory
+# (and to every subsubdirectory and its contents, and so on) unless the
+# metadata is explictly overridden later in the import.
+
+package MetadataXMLPlug;
+
+use strict;
+no strict 'refs';
+use BasPlug;
+use util;
+use metadatautil;
+
+sub BEGIN {
+    @MetadataXMLPlug::ISA = ('BasPlug');
+    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
+}
+
+use XMLParser;
+
+my $arguments = [
+      { 'name' => "block_exp",
+	'desc' => "{BasPlug.block_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_block_exp() }
+];
+
+my $options = { 'name'     => "MetadataXMLPlug",
+		'desc'     => "{MetadataXMLPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+my ($self);
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    if ($self->{'info_only'}) {
+	# don't worry about any options or initialisations etc
+	return bless $self, $class;
+    }
+	
+    # create XML::Parser object for parsing metadata.xml files
+    my $parser;
+    if ($]<5.008) {
+	# Perl 5.6
+	$parser = new XML::Parser('Style' => 'Stream',
+				  'Handlers' => {'Char' => \&Char,
+						 'Doctype' => \&Doctype
+						 });
+    }
+    else {
+	# Perl 5.8
+	$parser = new XML::Parser('Style' => 'Stream',
+				  'ProtocolEncoding' => 'ISO-8859-1',
+				  'Handlers' => {'Char' => \&Char,
+						 'Doctype' => \&Doctype
+						 });
+    }
+
+    $self->{'parser'} = $parser;
+    $self->{'in_filename'} = 0;
+    
+    
+    return bless $self, $class;
+}
+
+
+sub get_default_process_exp
+{
+    return q^metadata\.xml$^;
+}
+
+# We don't want any other plugins to see metadata.xml files
+# block exp are currently only used in the read bit
+sub get_default_block_exp
+{
+    return q^metadata\.xml$^;
+}
+
+sub metadata_read
+{
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata,
+$processor, $maxdocs, $gli) = @_;
+
+    my $filename = &util::filename_cat($base_dir, $file);
+    if ($filename !~ /metadata\.xml$/ || !-f $filename) {
+        return undef;
+    }
+
+    print STDERR "\n<Processing n='$file' p='MetadataXMLPlug'>\n" if ($gli);
+    print STDERR "MetadataXMLPlug: processing $file\n" if ($self->{'verbosity'})> 1;
+
+    $self->{'metadataref'} = $extrametadata;
+    $self->{'metakeysref'} = $extrametakeys;
+    
+    eval {
+	$self->{'parser'}->parsefile($filename);
+    };
+
+    if ($@) {
+	my $outhandle = $self->{'outhandle'};
+	my $plugin_name = ref ($self);
+	print $outhandle "$plugin_name failed to process $file ($@)\n";
+	
+	return -1; #error
+    }
+    return 1;
+
+}
+
+sub Doctype {
+    my ($expat, $name, $sysid, $pubid, $internal) = @_;
+
+    # allow the short-lived and badly named "GreenstoneDirectoryMetadata" files 
+    # to be processed as well as the "DirectoryMetadata" files which should now
+    # be created by import.pl
+    die if ($name !~ /^(Greenstone)?DirectoryMetadata$/);
+}
+
+sub StartTag {
+    my ($expat, $element) = @_;
+
+    if ($element eq "FileSet") {
+	$self->{'saved_targets'} = [];
+	$self->{'saved_metadata'} = {};
+    }
+    elsif ($element eq "FileName") {
+	$self->{'in_filename'} = 1;
+    }
+    elsif ($element eq "Metadata") {
+	$self->{'metadata_name'} = $_{'name'};
+	$self->{'metadata_value'} = "";
+	if ((defined $_{'mode'}) && ($_{'mode'} eq "accumulate")) {
+	    $self->{'metadata_accumulate'} = 1;
+	} else {
+	    $self->{'metadata_accumulate'} = 0;
+	}
+    }
+}
+
+sub EndTag {
+    my ($expat, $element) = @_;
+
+    if ($element eq "FileSet") {
+	foreach my $target (@{$self->{'saved_targets'}}) {
+	    my $file_metadata = $self->{'metadataref'}->{$target};
+	    my $saved_metadata = $self->{'saved_metadata'};
+	    if (!defined $file_metadata) {
+		$self->{'metadataref'}->{$target} = $saved_metadata;
+
+		# not had target before
+		push (@{$self->{'metakeysref'}}, $target);
+	    }
+	    else {
+		&metadatautil::combine_metadata_structures($file_metadata,$saved_metadata);
+	    }
+	}
+    }
+    elsif ($element eq "FileName") {
+	$self->{'in_filename'} = 0;
+    }
+    elsif ($element eq "Metadata") {
+	&metadatautil::store_saved_metadata($self,$self->{'metadata_name'}, $self->{'metadata_value'}, $self->{'metadata_accumulate'});
+	$self->{'metadata_name'} = "";
+    }
+
+}
+
+sub Text {
+
+    if ($self->{'in_filename'}) {
+	# $_ == FileName content
+	push (@{$self->{'saved_targets'}}, $_);
+    }
+    elsif (defined ($self->{'metadata_name'}) && $self->{'metadata_name'} ne "") {
+	# $_ == Metadata content
+	$self->{'metadata_value'} = $_;
+    }
+}
+
+# This Char function overrides the one in XML::Parser::Stream to overcome a
+# problem where $expat->{Text} is treated as the return value, slowing
+# things down significantly in some cases.
+sub Char {
+    if ($]<5.008) {
+	use bytes;  # Necessary to prevent encoding issues with XML::Parser 2.31+ and Perl 5.6
+    }
+    $_[0]->{'Text'} .= $_[1];
+    return undef;
+}
+
+#sub combine_metadata_structures
+#{
+#    my $self = shift(@_);
+#
+#    my ($mdref1, $mdref2) = @_;
+#    &metadatautil::combine_metadata_structures($mdref1, $mdref2);
+#}
+
+
+1;
Index: dl/trunk/perllib/plugins/NULPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/NULPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,197 +1,0 @@
-###########################################################################
-#
-# NULPlug.pm -- Plugin for dummy (.nul) files
-#
-# A component of the Greenstone digital library software from the New
-# Zealand Digital Library Project at the University of Waikato, New
-# Zealand.
-#
-# Copyright (C) 2005 Katherine Don
-# Copyright (C) 2005 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.
-#
-###########################################################################
-
-# NULPlug - a plugin for dummy files
-
-# This is a simple Plugin for importing dummy files, along with
-# their metadata.  A fictional document will
-# be created for every such file, and the metadata added to it.
-
-# This is used mainly for the null files resulting from exploding metadata
-# databases
-
-package NULPlug;
-
-use BasPlug;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @NULPlug::ISA = ('BasPlug');
-}
-
-my $arguments = 
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_process_exp() },
-      { 'name' => "assoc_field",
-	'desc' => "{NULPlug.assoc_field}",
-	'type' => "string",
-	'deft' => "",
-	'reqd' => "no" },
-      { 'name' => "add_metadata_as_text",
-	'desc' => "{NULPlug.add_metadata_as_text}",
-	'type' => "flag" },
-      { 'name' => "remove_namespace_for_text",
-	'desc' => "{NULPlug.remove_namespace_for_text}",
-	'type' => "flag" }
-      ];
-
-my $options = { 'name'     => "NULPlug",
-		'desc'     => "{NULPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-                 'args'     => $arguments };
-
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-    
-    return bless $self, $class;
-}
-
-sub get_default_process_exp {
-    return '(?i)\.nul$';
-}
-
-# The NULPlug read() function. This function does all the right
-# things to make general options work for a given plugin.  NULPlug
-# overrides read() because there is no need to read the actual text of
-# the file in, because the contents of the file is not text...
-#
-#
-# Return number of files processed, undef if can't process 
-#
-# Note that $base_dir might be "" and that $file might include directories
-
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-
-    #check for associate_ext, blocking etc
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-
-    print STDERR "<Processing n='$file' p='NULPlug'>\n" if ($gli);
-    print $outhandle "NULPlug processing \"$filename\"\n"
-	    if $self->{'verbosity'} > 1;
-
-    #if there's a leading directory name, eat it...
-    $file =~ s/^.*[\/\\]//;
-    
-    # create a new document
-    my $doc_obj = new doc ($filename, "indexed_doc");
-    my $top_section = $doc_obj->get_top_section();
-
-    $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});    
-    #$doc_obj->set_OIDtype ("incremental");
-    $doc_obj->add_utf8_metadata($top_section, "Plugin", "$self->{'plugin_type'}");
-    $doc_obj->add_metadata($top_section, "Source", $file); # set the filename as Source metadata to be consistent with other plugins
-
-    $doc_obj->add_utf8_metadata($top_section, "FileSize", (-s $filename));
-
-    # the metadata NoText is used to suppress the dummy text 'This document has no text.'
-    $doc_obj->add_metadata ($top_section, "NoText",    "1");
-
-    my $assoc_field = $self->{'assoc_field'} || "null_file";
-    $doc_obj->add_metadata ($top_section, $assoc_field, $file);
-    
-     if ($self->{'cover_image'}) {
-	$self->associate_cover_image($doc_obj, $filename);
-    }
-
-    # include any metadata passed in from previous plugins 
-    my $section = $doc_obj->get_top_section();
-    $self->extra_metadata ($doc_obj, $section, $metadata);
-    
-    # format the metadata passed in (presumably from metadata.xml)
-    my $text = "";
-    if ($self->{'add_metadata_as_text'}) {
-	$text = &metadatautil::format_metadata_as_table($metadata, $self->{'remove_namespace_for_text'});
-    } else {
-	#create an empty text string so we don't break downstream plugins 
-	$text = &gsprintf::lookup_string("{BasPlug.dummy_text}",1);
-    }
-    $self->title_fallback($doc_obj,$section,$file);
-    
-    # do plugin specific processing of doc_obj
-    unless (defined ($self->process(\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj))) {
-	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
-	return -1;
-    }
-
-    # do any automatic metadata extraction
-    $self->auto_extract_metadata ($doc_obj);
-
-    # add an OID
-    $doc_obj->set_OID();
-    $doc_obj->add_utf8_text($section, $text);
-    
-    # process the document
-    $processor->process($doc_obj);
-
-    $self->{'num_processed'} ++;
-    return 1;
-}
-
-
-# NULPlug processing of doc_obj.  In practice we don't need to do
-# anything here because the read function takes care of everything.
-
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
-    my $outhandle = $self->{'outhandle'};
-    
-    return 1;
-}
-
-
-1;
-
-
-
-
-
-
-
-
-
-
-
Index: /gsdl/trunk/perllib/plugins/NulPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/NulPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/NulPlugin.pm	(revision 15865)
@@ -0,0 +1,197 @@
+###########################################################################
+#
+# NULPlug.pm -- Plugin for dummy (.nul) files
+#
+# A component of the Greenstone digital library software from the New
+# Zealand Digital Library Project at the University of Waikato, New
+# Zealand.
+#
+# Copyright (C) 2005 Katherine Don
+# Copyright (C) 2005 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.
+#
+###########################################################################
+
+# NULPlug - a plugin for dummy files
+
+# This is a simple Plugin for importing dummy files, along with
+# their metadata.  A fictional document will
+# be created for every such file, and the metadata added to it.
+
+# This is used mainly for the null files resulting from exploding metadata
+# databases
+
+package NULPlug;
+
+use BasPlug;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @NULPlug::ISA = ('BasPlug');
+}
+
+my $arguments = 
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_process_exp() },
+      { 'name' => "assoc_field",
+	'desc' => "{NULPlug.assoc_field}",
+	'type' => "string",
+	'deft' => "",
+	'reqd' => "no" },
+      { 'name' => "add_metadata_as_text",
+	'desc' => "{NULPlug.add_metadata_as_text}",
+	'type' => "flag" },
+      { 'name' => "remove_namespace_for_text",
+	'desc' => "{NULPlug.remove_namespace_for_text}",
+	'type' => "flag" }
+      ];
+
+my $options = { 'name'     => "NULPlug",
+		'desc'     => "{NULPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+                 'args'     => $arguments };
+
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+    
+    return bless $self, $class;
+}
+
+sub get_default_process_exp {
+    return '(?i)\.nul$';
+}
+
+# The NULPlug read() function. This function does all the right
+# things to make general options work for a given plugin.  NULPlug
+# overrides read() because there is no need to read the actual text of
+# the file in, because the contents of the file is not text...
+#
+#
+# Return number of files processed, undef if can't process 
+#
+# Note that $base_dir might be "" and that $file might include directories
+
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+
+    #check for associate_ext, blocking etc
+    my ($block_status,$filename) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+
+    print STDERR "<Processing n='$file' p='NULPlug'>\n" if ($gli);
+    print $outhandle "NULPlug processing \"$filename\"\n"
+	    if $self->{'verbosity'} > 1;
+
+    #if there's a leading directory name, eat it...
+    $file =~ s/^.*[\/\\]//;
+    
+    # create a new document
+    my $doc_obj = new doc ($filename, "indexed_doc");
+    my $top_section = $doc_obj->get_top_section();
+
+    $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});    
+    #$doc_obj->set_OIDtype ("incremental");
+    $doc_obj->add_utf8_metadata($top_section, "Plugin", "$self->{'plugin_type'}");
+    $doc_obj->add_metadata($top_section, "Source", $file); # set the filename as Source metadata to be consistent with other plugins
+
+    $doc_obj->add_utf8_metadata($top_section, "FileSize", (-s $filename));
+
+    # the metadata NoText is used to suppress the dummy text 'This document has no text.'
+    $doc_obj->add_metadata ($top_section, "NoText",    "1");
+
+    my $assoc_field = $self->{'assoc_field'} || "null_file";
+    $doc_obj->add_metadata ($top_section, $assoc_field, $file);
+    
+     if ($self->{'cover_image'}) {
+	$self->associate_cover_image($doc_obj, $filename);
+    }
+
+    # include any metadata passed in from previous plugins 
+    my $section = $doc_obj->get_top_section();
+    $self->extra_metadata ($doc_obj, $section, $metadata);
+    
+    # format the metadata passed in (presumably from metadata.xml)
+    my $text = "";
+    if ($self->{'add_metadata_as_text'}) {
+	$text = &metadatautil::format_metadata_as_table($metadata, $self->{'remove_namespace_for_text'});
+    } else {
+	#create an empty text string so we don't break downstream plugins 
+	$text = &gsprintf::lookup_string("{BasPlug.dummy_text}",1);
+    }
+    $self->title_fallback($doc_obj,$section,$file);
+    
+    # do plugin specific processing of doc_obj
+    unless (defined ($self->process(\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj))) {
+	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
+	return -1;
+    }
+
+    # do any automatic metadata extraction
+    $self->auto_extract_metadata ($doc_obj);
+
+    # add an OID
+    $doc_obj->set_OID();
+    $doc_obj->add_utf8_text($section, $text);
+    
+    # process the document
+    $processor->process($doc_obj);
+
+    $self->{'num_processed'} ++;
+    return 1;
+}
+
+
+# NULPlug processing of doc_obj.  In practice we don't need to do
+# anything here because the read function takes care of everything.
+
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
+    my $outhandle = $self->{'outhandle'};
+    
+    return 1;
+}
+
+
+1;
+
+
+
+
+
+
+
+
+
+
+
Index: dl/trunk/perllib/plugins/OAIPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/OAIPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,475 +1,0 @@
-###########################################################################
-#
-# OAIPlug.pm -- basic Open Archives Initiative (OAI) plugin
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999 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 OAIPlug;
-
-use BasPlug;
-use unicode;
-use util;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-use XMLPlug;
-
-sub BEGIN {
-    @OAIPlug::ISA = ('XMLPlug');
-}
-
-
-my $arguments = 
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_process_exp() },
-      ];
-
-my $options = { 'name'     => "OAIPlug",
-		'desc'     => "{OAIPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new XMLPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)(\.oai)$^;
-}
-
-sub get_doctype {
-    my $self = shift(@_);
-    
-    return "OAI-PMH";
-}
-
-sub xml_start_document {
-    my $self = shift (@_);
-    $self->{'in_metadata_node'} = 0;
-    $self->{'rawxml'} = "";
-}
-
-sub xml_end_document {
-}
-
-sub xml_doctype {
-    my $self = shift(@_);
-
-    my ($expat, $name, $sysid, $pubid, $internal) = @_;
-
-    ##die "" if ($name !~ /^OAI-PMH$/);
-
-    my $outhandle = $self->{'outhandle'};
-    print $outhandle "OAIPlug: processing $self->{'file'}\n" if $self->{'verbosity'} > 1;
-    print STDERR "<Processing n='$self->{'file'}' p='OAIPlug'>\n" if $self->{'gli'};
-
-}
-
-
-sub xml_start_tag {
-    my $self = shift(@_);
-    my ($expat,$element) = @_;
-
-    my %attr_hash = %_;
-
-    my $attr = "";
-    map { $attr .= " $_=$attr_hash{$_}"; } keys %attr_hash;
-
-    $self->{'rawxml'} .= "<$element$attr>";
-
-    if ($element eq "metadata") {
-	$self->{'in_metadata_node'} = 1;
-	$self->{'metadata_xml'} = "";
-    }
-
-    if ($self->{'in_metadata_node'}) {
-	$self->{'metadata_xml'} .= "<$element$attr>";
-    }
-}
-
-sub xml_end_tag {
-    my $self = shift(@_);
-    my ($expat, $element) = @_;
-
-    $self->{'rawxml'} .= "</$element>";
-
-    if ($self->{'in_metadata_node'}) {
-	$self->{'metadata_xml'} .= "</$element>";
-    }
-
-    if ($element eq "metadata") {
-	my $textref = \$self->{'metadata_xml'};
-	my $metadata = $self->{'metadata'};
-	$self->extract_oai_metadata($textref,$metadata);
-
-	$self->{'in_metadata_node'} = 0;	
-    }
-
-
-}
-
-sub xml_text {
-    my $self = shift(@_);
-    my ($expat) = @_;
-
-    $self->{'rawxml'} .= $_;
-
-    if ($self->{'in_metadata_node'}) {
-	$self->{'metadata_xml'} .= $_;
-    }
-}
-
-
-
-
-sub read {
-    my $self = shift (@_);  
-  
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-
-    my $filename = $file;
-    $filename = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
-
-    return 0 if ((-d $filename) && ($filename =~ m/srcdocs$/));
-
-    if ($self->SUPER::read(@_)) {
-
-	# Do encoding stuff
-	my ($language, $encoding) = $self->textcat_get_language_encoding ($filename);
-	
-	my $url_array = $metadata->{'URL'};
-	my $num_urls = (defined $url_array) ? scalar(@$url_array) : 0;
-	
-	my $srcdoc_exists = 0;
-	my $srcdoc_pos = 0;
-	my $filename_dir = &util::filename_head($filename);
-	
-	for (my $i=0; $i<$num_urls; $i++) {
-	    
-	    if ($url_array->[$i] !~ m/^(http|ftp):/) {
-		
-		my $src_filename = &util::filename_cat($filename_dir, $url_array->[$i]);
-		
-		if (-e $src_filename) {
-		    $srcdoc_pos = $i;
-		    $srcdoc_exists = 1;
-		}
-	    }
-	}
-	
-	if ($srcdoc_exists)
-	{
-	    print $outhandle "OAIPlug: passing metadata on to $url_array->[0]\n"
-		if ($self->{'verbosity'}>1);
-	    
-	    
-	    # Make pretty print metadata table stick with src filename
-	    my $ppmd_table = $self->{'ppmd_table'};
-	    $metadata->{'prettymd'} = [ $ppmd_table ];
-	    $self->{'ppmd_table'} = undef;
-	    
-	    return &plugin::read ($pluginfo, $filename_dir, $url_array->[0],
-				  $metadata, $processor, $maxdocs, $total_count, $gli);
-	}
-	else
-	{
-	    # create a new document
-	    my $doc_obj = new doc ($filename, "indexed_doc");
-	    my $top_section = $doc_obj->get_top_section;
-	    my $plugin_type = $self->{'plugin_type'};
-	    
-	    $doc_obj->add_utf8_metadata($top_section, "Language", $language);
-	    $doc_obj->add_utf8_metadata($top_section, "Encoding", $encoding);
-	    $doc_obj->add_utf8_metadata($top_section, "Plugin", $plugin_type);
-	    $doc_obj->add_metadata($top_section, "FileFormat", "OAI");
-	    $doc_obj->add_metadata($top_section, "FileSize", (-s $filename));
-	    
-	    # include any metadata passed in from previous plugins 
-	    # note that this metadata is associated with the top level section
-	    $self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
-	    
-	    # do plugin specific processing of doc_obj
-	    my $textref = \$self->{'rawxml'};
-	    unless (defined ($self->process($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj))) {
-		print STDERR "<ProcessingError n='$file'>\n" if ($gli);
-		return -1;
-	    }
-	    
-	    # do any automatic metadata extraction
-	    $self->auto_extract_metadata ($doc_obj);
-	    
-	    # add an OID
-	    $doc_obj->set_OID();
-	    
-	    my $ppmd_table = $self->{'ppmd_table'};
-	    $doc_obj->add_utf8_metadata($top_section,"prettymd",$ppmd_table);
-	    $self->{'ppmd_table'} = undef;
-	    
-	    # process the document
-	    $processor->process($doc_obj);
-	    
-	    $self->{'num_processed'} ++;
-	    
-	    return 1; # processed the file
-	}
-    }
-    else {
-	return undef;
-    }
-}
-
-
-# do plugin specific processing of doc_obj
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    print STDERR "<Processing n='$file' p='OAIPlug'>\n" if ($gli);
-    print $outhandle "OAIPlug: processing $file\n"
-	if $self->{'verbosity'} > 1;
-
-    my $cursection = $doc_obj->get_top_section();
-
-##    $self->extract_metadata ($textref, $metadata, $doc_obj, $cursection);
-
-    # add text to document object
-
-#    $$textref =~ s/<(.*?)>/$1 /g;
-    $$textref =~ s/</&lt;/g;
-    $$textref =~ s/>/&gt;/g;
-    $$textref =~ s/\[/&#91;/g;
-    $$textref =~ s/\]/&#93;/g;
-
-##    print STDERR "*** adding text: $$textref\n";
-    
-    $doc_obj->add_utf8_text($cursection, $$textref);
-
-    return 1;
-}
-
-
-# Improvement is to merge this with newer version in MetadataPass
-
-sub open_prettyprint_metadata_table
-{
-    my $self = shift(@_);
-
-    my $att   = "width=100% cellspacing=2";
-    my $style = "style=\'border-bottom: 4px solid #000080\'";
-
-    $self->{'ppmd_table'} = "\n<table $att $style>";
-}
-
-sub add_prettyprint_metadata_line 
-{
-    my $self = shift(@_);
-    my ($metaname, $metavalue_utf8) = @_;
-
-###    $metavalue_utf8 =~ s/hdl\.handle\.net/mcgonagall.cs.waikato.ac.nz:8080\/dspace\/handle/;
-    $metavalue_utf8 = &util::hyperlink_text($metavalue_utf8);
-
-    $self->{'ppmd_table'} .= "  <tr bgcolor=#b5d3cd>\n";
-    $self->{'ppmd_table'} .= "    <td width=30%>\n";
-    $self->{'ppmd_table'} .= "      $metaname\n";
-    $self->{'ppmd_table'} .= "    </td>\n";
-    $self->{'ppmd_table'} .= "    <td>\n";
-    $self->{'ppmd_table'} .= "      $metavalue_utf8\n";
-    $self->{'ppmd_table'} .= "    </td>\n";
-    $self->{'ppmd_table'} .= "  </tr>\n";
-
-}
-
-sub close_prettyprint_metadata_table
-{
-    my $self = shift(@_);
-
-    $self->{'ppmd_table'} .= "</table>\n";
-}
-
-
-sub remap_dcterms_metadata
-{
-    my $self = shift(@_);
-
-    my ($metaname) = @_;
-
-    my $dcterm_mapping = {
-	"alternative" => "dc.title",
-	"tableOfContents" => "dc.description",
-	"abstract" => "dc.description",
-	"created" => "dc.date",
-	"valid" => "dc.date",
-	"available" => "dc.date",
-	"issued" => "dc.date",
-	"modified" => "dc.date",
-	"dateAccepted" => "dc.date",
-	"dateCopyrighted" => "dc.date",
-	"dateSubmitted" => "dc.date",
-	"extent" => "dc.format",
-	"medium" => "dc.format",
-	"isVersionOf" => "dc.relation",
-	"hasVersion" => "dc.relation",
-	"isReplacedBy" => "dc.relation",
-	"replaces" => "dc.relation",
-	"isRequiredBy" => "dc.relation",
-	"requires" => "dc.relation",
-	"isPartOf" => "dc.relation",
-	"hasPart" => "dc.relation",
-	"isReferencedBy" => "dc.relation",
-	"references" => "dc.relation",
-	"isFormatOf" => "dc.relation",
-	"hasFormat" => "dc.relation",
-	"conformsTo" => "dc.relation",
-	"spatial" => "dc.coverage",
-	"temporal" => "dc.coverage",
-	"audience" => "dc.any",
-	"accrualMethod" => "dc.any",
-	"accrualPeriodicity" => "dc.any",
-	"accrualPolicy" => "dc.any",
-	"instructionalMethod" => "dc.any",
-	"provenance" => "dc.any",
-	"rightsHolder" => "dc.any",
-	"mediator" => "audience",
-	"educationLevel" => "audience",
-	"accessRights" => "dc.rights",
-	"license" => "dc.rights",
-	"bibliographicCitation" => "dc.identifier"
-	};
-
-    my ($prefix,$name) = ($metaname =~ m/^(.*?)\.(.*?)$/);
-    
-    if ($prefix eq "dcterms")
-    {
-	if (defined $dcterm_mapping->{$name}) 
-	{
-	    return $dcterm_mapping->{$name}."^".$name;
-	}
-
-    }
-    return $metaname; # didn't get a match, return param passed in unchanged
-}
-
-
-sub extract_oai_metadata {
-    my $self = shift (@_);
-    my ($textref, $metadata) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    # Only handles DC metadata
-
-    $self->open_prettyprint_metadata_table();
-
-    if ($$textref =~ m/<metadata\s*>(.*?)<\/metadata\s*>/s)
-    {
-	my $metadata_text = $1;
-
-	# locate and remove outermost tag (ignoring any attribute information in top-level tag)
-	my ($wrapper_metadata_xml,$inner_metadata_text) = ($metadata_text =~ m/<([^ >]+).*?>(.*?)<\/\1>/s);
-
-	# split tag into namespace and tag name
-	my($namespace,$top_level_prefix) = ($wrapper_metadata_xml =~ m/^(.*?):(.*?)$/);
-
-	if ($top_level_prefix !~ /dc$/) {
-	    print $outhandle "Warning: OAIPlug currently only designed for Dublin Core (or variant) metadata\n";
-	    print $outhandle "         This recorded metadata section '$top_level_prefix' does not appear to match.\n";
-	    print $outhandle "         Metadata assumed to be in form: <prefix:tag>value</prefix:tag> and will be converted\n";
-	    print $outhandle "         into Greenstone metadata as prefix.tag = value\n";
-	}
-
-	while ($inner_metadata_text =~ m/<([^ >]+).*?>(.*?)<\/\1>(.*)/s)
-	{
-	    # if URL given for document as identifier metadata, store it ...
-	    # $doc_obj->add_utf8_metadata($cursection, "URL", $web_url);
-
-	    my $metaname = $1;
-	    my $metavalue = $2;
-	    $inner_metadata_text = $3;
-
-#	    print STDERR "*** metaname = $metaname\n";
-#	    print STDERR "*** metavalue = $metavalue\n";
-
-	    # $metaname =~ s/^(dc:)?(.)/\u$2/; # strip of optional prefix and uppercase first letter
-	    $metaname =~ s/:/\./;
-	    if ($metaname !~ m/\./)
-	    {
-		$metaname = "$top_level_prefix.$metaname";
-	    }
-	    $metaname =~ s/\.(.)/\.\u$1/;
-
-	    $metaname = $self->remap_dcterms_metadata($metaname);
-
-	    $metavalue =~ s/\[/&#91;/g;
-	    $metavalue =~ s/\]/&#93;/g;
-
-
-#	    if ($metaname eq "Identifier")
-#	    {
-#		# name clashes with GSDL reserved metadata name for hash id
-#		$metaname = "URL";
-#	    }
-
-	    if (defined $metadata->{$metaname})
-	    {
-		push(@{$metadata->{$metaname}},$metavalue);
-
-	    }
-	    else
-	    {
-		$metadata->{$metaname} = [ $metavalue ];
-	    }
-
-	    $self->add_prettyprint_metadata_line($metaname, $metavalue);
-	    
-	}
-    }
-
-    $self->close_prettyprint_metadata_table();
-}
-
-## we know from the file extension, so doesn't need to check the doctype
-sub check_doctype {
-
-    return 1;
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/OAIPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/OAIPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/OAIPlugin.pm	(revision 15865)
@@ -0,0 +1,475 @@
+###########################################################################
+#
+# OAIPlug.pm -- basic Open Archives Initiative (OAI) plugin
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999 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 OAIPlug;
+
+use BasPlug;
+use unicode;
+use util;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+use XMLPlug;
+
+sub BEGIN {
+    @OAIPlug::ISA = ('XMLPlug');
+}
+
+
+my $arguments = 
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_process_exp() },
+      ];
+
+my $options = { 'name'     => "OAIPlug",
+		'desc'     => "{OAIPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new XMLPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)(\.oai)$^;
+}
+
+sub get_doctype {
+    my $self = shift(@_);
+    
+    return "OAI-PMH";
+}
+
+sub xml_start_document {
+    my $self = shift (@_);
+    $self->{'in_metadata_node'} = 0;
+    $self->{'rawxml'} = "";
+}
+
+sub xml_end_document {
+}
+
+sub xml_doctype {
+    my $self = shift(@_);
+
+    my ($expat, $name, $sysid, $pubid, $internal) = @_;
+
+    ##die "" if ($name !~ /^OAI-PMH$/);
+
+    my $outhandle = $self->{'outhandle'};
+    print $outhandle "OAIPlug: processing $self->{'file'}\n" if $self->{'verbosity'} > 1;
+    print STDERR "<Processing n='$self->{'file'}' p='OAIPlug'>\n" if $self->{'gli'};
+
+}
+
+
+sub xml_start_tag {
+    my $self = shift(@_);
+    my ($expat,$element) = @_;
+
+    my %attr_hash = %_;
+
+    my $attr = "";
+    map { $attr .= " $_=$attr_hash{$_}"; } keys %attr_hash;
+
+    $self->{'rawxml'} .= "<$element$attr>";
+
+    if ($element eq "metadata") {
+	$self->{'in_metadata_node'} = 1;
+	$self->{'metadata_xml'} = "";
+    }
+
+    if ($self->{'in_metadata_node'}) {
+	$self->{'metadata_xml'} .= "<$element$attr>";
+    }
+}
+
+sub xml_end_tag {
+    my $self = shift(@_);
+    my ($expat, $element) = @_;
+
+    $self->{'rawxml'} .= "</$element>";
+
+    if ($self->{'in_metadata_node'}) {
+	$self->{'metadata_xml'} .= "</$element>";
+    }
+
+    if ($element eq "metadata") {
+	my $textref = \$self->{'metadata_xml'};
+	my $metadata = $self->{'metadata'};
+	$self->extract_oai_metadata($textref,$metadata);
+
+	$self->{'in_metadata_node'} = 0;	
+    }
+
+
+}
+
+sub xml_text {
+    my $self = shift(@_);
+    my ($expat) = @_;
+
+    $self->{'rawxml'} .= $_;
+
+    if ($self->{'in_metadata_node'}) {
+	$self->{'metadata_xml'} .= $_;
+    }
+}
+
+
+
+
+sub read {
+    my $self = shift (@_);  
+  
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+
+    my $filename = $file;
+    $filename = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
+
+    return 0 if ((-d $filename) && ($filename =~ m/srcdocs$/));
+
+    if ($self->SUPER::read(@_)) {
+
+	# Do encoding stuff
+	my ($language, $encoding) = $self->textcat_get_language_encoding ($filename);
+	
+	my $url_array = $metadata->{'URL'};
+	my $num_urls = (defined $url_array) ? scalar(@$url_array) : 0;
+	
+	my $srcdoc_exists = 0;
+	my $srcdoc_pos = 0;
+	my $filename_dir = &util::filename_head($filename);
+	
+	for (my $i=0; $i<$num_urls; $i++) {
+	    
+	    if ($url_array->[$i] !~ m/^(http|ftp):/) {
+		
+		my $src_filename = &util::filename_cat($filename_dir, $url_array->[$i]);
+		
+		if (-e $src_filename) {
+		    $srcdoc_pos = $i;
+		    $srcdoc_exists = 1;
+		}
+	    }
+	}
+	
+	if ($srcdoc_exists)
+	{
+	    print $outhandle "OAIPlug: passing metadata on to $url_array->[0]\n"
+		if ($self->{'verbosity'}>1);
+	    
+	    
+	    # Make pretty print metadata table stick with src filename
+	    my $ppmd_table = $self->{'ppmd_table'};
+	    $metadata->{'prettymd'} = [ $ppmd_table ];
+	    $self->{'ppmd_table'} = undef;
+	    
+	    return &plugin::read ($pluginfo, $filename_dir, $url_array->[0],
+				  $metadata, $processor, $maxdocs, $total_count, $gli);
+	}
+	else
+	{
+	    # create a new document
+	    my $doc_obj = new doc ($filename, "indexed_doc");
+	    my $top_section = $doc_obj->get_top_section;
+	    my $plugin_type = $self->{'plugin_type'};
+	    
+	    $doc_obj->add_utf8_metadata($top_section, "Language", $language);
+	    $doc_obj->add_utf8_metadata($top_section, "Encoding", $encoding);
+	    $doc_obj->add_utf8_metadata($top_section, "Plugin", $plugin_type);
+	    $doc_obj->add_metadata($top_section, "FileFormat", "OAI");
+	    $doc_obj->add_metadata($top_section, "FileSize", (-s $filename));
+	    
+	    # include any metadata passed in from previous plugins 
+	    # note that this metadata is associated with the top level section
+	    $self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
+	    
+	    # do plugin specific processing of doc_obj
+	    my $textref = \$self->{'rawxml'};
+	    unless (defined ($self->process($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj))) {
+		print STDERR "<ProcessingError n='$file'>\n" if ($gli);
+		return -1;
+	    }
+	    
+	    # do any automatic metadata extraction
+	    $self->auto_extract_metadata ($doc_obj);
+	    
+	    # add an OID
+	    $doc_obj->set_OID();
+	    
+	    my $ppmd_table = $self->{'ppmd_table'};
+	    $doc_obj->add_utf8_metadata($top_section,"prettymd",$ppmd_table);
+	    $self->{'ppmd_table'} = undef;
+	    
+	    # process the document
+	    $processor->process($doc_obj);
+	    
+	    $self->{'num_processed'} ++;
+	    
+	    return 1; # processed the file
+	}
+    }
+    else {
+	return undef;
+    }
+}
+
+
+# do plugin specific processing of doc_obj
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    print STDERR "<Processing n='$file' p='OAIPlug'>\n" if ($gli);
+    print $outhandle "OAIPlug: processing $file\n"
+	if $self->{'verbosity'} > 1;
+
+    my $cursection = $doc_obj->get_top_section();
+
+##    $self->extract_metadata ($textref, $metadata, $doc_obj, $cursection);
+
+    # add text to document object
+
+#    $$textref =~ s/<(.*?)>/$1 /g;
+    $$textref =~ s/</&lt;/g;
+    $$textref =~ s/>/&gt;/g;
+    $$textref =~ s/\[/&#91;/g;
+    $$textref =~ s/\]/&#93;/g;
+
+##    print STDERR "*** adding text: $$textref\n";
+    
+    $doc_obj->add_utf8_text($cursection, $$textref);
+
+    return 1;
+}
+
+
+# Improvement is to merge this with newer version in MetadataPass
+
+sub open_prettyprint_metadata_table
+{
+    my $self = shift(@_);
+
+    my $att   = "width=100% cellspacing=2";
+    my $style = "style=\'border-bottom: 4px solid #000080\'";
+
+    $self->{'ppmd_table'} = "\n<table $att $style>";
+}
+
+sub add_prettyprint_metadata_line 
+{
+    my $self = shift(@_);
+    my ($metaname, $metavalue_utf8) = @_;
+
+###    $metavalue_utf8 =~ s/hdl\.handle\.net/mcgonagall.cs.waikato.ac.nz:8080\/dspace\/handle/;
+    $metavalue_utf8 = &util::hyperlink_text($metavalue_utf8);
+
+    $self->{'ppmd_table'} .= "  <tr bgcolor=#b5d3cd>\n";
+    $self->{'ppmd_table'} .= "    <td width=30%>\n";
+    $self->{'ppmd_table'} .= "      $metaname\n";
+    $self->{'ppmd_table'} .= "    </td>\n";
+    $self->{'ppmd_table'} .= "    <td>\n";
+    $self->{'ppmd_table'} .= "      $metavalue_utf8\n";
+    $self->{'ppmd_table'} .= "    </td>\n";
+    $self->{'ppmd_table'} .= "  </tr>\n";
+
+}
+
+sub close_prettyprint_metadata_table
+{
+    my $self = shift(@_);
+
+    $self->{'ppmd_table'} .= "</table>\n";
+}
+
+
+sub remap_dcterms_metadata
+{
+    my $self = shift(@_);
+
+    my ($metaname) = @_;
+
+    my $dcterm_mapping = {
+	"alternative" => "dc.title",
+	"tableOfContents" => "dc.description",
+	"abstract" => "dc.description",
+	"created" => "dc.date",
+	"valid" => "dc.date",
+	"available" => "dc.date",
+	"issued" => "dc.date",
+	"modified" => "dc.date",
+	"dateAccepted" => "dc.date",
+	"dateCopyrighted" => "dc.date",
+	"dateSubmitted" => "dc.date",
+	"extent" => "dc.format",
+	"medium" => "dc.format",
+	"isVersionOf" => "dc.relation",
+	"hasVersion" => "dc.relation",
+	"isReplacedBy" => "dc.relation",
+	"replaces" => "dc.relation",
+	"isRequiredBy" => "dc.relation",
+	"requires" => "dc.relation",
+	"isPartOf" => "dc.relation",
+	"hasPart" => "dc.relation",
+	"isReferencedBy" => "dc.relation",
+	"references" => "dc.relation",
+	"isFormatOf" => "dc.relation",
+	"hasFormat" => "dc.relation",
+	"conformsTo" => "dc.relation",
+	"spatial" => "dc.coverage",
+	"temporal" => "dc.coverage",
+	"audience" => "dc.any",
+	"accrualMethod" => "dc.any",
+	"accrualPeriodicity" => "dc.any",
+	"accrualPolicy" => "dc.any",
+	"instructionalMethod" => "dc.any",
+	"provenance" => "dc.any",
+	"rightsHolder" => "dc.any",
+	"mediator" => "audience",
+	"educationLevel" => "audience",
+	"accessRights" => "dc.rights",
+	"license" => "dc.rights",
+	"bibliographicCitation" => "dc.identifier"
+	};
+
+    my ($prefix,$name) = ($metaname =~ m/^(.*?)\.(.*?)$/);
+    
+    if ($prefix eq "dcterms")
+    {
+	if (defined $dcterm_mapping->{$name}) 
+	{
+	    return $dcterm_mapping->{$name}."^".$name;
+	}
+
+    }
+    return $metaname; # didn't get a match, return param passed in unchanged
+}
+
+
+sub extract_oai_metadata {
+    my $self = shift (@_);
+    my ($textref, $metadata) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    # Only handles DC metadata
+
+    $self->open_prettyprint_metadata_table();
+
+    if ($$textref =~ m/<metadata\s*>(.*?)<\/metadata\s*>/s)
+    {
+	my $metadata_text = $1;
+
+	# locate and remove outermost tag (ignoring any attribute information in top-level tag)
+	my ($wrapper_metadata_xml,$inner_metadata_text) = ($metadata_text =~ m/<([^ >]+).*?>(.*?)<\/\1>/s);
+
+	# split tag into namespace and tag name
+	my($namespace,$top_level_prefix) = ($wrapper_metadata_xml =~ m/^(.*?):(.*?)$/);
+
+	if ($top_level_prefix !~ /dc$/) {
+	    print $outhandle "Warning: OAIPlug currently only designed for Dublin Core (or variant) metadata\n";
+	    print $outhandle "         This recorded metadata section '$top_level_prefix' does not appear to match.\n";
+	    print $outhandle "         Metadata assumed to be in form: <prefix:tag>value</prefix:tag> and will be converted\n";
+	    print $outhandle "         into Greenstone metadata as prefix.tag = value\n";
+	}
+
+	while ($inner_metadata_text =~ m/<([^ >]+).*?>(.*?)<\/\1>(.*)/s)
+	{
+	    # if URL given for document as identifier metadata, store it ...
+	    # $doc_obj->add_utf8_metadata($cursection, "URL", $web_url);
+
+	    my $metaname = $1;
+	    my $metavalue = $2;
+	    $inner_metadata_text = $3;
+
+#	    print STDERR "*** metaname = $metaname\n";
+#	    print STDERR "*** metavalue = $metavalue\n";
+
+	    # $metaname =~ s/^(dc:)?(.)/\u$2/; # strip of optional prefix and uppercase first letter
+	    $metaname =~ s/:/\./;
+	    if ($metaname !~ m/\./)
+	    {
+		$metaname = "$top_level_prefix.$metaname";
+	    }
+	    $metaname =~ s/\.(.)/\.\u$1/;
+
+	    $metaname = $self->remap_dcterms_metadata($metaname);
+
+	    $metavalue =~ s/\[/&#91;/g;
+	    $metavalue =~ s/\]/&#93;/g;
+
+
+#	    if ($metaname eq "Identifier")
+#	    {
+#		# name clashes with GSDL reserved metadata name for hash id
+#		$metaname = "URL";
+#	    }
+
+	    if (defined $metadata->{$metaname})
+	    {
+		push(@{$metadata->{$metaname}},$metavalue);
+
+	    }
+	    else
+	    {
+		$metadata->{$metaname} = [ $metavalue ];
+	    }
+
+	    $self->add_prettyprint_metadata_line($metaname, $metavalue);
+	    
+	}
+    }
+
+    $self->close_prettyprint_metadata_table();
+}
+
+## we know from the file extension, so doesn't need to check the doctype
+sub check_doctype {
+
+    return 1;
+}
+
+1;
Index: dl/trunk/perllib/plugins/OggVorbisPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/OggVorbisPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,185 +1,0 @@
-###########################################################################
-#
-# OggVorbisPlug.pm -- A plugin for Ogg Vorbis audio files
-#
-# Original code by Christy Kuo
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright 1999-2004 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 OggVorbisPlug;
-
-
-use UnknownPlug;
-use Ogg::Vorbis::Header::PurePerl;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @OggVorbisPlug::ISA = ('UnknownPlug');
-}
-
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "string",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" },
-      { 'name' => "add_technical_metadata",
-	'desc' => "{OggVorbisPlug.add_technical_metadata}",
-	'type' => "flag",
-	'deft' => "" } ];
-
-my $options = { 'name'     => "OggVorbisPlug",
-		'desc'     => "{OggVorbisPlug.desc}",
-		'inherits' => "yes",
-		'abstract' => "no",
-		'args'     => $arguments };
-
-
-# This plugin processes exported Ogg Vorbis files with the suffix ".ogg"
-sub get_default_process_exp
-{
-    return q^(?i)(\.ogg)$^;
-}
-
-
-sub new
-{
-    my ($class) = shift(@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-    
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-    
-    my $self = new UnknownPlug($pluginlist, $inputargs, $hashArgOptLists);
-    
-    return bless $self, $class;
-}
-
-
-sub read
-{
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-
-    #check process and block exps, smart block, etc
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-
-     # Report that we're processing the file
-    print STDERR "<Processing n='$file' p='OggVorbisPlug'>\n" if ($gli);
-    print $outhandle "OggVorbisPlug: processing $file\n"
-  	if ($self->{'verbosity'}) > 1;
-    
-    # file is just the name of the file (need to get rid off any leading directory names)
-    $file =~ s/^.*[\/\\]//;
-
-    # create a new index document
-    my $doc_obj = new doc ($filename, "indexed_doc");
-    if ($processor->{'OIDtype'} =~ /^(assigned|dirname)$/) {
-	$doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
-    }
-    else {
-	$doc_obj->set_OIDtype ("incremental");    # this is done to avoid hashing content of file
-    }
-    my $section = $doc_obj->get_top_section();
-    
-    # replace spaces in filename with %20 in url for metadata entry
-    my $url = $file;
-    ##$url =~ s/ /%20/g;
-
-    # Source (filename) to be consistent with other plugins
-    $doc_obj->add_metadata ($section, "Source", $url);
-
-    # Extract metadata
-    my $ogg = Ogg::Vorbis::Header::PurePerl->new($filename);
-
-    # Comments added to the file
-    foreach my $key ($ogg->comment_tags())
-    {
-	# Convert key to title case
-	my $keytc = uc(substr($key, 0, 1)) . substr($key, 1, length($key));
-	foreach my $value ($ogg->comment($key))
-	{
-	    if (defined $value && $value ne "") {
-		$doc_obj->add_metadata($section, $keytc, $value);
-	    }
-	}
-    }
-
-    # Technical data (optional)
-    if ($self->{'add_technical_metadata'}) {
-	foreach my $key (keys %{$ogg->info})
-	{
-	    # Convert key to title case
-	    my $keytc = uc(substr($key, 0, 1)) . substr($key, 1, length($key));
-	    my $value = $ogg->info->{$key};
-	    if (defined $value && $value ne "") {
-		$doc_obj->add_metadata($section, $keytc, $value);
-	    }
-	}
-    }
-
-    # srclink
-    $doc_obj->add_metadata ($section, "FileFormat", "OggVorbis");
-    $doc_obj->add_metadata ($section, "srclink", "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Source]\">");
-    $doc_obj->add_metadata ($section, "/srclink", "</a>");
-    # srcicon (need to include "iogg.gif" in the greenstone images directory
-    $doc_obj->add_metadata ($section, "srcicon", "<img src=\"_httpprefix_/images/iogg.gif\" title=\"Download\" border=0>");
-
-    # add NoText metadata which can be used to suppress the dummy text
-    $doc_obj->add_metadata ($section, "NoText", "1");
-
-    # Add the actual file as an associated file
-    $doc_obj->associate_file($filename, $file, "VORBIS", $section);
-
-    # Create an empty text string so we don't break downstream plugins 
-     my $text = &gsprintf::lookup_string("{BasPlug.dummy_text}",1);
-
-    # include any metadata passed in from previous plugins
-    $self->extra_metadata ($doc_obj, $section, $metadata);
-
-    # do plugin specific processing of doc_obj
-    return undef unless defined ($self->process (\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj));
-
-    # do any automatic metadata extraction
-    $self->auto_extract_metadata($doc_obj);
-
-    # add an OID
-    $doc_obj->set_OID();
-    $doc_obj->add_utf8_text($section, $text);
-
-    # process the document
-    $processor->process($doc_obj);
-
-    $self->{'num_processed'}++;
-    return 1;
-}
-
-
-1;
Index: /gsdl/trunk/perllib/plugins/OggVorbisPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/OggVorbisPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/OggVorbisPlugin.pm	(revision 15865)
@@ -0,0 +1,185 @@
+###########################################################################
+#
+# OggVorbisPlug.pm -- A plugin for Ogg Vorbis audio files
+#
+# Original code by Christy Kuo
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright 1999-2004 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 OggVorbisPlug;
+
+
+use UnknownPlug;
+use Ogg::Vorbis::Header::PurePerl;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @OggVorbisPlug::ISA = ('UnknownPlug');
+}
+
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "string",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" },
+      { 'name' => "add_technical_metadata",
+	'desc' => "{OggVorbisPlug.add_technical_metadata}",
+	'type' => "flag",
+	'deft' => "" } ];
+
+my $options = { 'name'     => "OggVorbisPlug",
+		'desc'     => "{OggVorbisPlug.desc}",
+		'inherits' => "yes",
+		'abstract' => "no",
+		'args'     => $arguments };
+
+
+# This plugin processes exported Ogg Vorbis files with the suffix ".ogg"
+sub get_default_process_exp
+{
+    return q^(?i)(\.ogg)$^;
+}
+
+
+sub new
+{
+    my ($class) = shift(@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+    
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+    
+    my $self = new UnknownPlug($pluginlist, $inputargs, $hashArgOptLists);
+    
+    return bless $self, $class;
+}
+
+
+sub read
+{
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+
+    #check process and block exps, smart block, etc
+    my ($block_status,$filename) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+
+     # Report that we're processing the file
+    print STDERR "<Processing n='$file' p='OggVorbisPlug'>\n" if ($gli);
+    print $outhandle "OggVorbisPlug: processing $file\n"
+  	if ($self->{'verbosity'}) > 1;
+    
+    # file is just the name of the file (need to get rid off any leading directory names)
+    $file =~ s/^.*[\/\\]//;
+
+    # create a new index document
+    my $doc_obj = new doc ($filename, "indexed_doc");
+    if ($processor->{'OIDtype'} =~ /^(assigned|dirname)$/) {
+	$doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
+    }
+    else {
+	$doc_obj->set_OIDtype ("incremental");    # this is done to avoid hashing content of file
+    }
+    my $section = $doc_obj->get_top_section();
+    
+    # replace spaces in filename with %20 in url for metadata entry
+    my $url = $file;
+    ##$url =~ s/ /%20/g;
+
+    # Source (filename) to be consistent with other plugins
+    $doc_obj->add_metadata ($section, "Source", $url);
+
+    # Extract metadata
+    my $ogg = Ogg::Vorbis::Header::PurePerl->new($filename);
+
+    # Comments added to the file
+    foreach my $key ($ogg->comment_tags())
+    {
+	# Convert key to title case
+	my $keytc = uc(substr($key, 0, 1)) . substr($key, 1, length($key));
+	foreach my $value ($ogg->comment($key))
+	{
+	    if (defined $value && $value ne "") {
+		$doc_obj->add_metadata($section, $keytc, $value);
+	    }
+	}
+    }
+
+    # Technical data (optional)
+    if ($self->{'add_technical_metadata'}) {
+	foreach my $key (keys %{$ogg->info})
+	{
+	    # Convert key to title case
+	    my $keytc = uc(substr($key, 0, 1)) . substr($key, 1, length($key));
+	    my $value = $ogg->info->{$key};
+	    if (defined $value && $value ne "") {
+		$doc_obj->add_metadata($section, $keytc, $value);
+	    }
+	}
+    }
+
+    # srclink
+    $doc_obj->add_metadata ($section, "FileFormat", "OggVorbis");
+    $doc_obj->add_metadata ($section, "srclink", "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Source]\">");
+    $doc_obj->add_metadata ($section, "/srclink", "</a>");
+    # srcicon (need to include "iogg.gif" in the greenstone images directory
+    $doc_obj->add_metadata ($section, "srcicon", "<img src=\"_httpprefix_/images/iogg.gif\" title=\"Download\" border=0>");
+
+    # add NoText metadata which can be used to suppress the dummy text
+    $doc_obj->add_metadata ($section, "NoText", "1");
+
+    # Add the actual file as an associated file
+    $doc_obj->associate_file($filename, $file, "VORBIS", $section);
+
+    # Create an empty text string so we don't break downstream plugins 
+     my $text = &gsprintf::lookup_string("{BasPlug.dummy_text}",1);
+
+    # include any metadata passed in from previous plugins
+    $self->extra_metadata ($doc_obj, $section, $metadata);
+
+    # do plugin specific processing of doc_obj
+    return undef unless defined ($self->process (\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj));
+
+    # do any automatic metadata extraction
+    $self->auto_extract_metadata($doc_obj);
+
+    # add an OID
+    $doc_obj->set_OID();
+    $doc_obj->add_utf8_text($section, $text);
+
+    # process the document
+    $processor->process($doc_obj);
+
+    $self->{'num_processed'}++;
+    return 1;
+}
+
+
+1;
Index: dl/trunk/perllib/plugins/OpenDocumentPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/OpenDocumentPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,299 +1,0 @@
-###########################################################################
-#
-# OpenDocumentPlug.pm -- The Open Document plugin
-# 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 OASIS Open Document format.
-# Word processing document: .odt, template: .ott 
-# Spreadsheet document: .ods, template: .ots
-# Presentation document: .odp, template: .otp
-# Graphics document: .odg, template: .otg
-# Formulas document: .odf, template: .otf (not supported)
-
-#This basically extracts any text out of the document, but not much else. 
-
-package OpenDocumentPlug;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-use XMLPlug;
-use XML::XPath;
-use XML::XPath::XMLParser;
-use Cwd;
-use util;
-use ghtml;
-
-sub BEGIN {
-    @OpenDocumentPlug::ISA = ('XMLPlug');
-}
-
-
-#our @filesAssoc = ();
-our @filesProcess = ( "content.xml" , "meta.xml" );
-#XML plug has this so we need it too
-our ($self);
-
-my $arguments = [
-		 { 'name' => "process_exp",
-		   'desc' => "{BasPlug.process_exp}",
-		   'type' => "regexp",
-		   'deft' =>  &get_default_process_exp() }
-		 ];
-
-my $options = { 'name'     => "OpenDocumentPlug",
-		'desc'     => "{OpenDocumentPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments};
-
-sub get_default_process_exp { return q^(?i)\.o(?:d|t)(?:t|s|p|g)$^; }
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new XMLPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    $self->{'section'} = "";
-    $self->{'office:meta'} = "";
-    
-    return bless $self, $class;
-}
-
-sub get_doctype {
-    my $self = shift(@_);
-    
-    return "manifest:manifest";
-}
-
-sub xml_doctype {
-    my $self = shift(@_);
-    my ($expat, $name, $sysid, $pubid, $internal) = @_;
-    die "The only valid doctype is manifest, $name is not valid" if ($name ne "manifest:manifest");
-}
-
-# Called for every start tag. The $_ variable will contain a copy of the
-# tag and the %_ variable will contain the element's attributes.
-sub xml_start_tag {
-    my $self = shift(@_);
-    my ($expat, $element) = @_;
-    my %atts  = %_;
-    $self->{'office:meta'} = $element if $self->{'office:meta'} eq "Start";
-    if($element eq 'office:text') {
-	$self->{'collectedText'} = "";
-    }elsif($element eq 'office:meta') {
-	$self->{'collectedText'} = "";
-	$self->{'office:meta'} = "Start";
-    }elsif($element eq 'meta:document-statistic'){
-	foreach my $att (keys %atts) {
-	    $self->{'doc_obj'}->add_utf8_metadata("",$att,$atts{$att});
-	}
-	
-    }
-}
-
-sub xml_end_tag {
-    my $self = shift(@_);
-    my ($expat, $element) = @_;
-    
-    if($element eq 'office:text') {
-	$self->{'doc_obj'}->add_utf8_text("",$self->{'collectedText'});
-	$self->{'collectedText'} = "";
-    }elsif($element eq $self->{'office:meta'}) {
-	if( $self->{'collectedText'} ne "") {
-	    $self->{'doc_obj'}->add_utf8_metadata("",$self->{'office:meta'},$self->{'collectedText'});
-	    $self->{'doc_obj'}->add_utf8_metadata("","Title",$self->{'collectedText'}) if $self->{'office:meta'} =~ m/:title$/;
-	    $self->{'doc_obj'}->add_utf8_metadata("","Language",$self->{'collectedText'}) if $self->{'office:meta'} =~ m/:language$/;
-	    $self->{'doc_obj'}->add_utf8_metadata("","GENERATOR",$self->{'collectedText'}) if $self->{'office:meta'} =~ m/:generator$/;
-	    
-    	}
-	$self->{'collectedText'} = "";
-        $self->{'office:meta'} = "Start";
-    }elsif($element eq 'office:meta'){
-	$self->{'office:meta'} = "";
-    }elsif($element eq 'office:body'){
-	#some documents have text in other places that should probably be indexed if we can't find any doc text
-	
-	if( defined $self->{'collectedText'} && $self->{'collectedText'} ne "" && $self->{'doc_obj'}->get_text("") eq "") {
-	    $self->{'doc_obj'}->add_utf8_text("",$self->{'collectedText'});
-	}
-    }
-}
-
-sub xml_text {
-    my $self = shift(@_);
-    my ($expat) = @_;
-    if($_ =~ m/\w/i) {
-	$self->{'collectedText'} .= "<br/>" if $self->{'collectedText'} ne "";
-	$self->{'collectedText'} .= "$_";
-    }
-}
-
-#trap start and end document so we do not get our doc_obj closed too soon
-sub xml_start_document {}
-sub xml_end_document {}
-
-sub read {
-    # $self must be global to work with XML callback routines.
-    $self = shift (@_);  
-   
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    # check process and block exps, smart block, associate_ext etc
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-
-    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
-    $self->{'file'} = $file;
-    $self->{'filename'} = $filename;
-    $self->{'processor'} = $processor;
-    $self->{'metadata'} = $metadata;
-    
-    eval{
-	my ($file_only) = $file =~ /([^\\\/]*)$/;
-	my $tmpdir = &util::get_tmp_filename ();
-	&util::mk_all_dir ($tmpdir);
-	
-	$self->open_document();
-	
-	# save current working directory
-	my $cwd = getcwd();
-	chdir ($tmpdir) || die "Unable to change to $tmpdir";
-	&util::cp ($filename, $tmpdir);
-	
-	$self->unzip ("\"$file_only\"");
-	foreach my $xmlFile (@OpenDocumentPlug::filesProcess) {
-	    if (-e $xmlFile) {
-		$self->parse_file($xmlFile);
-	    }
-	}
-	$self->close_document($filename,$file_only);
-	
-	chdir ($cwd) || die "Unable to change back to $cwd";
-	&util::rm_r ($tmpdir);
-	
-    };
-    
-    if ($@) {
-
-	# parsefile may either croak somewhere in XML::Parser (e.g. because
-	# the document is not well formed) or die somewhere in XMLPlug or a
-	# derived plugin (e.g. because we're attempting to process a
-	# document whose DOCTYPE is not meant for this plugin). For the
-	# first case we'll print a warning and continue, for the second
-	# we'll just continue quietly
-
-	print STDERR "**** Error is: $@\n";
-
-	my ($msg) = $@ =~ /Carp::croak\(\'(.*?)\'\)/;
-	if (defined $msg) {	
-	    my $outhandle = $self->{'outhandle'};
-	    my $plugin_name = ref ($self);
-	    print $outhandle "$plugin_name failed to process $file ($msg)\n";
-	}
-
-	# reset ourself for the next document
-	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
-	return -1; # error during processing
-    }
-
-    return 1;
-}
-
-sub unzip {
-    my $self = shift (@_);
-    my ($file) = @_;
-
-    system ("unzip $file");
-    &util::rm ($file) if -e $file;
-}
-
-sub close_document() {
-    my $self = shift(@_);
-    my ($filename,$file_only) = @_;
-  
-    my $doc_obj = $self->{'doc_obj'};  
-
-    my $mimetype = $self->get_mimetype();
-    
-    $doc_obj->associate_file($filename, $file_only, $mimetype, "");
-    $doc_obj->associate_file("Thumbnails/thumbnail.png", "thumbnail.png", "image/png", "");
-    my $doc_ext = $filename;
-    $doc_ext =~ s/.*\.od(.)/od$1/;
-    
-    # We use set instead of add here because we only want one value
-    $doc_obj->set_utf8_metadata_element("", "FileFormat", "Open Document");
-
-    #setup to doclink thingi
-    my $doclink = "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[archivedir]/$file_only\">";
-    $doc_obj->add_utf8_metadata ("", "srclink",  $doclink); 
-    $doc_obj->add_utf8_metadata ("", "srcicon",  "<img border=\"0\" align=\"absmiddle\" src=\"_httpprefix_/collect/[collection]/index/assoc/[archivedir]/thumbnail.png\" alt=\"View the Open document\" title=\"View the Open document\">"); 
-    $doc_obj->add_utf8_metadata ("", "/srclink", "</a>"); 
-    $doc_obj->add_utf8_metadata ("", "Source", &ghtml::dmsafe($file_only));
-    $doc_obj->set_utf8_metadata_element("", "FileSize", (-s $filename));
-     
-    # include any metadata passed in from previous plugins 
-    # note that this metadata is associated with the top level section
-    $self->extra_metadata ($doc_obj, 
-			   $doc_obj->get_top_section(), 
-			   $self->{'metadata'});
-    
-    # add a Title if none has been found yet
-    $self->title_fallback($doc_obj,"",$file_only);
-   
-    # add an OID
-    $doc_obj->set_OID();
-    
-    $doc_obj->add_utf8_metadata("", "Plugin", "$self->{'plugin_type'}");
-
-    # process the document
-    $self->{'processor'}->process($doc_obj);
-    
-    $self->{'num_processed'} ++;
-    return 1;
-}
-
-sub get_mimetype(){
-    my $filename = "mimetype";
-    if (!open (FILEIN,"<$filename")){
-   	print STDERR "Warning: unable to open the $filename\n";
-	return "Unknown OpenDocument Format";
-    }
-    else {
-	my $text = "";
-	while (defined (my $line = <FILEIN>)) {
-	   $text .= $line;   
-	}
-	return $text;
-    }
-}
-1;
-
-
-
-
Index: /gsdl/trunk/perllib/plugins/OpenDocumentPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/OpenDocumentPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/OpenDocumentPlugin.pm	(revision 15865)
@@ -0,0 +1,299 @@
+###########################################################################
+#
+# OpenDocumentPlug.pm -- The Open Document plugin
+# 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 OASIS Open Document format.
+# Word processing document: .odt, template: .ott 
+# Spreadsheet document: .ods, template: .ots
+# Presentation document: .odp, template: .otp
+# Graphics document: .odg, template: .otg
+# Formulas document: .odf, template: .otf (not supported)
+
+#This basically extracts any text out of the document, but not much else. 
+
+package OpenDocumentPlug;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+use XMLPlug;
+use XML::XPath;
+use XML::XPath::XMLParser;
+use Cwd;
+use util;
+use ghtml;
+
+sub BEGIN {
+    @OpenDocumentPlug::ISA = ('XMLPlug');
+}
+
+
+#our @filesAssoc = ();
+our @filesProcess = ( "content.xml" , "meta.xml" );
+#XML plug has this so we need it too
+our ($self);
+
+my $arguments = [
+		 { 'name' => "process_exp",
+		   'desc' => "{BasPlug.process_exp}",
+		   'type' => "regexp",
+		   'deft' =>  &get_default_process_exp() }
+		 ];
+
+my $options = { 'name'     => "OpenDocumentPlug",
+		'desc'     => "{OpenDocumentPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments};
+
+sub get_default_process_exp { return q^(?i)\.o(?:d|t)(?:t|s|p|g)$^; }
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new XMLPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    $self->{'section'} = "";
+    $self->{'office:meta'} = "";
+    
+    return bless $self, $class;
+}
+
+sub get_doctype {
+    my $self = shift(@_);
+    
+    return "manifest:manifest";
+}
+
+sub xml_doctype {
+    my $self = shift(@_);
+    my ($expat, $name, $sysid, $pubid, $internal) = @_;
+    die "The only valid doctype is manifest, $name is not valid" if ($name ne "manifest:manifest");
+}
+
+# Called for every start tag. The $_ variable will contain a copy of the
+# tag and the %_ variable will contain the element's attributes.
+sub xml_start_tag {
+    my $self = shift(@_);
+    my ($expat, $element) = @_;
+    my %atts  = %_;
+    $self->{'office:meta'} = $element if $self->{'office:meta'} eq "Start";
+    if($element eq 'office:text') {
+	$self->{'collectedText'} = "";
+    }elsif($element eq 'office:meta') {
+	$self->{'collectedText'} = "";
+	$self->{'office:meta'} = "Start";
+    }elsif($element eq 'meta:document-statistic'){
+	foreach my $att (keys %atts) {
+	    $self->{'doc_obj'}->add_utf8_metadata("",$att,$atts{$att});
+	}
+	
+    }
+}
+
+sub xml_end_tag {
+    my $self = shift(@_);
+    my ($expat, $element) = @_;
+    
+    if($element eq 'office:text') {
+	$self->{'doc_obj'}->add_utf8_text("",$self->{'collectedText'});
+	$self->{'collectedText'} = "";
+    }elsif($element eq $self->{'office:meta'}) {
+	if( $self->{'collectedText'} ne "") {
+	    $self->{'doc_obj'}->add_utf8_metadata("",$self->{'office:meta'},$self->{'collectedText'});
+	    $self->{'doc_obj'}->add_utf8_metadata("","Title",$self->{'collectedText'}) if $self->{'office:meta'} =~ m/:title$/;
+	    $self->{'doc_obj'}->add_utf8_metadata("","Language",$self->{'collectedText'}) if $self->{'office:meta'} =~ m/:language$/;
+	    $self->{'doc_obj'}->add_utf8_metadata("","GENERATOR",$self->{'collectedText'}) if $self->{'office:meta'} =~ m/:generator$/;
+	    
+    	}
+	$self->{'collectedText'} = "";
+        $self->{'office:meta'} = "Start";
+    }elsif($element eq 'office:meta'){
+	$self->{'office:meta'} = "";
+    }elsif($element eq 'office:body'){
+	#some documents have text in other places that should probably be indexed if we can't find any doc text
+	
+	if( defined $self->{'collectedText'} && $self->{'collectedText'} ne "" && $self->{'doc_obj'}->get_text("") eq "") {
+	    $self->{'doc_obj'}->add_utf8_text("",$self->{'collectedText'});
+	}
+    }
+}
+
+sub xml_text {
+    my $self = shift(@_);
+    my ($expat) = @_;
+    if($_ =~ m/\w/i) {
+	$self->{'collectedText'} .= "<br/>" if $self->{'collectedText'} ne "";
+	$self->{'collectedText'} .= "$_";
+    }
+}
+
+#trap start and end document so we do not get our doc_obj closed too soon
+sub xml_start_document {}
+sub xml_end_document {}
+
+sub read {
+    # $self must be global to work with XML callback routines.
+    $self = shift (@_);  
+   
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    # check process and block exps, smart block, associate_ext etc
+    my ($block_status,$filename) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+
+    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
+    $self->{'file'} = $file;
+    $self->{'filename'} = $filename;
+    $self->{'processor'} = $processor;
+    $self->{'metadata'} = $metadata;
+    
+    eval{
+	my ($file_only) = $file =~ /([^\\\/]*)$/;
+	my $tmpdir = &util::get_tmp_filename ();
+	&util::mk_all_dir ($tmpdir);
+	
+	$self->open_document();
+	
+	# save current working directory
+	my $cwd = getcwd();
+	chdir ($tmpdir) || die "Unable to change to $tmpdir";
+	&util::cp ($filename, $tmpdir);
+	
+	$self->unzip ("\"$file_only\"");
+	foreach my $xmlFile (@OpenDocumentPlug::filesProcess) {
+	    if (-e $xmlFile) {
+		$self->parse_file($xmlFile);
+	    }
+	}
+	$self->close_document($filename,$file_only);
+	
+	chdir ($cwd) || die "Unable to change back to $cwd";
+	&util::rm_r ($tmpdir);
+	
+    };
+    
+    if ($@) {
+
+	# parsefile may either croak somewhere in XML::Parser (e.g. because
+	# the document is not well formed) or die somewhere in XMLPlug or a
+	# derived plugin (e.g. because we're attempting to process a
+	# document whose DOCTYPE is not meant for this plugin). For the
+	# first case we'll print a warning and continue, for the second
+	# we'll just continue quietly
+
+	print STDERR "**** Error is: $@\n";
+
+	my ($msg) = $@ =~ /Carp::croak\(\'(.*?)\'\)/;
+	if (defined $msg) {	
+	    my $outhandle = $self->{'outhandle'};
+	    my $plugin_name = ref ($self);
+	    print $outhandle "$plugin_name failed to process $file ($msg)\n";
+	}
+
+	# reset ourself for the next document
+	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
+	return -1; # error during processing
+    }
+
+    return 1;
+}
+
+sub unzip {
+    my $self = shift (@_);
+    my ($file) = @_;
+
+    system ("unzip $file");
+    &util::rm ($file) if -e $file;
+}
+
+sub close_document() {
+    my $self = shift(@_);
+    my ($filename,$file_only) = @_;
+  
+    my $doc_obj = $self->{'doc_obj'};  
+
+    my $mimetype = $self->get_mimetype();
+    
+    $doc_obj->associate_file($filename, $file_only, $mimetype, "");
+    $doc_obj->associate_file("Thumbnails/thumbnail.png", "thumbnail.png", "image/png", "");
+    my $doc_ext = $filename;
+    $doc_ext =~ s/.*\.od(.)/od$1/;
+    
+    # We use set instead of add here because we only want one value
+    $doc_obj->set_utf8_metadata_element("", "FileFormat", "Open Document");
+
+    #setup to doclink thingi
+    my $doclink = "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[archivedir]/$file_only\">";
+    $doc_obj->add_utf8_metadata ("", "srclink",  $doclink); 
+    $doc_obj->add_utf8_metadata ("", "srcicon",  "<img border=\"0\" align=\"absmiddle\" src=\"_httpprefix_/collect/[collection]/index/assoc/[archivedir]/thumbnail.png\" alt=\"View the Open document\" title=\"View the Open document\">"); 
+    $doc_obj->add_utf8_metadata ("", "/srclink", "</a>"); 
+    $doc_obj->add_utf8_metadata ("", "Source", &ghtml::dmsafe($file_only));
+    $doc_obj->set_utf8_metadata_element("", "FileSize", (-s $filename));
+     
+    # include any metadata passed in from previous plugins 
+    # note that this metadata is associated with the top level section
+    $self->extra_metadata ($doc_obj, 
+			   $doc_obj->get_top_section(), 
+			   $self->{'metadata'});
+    
+    # add a Title if none has been found yet
+    $self->title_fallback($doc_obj,"",$file_only);
+   
+    # add an OID
+    $doc_obj->set_OID();
+    
+    $doc_obj->add_utf8_metadata("", "Plugin", "$self->{'plugin_type'}");
+
+    # process the document
+    $self->{'processor'}->process($doc_obj);
+    
+    $self->{'num_processed'} ++;
+    return 1;
+}
+
+sub get_mimetype(){
+    my $filename = "mimetype";
+    if (!open (FILEIN,"<$filename")){
+   	print STDERR "Warning: unable to open the $filename\n";
+	return "Unknown OpenDocument Format";
+    }
+    else {
+	my $text = "";
+	while (defined (my $line = <FILEIN>)) {
+	   $text .= $line;   
+	}
+	return $text;
+    }
+}
+1;
+
+
+
+
Index: dl/trunk/perllib/plugins/PDFPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/PDFPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,335 +1,0 @@
-###########################################################################
-#
-# PDFPlug.pm -- reasonably with-it pdf plugin
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999-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.
-#
-###########################################################################
-package PDFPlug;
-
-use ConvertToPlug;
-use unicode;
-use strict;
-no strict 'refs'; # so we can use a var for filehandles (eg STDERR)
-
-sub BEGIN {
-    @PDFPlug::ISA = ('ConvertToPlug');
-}
-
-my $convert_to_list =
-    [ {	'name' => "auto",
-	'desc' => "{ConvertToPlug.convert_to.auto}" },
-      {	'name' => "html",
-	'desc' => "{ConvertToPlug.convert_to.html}" },
-      {	'name' => "text",
-	'desc' => "{ConvertToPlug.convert_to.text}" },
-      { 'name' => "pagedimg_jpg",
-	'desc' => "{ConvertToPlug.convert_to.pagedimg_jpg}"},
-      { 'name' => "pagedimg_gif",
-	'desc' => "{ConvertToPlug.convert_to.pagedimg_gif}"},
-      { 'name' => "pagedimg_png",
-	'desc' => "{ConvertToPlug.convert_to.pagedimg_png}"}, 
-      ];
-
-
-my $arguments = 
-    [
-     { 'name' => "convert_to",
-       'desc' => "{ConvertToPlug.convert_to}",
-       'type' => "enum",
-       'reqd' => "yes",
-       'list' => $convert_to_list, 
-       'deft' => "html" },	 
-     { 'name' => "process_exp",
-       'desc' => "{BasPlug.process_exp}",
-       'type' => "regexp",
-       'deft' => &get_default_process_exp(),
-       'reqd' => "no" },
-     { 'name' => "block_exp",
-       'desc' => "{BasPlug.block_exp}",
-       'type' => "regexp",
-       'deft' => &get_default_block_exp() },
-     { 'name' => "metadata_fields",
-       'desc' => "{HTMLPlug.metadata_fields}",
-       'type' => "string",
-       'deft' => "" },
-     { 'name' => "noimages",
-       'desc' => "{PDFPlug.noimages}",
-       'type' => "flag" },
-     { 'name' => "allowimagesonly",
-       'desc' => "{PDFPlug.allowimagesonly}",
-       'type' => "flag" },
-     { 'name' => "complex",
-       'desc' => "{PDFPlug.complex}",
-       'type' => "flag" },
-     { 'name' => "nohidden",
-       'desc' => "{PDFPlug.nohidden}",
-       'type' => "flag" },
-     { 'name' => "zoom",
-       'desc' => "{PDFPlug.zoom}",
-       'deft' => "2",
-       'range' => "1,3", # actually the range is 0.5-3 
-       'type' => "int" },
-     { 'name' => "use_sections",
-       'desc' => "{PDFPlug.use_sections}",
-       'type' => "flag" },
-     { 'name' => "description_tags",
-       'desc' => "{HTMLPlug.description_tags}",
-       'type' => "flag" }
-     ];
-
-my $options = { 'name'     => "PDFPlug",
-		'desc'     => "{PDFPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'srcreplaceable' => "yes", # Source docs in PDF can be replaced with GS-generated html		
-		'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    push(@$inputargs,"-title_sub");
-    push(@$inputargs,'^(Page\s+\d+)?(\s*1\s+)?');
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my @arg_array = @$inputargs;
-    my $self = new ConvertToPlug($pluginlist, $inputargs, $hashArgOptLists);
-    
-    if ($self->{'info_only'}) {
-	# don't worry about any options etc
-	return bless $self, $class;
-    }
-
-    # these are passed through to gsConvert.pl by ConvertToPlug.pm
-    my $zoom = $self->{"zoom"};
-    $self->{'convert_options'} = "-pdf_zoom $zoom";
-    $self->{'convert_options'} .= " -pdf_complex" if $self->{"complex"};
-    $self->{'convert_options'} .= " -pdf_nohidden" if $self->{"nohidden"};
-    $self->{'convert_options'} .= " -pdf_ignore_images" if $self->{"noimages"};
-    $self->{'convert_options'} .= " -pdf_allow_images_only" if $self->{"allowimagesonly"};
-
-    my $secondary_plugin_options = $self->{'secondary_plugin_options'};
-
-    if (!defined $secondary_plugin_options->{'HTMLPlug'}) {
-	$secondary_plugin_options->{'HTMLPlug'} = [];
-    }
-    if (!defined $secondary_plugin_options->{'TEXTPlug'}) {
-	$secondary_plugin_options->{'TEXTPlug'} = [];
-    }
-    if (defined $self->{'convert_to'} && $self->{'convert_to'} =~ /pagedimg.*/i) {
-	if (!defined $secondary_plugin_options->{'PagedImgPlug'}){
-	    $secondary_plugin_options->{'PagedImgPlug'} = [];
-	    my $pagedimg_options = $secondary_plugin_options->{'PagedImgPlug'}; 
-	    push(@$pagedimg_options, "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
-	}
-    }
-    my $html_options = $secondary_plugin_options->{'HTMLPlug'};
-    my $text_options = $secondary_plugin_options->{'TEXTPlug'};
-    my $pagedimg_options = $secondary_plugin_options->{'PagedImgPlug'};
-   
-    if ($self->{'input_encoding'} eq "auto") {
-	$self->{'input_encoding'} = "utf8";
-    }
-
-    # if pdftohtml is always producing utf8, then htmlplug always needs this option
-    push(@$html_options,"-input_encoding", "utf8");
-    push(@$html_options,"-extract_language") if $self->{'extract_language'};
-    # Instruct HTMLPlug (when eventually accessed through read_into_doc_obj) 
-    # to extract these metadata fields from the HEAD META fields
-    my $required_metadata;
-    if (defined $self->{'metadata_fields'} && $self->{'metadata_fields'} =~ /\S/) {
-	push(@$html_options,"-metadata_fields",$self->{'metadata_fields'});
-    } else {
-	push(@$html_options,"-metadata_fields","Title,GENERATOR,date,author<Creator>");
-    }
-    #push(@$html_options,"-metadata_fields","Title,GENERATOR,date,author<Creator>");
-        
-    if ($self->{'use_sections'} || $self->{'description_tags'}) {
-	$self->{'description_tags'} = 1;
-	push(@$html_options,"-description_tags");
-    }
-
-    # following title_sub removes "Page 1" added by pdftohtml, and a leading
-    # "1", which is often the page number at the top of the page. Bad Luck
-    # if your document title actually starts with "1 " - is there a better way?
-    push(@$html_options , "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
-    push(@$text_options , "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
-
-    my $associate_tail_re = $self->{'associate_tail_re'};
-    if ((defined $associate_tail_re) && ($associate_tail_re ne "")) {
-	push(@$html_options, "-associate_tail_re", $associate_tail_re);
-	push(@$text_options, "-associate_tail_re", $associate_tail_re);
-	push(@$pagedimg_options, "-associate_tail_re", $associate_tail_re);
-    }
-
- 
-    $self = bless $self, $class;
-    $self->load_secondary_plugins($class,$secondary_plugin_options,$hashArgOptLists);
-    return $self;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)\.pdf$^;
-}
-
-# so we don't inherit HTMLPlug's block exp...
-sub get_default_block_exp {
-    return "";
-}
-    
-sub convert_post_process
-{
-    my $self = shift (@_);
-    my ($conv_filename) = @_;
-
-    my $outhandle=$self->{'outhandle'};
-
-    my ($language, $encoding) = $self->textcat_get_language_encoding ($conv_filename);
-
-    # read in file ($text will be in utf8)
-    my $text = "";
-    $self->read_file ($conv_filename, $encoding, $language, \$text);
-
-    # Calculate number of pages based on <a ...> tags (we have a <a name=1> etc
-    # for each page).  Metadata based on this calculation not set until process()
-    # 
-    # Note: this is done even if we are not breaking to document into pages as it might
-    # be useful to give an indication of document length in browser through setting
-    # num_pages as metadata.
-    my @pages = ($text =~ /\<[Aa] name=\"?\w+\"?>/ig);
-    my $num_pages = scalar(@pages);
-    $self->{'num_pages'} = $num_pages;
-
-    if ($self->{'use_sections'}
-	&& $self->{'converted_to'} eq "HTML") {
-
-	print $outhandle "PDFPlug: Calculating sections...\n";
-
-	# we have "<a name=1></a>" etc for each page
-	# it may be <A name=
-	my @sections = split('<[Aa] name=', $text);
-
-	my $top_section = "";
-
-	if (scalar (@sections) == 1) { #only one section - no split!
-	    print $outhandle "PDFPlug: warning - no sections found\n";
-	} else {
-	    $top_section .= shift @sections; # keep HTML header etc as top_section
-	}
-
-	# handle first section specially for title? Or all use first 100...
-	
-	my $title = $sections[0];
-	$title =~ s/^\"?\w+\"?>//; # specific for pdftohtml...
-	$title =~ s/<\/([^>]+)><\1>//g; # (eg) </b><b> - no space
-	$title =~ s/<[^>]*>/ /g;
-	$title =~ s/(?:&nbsp;|\xc2\xa0)/ /g; # utf-8 for nbsp...
-	$title =~ s/^\s+//s;
-	$title =~ s/\s+$//;
-	$title =~ s/\s+/ /gs;
-	$title =~ s/^$self->{'title_sub'}// if ($self->{'title_sub'});
-	$title =~ s/^\s+//s; # in case title_sub introduced any...
-	$title = substr ($title, 0, 100);
-	$title =~ s/\s\S*$/.../;
-
-
-	if (scalar (@sections) == 1) { # no sections found
-	    $top_section .= $sections[0];
-	    @sections=();
-	} else {
-	    $top_section .= "<!--<Section>\n<Metadata name=\"Title\">$title</Metadata>\n-->\n <!--</Section>-->\n";
-	}
-
-	# add metadata per section...
-	foreach my $section (@sections) {
-	    # section names are not always just digits, may be like "outline"
-	    $section =~ s@^\"?(\w+)\"?></a>@@; # leftover from split expression...
-
-	    $title = $1; # Greenstone does magic if sections are titled digits
-	    if (! defined($title) ) {
-		print STDERR "no title: $section\n";
-		$title = " "; # get rid of the undefined warning in next line
-	    }
-	    my $newsection = "<!-- from PDFPlug -->\n<!-- <Section>\n";
-	    $newsection .= "<Metadata name=\"Title\">" . $title
-		. "</Metadata>\n--><p>\n";
-	    $newsection .= $section;
-	    $newsection .= "<!--</Section>-->\n";
-	    $section = $newsection;
-	}
-
-	$text=join('', ($top_section, @sections));
-    }
-
-    # turn any high bytes that aren't valid utf-8 into utf-8.
-    unicode::ensure_utf8(\$text);
-
-    # Write it out again!
-    $self->utf8_write_file (\$text, $conv_filename);
-}
-
-
-# do plugin specific processing of doc_obj for HTML type
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-
-    my $result = $self->process_type("pdf",$base_dir,$file,$doc_obj);
-
-    # fix up the extracted date metadata to be in Greenstone date format,
-    # and fix the capitalisation of 'date'
-    my $cursection = $doc_obj->get_top_section();
-    foreach my $datemeta (@{$doc_obj->get_metadata($cursection, "date")}) {
-	$doc_obj->delete_metadata($cursection, "date", $datemeta);
-
-	# We're just interested in the date bit, not the time
-	# some pdf creators (eg "Acrobat 5.0 Scan Plug-in for Windows")
-	# set a /CreationDate, and set /ModDate to 000000000. pdftohtml
-	# extracts the ModDate, so it is 0...
-	$datemeta =~ /(\d+)-(\d+)-(\d+)/;
-	my ($year, $month, $day) = ($1,$2,$3);
-	if (defined($year) && defined($month) && defined($day)) {
-	    if ($year == 0) {next}
-	    if ($year < 100) {$year += 1900} # just to be safe
-	    if ($month =~ /^\d$/) {$month="0$month"} # single digit
-	    if ($day =~ /^\d$/) {$day="0$day"} # single digit
-	    my $date="$year$month$day";
-	    $doc_obj->add_utf8_metadata($cursection, "Date", $date);
-	}
-    }
-
-    $doc_obj->add_utf8_metadata($cursection, "NumPages", $self->{'num_pages'});
-    
-    if ($self->{'use_sections'} && $self->{'converted_to'} eq "HTML") {
-	# we explicitly make it a paged document, cos greenstone won't get it
-	# right if any section has an empty title, or one with letters in it
-	$doc_obj->set_utf8_metadata_element ($cursection, "gsdlthistype", "Paged");
-    }
-
-    return $result;
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/PDFPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/PDFPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/PDFPlugin.pm	(revision 15865)
@@ -0,0 +1,335 @@
+###########################################################################
+#
+# PDFPlug.pm -- reasonably with-it pdf plugin
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999-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.
+#
+###########################################################################
+package PDFPlug;
+
+use ConvertToPlug;
+use unicode;
+use strict;
+no strict 'refs'; # so we can use a var for filehandles (eg STDERR)
+
+sub BEGIN {
+    @PDFPlug::ISA = ('ConvertToPlug');
+}
+
+my $convert_to_list =
+    [ {	'name' => "auto",
+	'desc' => "{ConvertToPlug.convert_to.auto}" },
+      {	'name' => "html",
+	'desc' => "{ConvertToPlug.convert_to.html}" },
+      {	'name' => "text",
+	'desc' => "{ConvertToPlug.convert_to.text}" },
+      { 'name' => "pagedimg_jpg",
+	'desc' => "{ConvertToPlug.convert_to.pagedimg_jpg}"},
+      { 'name' => "pagedimg_gif",
+	'desc' => "{ConvertToPlug.convert_to.pagedimg_gif}"},
+      { 'name' => "pagedimg_png",
+	'desc' => "{ConvertToPlug.convert_to.pagedimg_png}"}, 
+      ];
+
+
+my $arguments = 
+    [
+     { 'name' => "convert_to",
+       'desc' => "{ConvertToPlug.convert_to}",
+       'type' => "enum",
+       'reqd' => "yes",
+       'list' => $convert_to_list, 
+       'deft' => "html" },	 
+     { 'name' => "process_exp",
+       'desc' => "{BasPlug.process_exp}",
+       'type' => "regexp",
+       'deft' => &get_default_process_exp(),
+       'reqd' => "no" },
+     { 'name' => "block_exp",
+       'desc' => "{BasPlug.block_exp}",
+       'type' => "regexp",
+       'deft' => &get_default_block_exp() },
+     { 'name' => "metadata_fields",
+       'desc' => "{HTMLPlug.metadata_fields}",
+       'type' => "string",
+       'deft' => "" },
+     { 'name' => "noimages",
+       'desc' => "{PDFPlug.noimages}",
+       'type' => "flag" },
+     { 'name' => "allowimagesonly",
+       'desc' => "{PDFPlug.allowimagesonly}",
+       'type' => "flag" },
+     { 'name' => "complex",
+       'desc' => "{PDFPlug.complex}",
+       'type' => "flag" },
+     { 'name' => "nohidden",
+       'desc' => "{PDFPlug.nohidden}",
+       'type' => "flag" },
+     { 'name' => "zoom",
+       'desc' => "{PDFPlug.zoom}",
+       'deft' => "2",
+       'range' => "1,3", # actually the range is 0.5-3 
+       'type' => "int" },
+     { 'name' => "use_sections",
+       'desc' => "{PDFPlug.use_sections}",
+       'type' => "flag" },
+     { 'name' => "description_tags",
+       'desc' => "{HTMLPlug.description_tags}",
+       'type' => "flag" }
+     ];
+
+my $options = { 'name'     => "PDFPlug",
+		'desc'     => "{PDFPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'srcreplaceable' => "yes", # Source docs in PDF can be replaced with GS-generated html		
+		'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    push(@$inputargs,"-title_sub");
+    push(@$inputargs,'^(Page\s+\d+)?(\s*1\s+)?');
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my @arg_array = @$inputargs;
+    my $self = new ConvertToPlug($pluginlist, $inputargs, $hashArgOptLists);
+    
+    if ($self->{'info_only'}) {
+	# don't worry about any options etc
+	return bless $self, $class;
+    }
+
+    # these are passed through to gsConvert.pl by ConvertToPlug.pm
+    my $zoom = $self->{"zoom"};
+    $self->{'convert_options'} = "-pdf_zoom $zoom";
+    $self->{'convert_options'} .= " -pdf_complex" if $self->{"complex"};
+    $self->{'convert_options'} .= " -pdf_nohidden" if $self->{"nohidden"};
+    $self->{'convert_options'} .= " -pdf_ignore_images" if $self->{"noimages"};
+    $self->{'convert_options'} .= " -pdf_allow_images_only" if $self->{"allowimagesonly"};
+
+    my $secondary_plugin_options = $self->{'secondary_plugin_options'};
+
+    if (!defined $secondary_plugin_options->{'HTMLPlug'}) {
+	$secondary_plugin_options->{'HTMLPlug'} = [];
+    }
+    if (!defined $secondary_plugin_options->{'TEXTPlug'}) {
+	$secondary_plugin_options->{'TEXTPlug'} = [];
+    }
+    if (defined $self->{'convert_to'} && $self->{'convert_to'} =~ /pagedimg.*/i) {
+	if (!defined $secondary_plugin_options->{'PagedImgPlug'}){
+	    $secondary_plugin_options->{'PagedImgPlug'} = [];
+	    my $pagedimg_options = $secondary_plugin_options->{'PagedImgPlug'}; 
+	    push(@$pagedimg_options, "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
+	}
+    }
+    my $html_options = $secondary_plugin_options->{'HTMLPlug'};
+    my $text_options = $secondary_plugin_options->{'TEXTPlug'};
+    my $pagedimg_options = $secondary_plugin_options->{'PagedImgPlug'};
+   
+    if ($self->{'input_encoding'} eq "auto") {
+	$self->{'input_encoding'} = "utf8";
+    }
+
+    # if pdftohtml is always producing utf8, then htmlplug always needs this option
+    push(@$html_options,"-input_encoding", "utf8");
+    push(@$html_options,"-extract_language") if $self->{'extract_language'};
+    # Instruct HTMLPlug (when eventually accessed through read_into_doc_obj) 
+    # to extract these metadata fields from the HEAD META fields
+    my $required_metadata;
+    if (defined $self->{'metadata_fields'} && $self->{'metadata_fields'} =~ /\S/) {
+	push(@$html_options,"-metadata_fields",$self->{'metadata_fields'});
+    } else {
+	push(@$html_options,"-metadata_fields","Title,GENERATOR,date,author<Creator>");
+    }
+    #push(@$html_options,"-metadata_fields","Title,GENERATOR,date,author<Creator>");
+        
+    if ($self->{'use_sections'} || $self->{'description_tags'}) {
+	$self->{'description_tags'} = 1;
+	push(@$html_options,"-description_tags");
+    }
+
+    # following title_sub removes "Page 1" added by pdftohtml, and a leading
+    # "1", which is often the page number at the top of the page. Bad Luck
+    # if your document title actually starts with "1 " - is there a better way?
+    push(@$html_options , "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
+    push(@$text_options , "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
+
+    my $associate_tail_re = $self->{'associate_tail_re'};
+    if ((defined $associate_tail_re) && ($associate_tail_re ne "")) {
+	push(@$html_options, "-associate_tail_re", $associate_tail_re);
+	push(@$text_options, "-associate_tail_re", $associate_tail_re);
+	push(@$pagedimg_options, "-associate_tail_re", $associate_tail_re);
+    }
+
+ 
+    $self = bless $self, $class;
+    $self->load_secondary_plugins($class,$secondary_plugin_options,$hashArgOptLists);
+    return $self;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)\.pdf$^;
+}
+
+# so we don't inherit HTMLPlug's block exp...
+sub get_default_block_exp {
+    return "";
+}
+    
+sub convert_post_process
+{
+    my $self = shift (@_);
+    my ($conv_filename) = @_;
+
+    my $outhandle=$self->{'outhandle'};
+
+    my ($language, $encoding) = $self->textcat_get_language_encoding ($conv_filename);
+
+    # read in file ($text will be in utf8)
+    my $text = "";
+    $self->read_file ($conv_filename, $encoding, $language, \$text);
+
+    # Calculate number of pages based on <a ...> tags (we have a <a name=1> etc
+    # for each page).  Metadata based on this calculation not set until process()
+    # 
+    # Note: this is done even if we are not breaking to document into pages as it might
+    # be useful to give an indication of document length in browser through setting
+    # num_pages as metadata.
+    my @pages = ($text =~ /\<[Aa] name=\"?\w+\"?>/ig);
+    my $num_pages = scalar(@pages);
+    $self->{'num_pages'} = $num_pages;
+
+    if ($self->{'use_sections'}
+	&& $self->{'converted_to'} eq "HTML") {
+
+	print $outhandle "PDFPlug: Calculating sections...\n";
+
+	# we have "<a name=1></a>" etc for each page
+	# it may be <A name=
+	my @sections = split('<[Aa] name=', $text);
+
+	my $top_section = "";
+
+	if (scalar (@sections) == 1) { #only one section - no split!
+	    print $outhandle "PDFPlug: warning - no sections found\n";
+	} else {
+	    $top_section .= shift @sections; # keep HTML header etc as top_section
+	}
+
+	# handle first section specially for title? Or all use first 100...
+	
+	my $title = $sections[0];
+	$title =~ s/^\"?\w+\"?>//; # specific for pdftohtml...
+	$title =~ s/<\/([^>]+)><\1>//g; # (eg) </b><b> - no space
+	$title =~ s/<[^>]*>/ /g;
+	$title =~ s/(?:&nbsp;|\xc2\xa0)/ /g; # utf-8 for nbsp...
+	$title =~ s/^\s+//s;
+	$title =~ s/\s+$//;
+	$title =~ s/\s+/ /gs;
+	$title =~ s/^$self->{'title_sub'}// if ($self->{'title_sub'});
+	$title =~ s/^\s+//s; # in case title_sub introduced any...
+	$title = substr ($title, 0, 100);
+	$title =~ s/\s\S*$/.../;
+
+
+	if (scalar (@sections) == 1) { # no sections found
+	    $top_section .= $sections[0];
+	    @sections=();
+	} else {
+	    $top_section .= "<!--<Section>\n<Metadata name=\"Title\">$title</Metadata>\n-->\n <!--</Section>-->\n";
+	}
+
+	# add metadata per section...
+	foreach my $section (@sections) {
+	    # section names are not always just digits, may be like "outline"
+	    $section =~ s@^\"?(\w+)\"?></a>@@; # leftover from split expression...
+
+	    $title = $1; # Greenstone does magic if sections are titled digits
+	    if (! defined($title) ) {
+		print STDERR "no title: $section\n";
+		$title = " "; # get rid of the undefined warning in next line
+	    }
+	    my $newsection = "<!-- from PDFPlug -->\n<!-- <Section>\n";
+	    $newsection .= "<Metadata name=\"Title\">" . $title
+		. "</Metadata>\n--><p>\n";
+	    $newsection .= $section;
+	    $newsection .= "<!--</Section>-->\n";
+	    $section = $newsection;
+	}
+
+	$text=join('', ($top_section, @sections));
+    }
+
+    # turn any high bytes that aren't valid utf-8 into utf-8.
+    unicode::ensure_utf8(\$text);
+
+    # Write it out again!
+    $self->utf8_write_file (\$text, $conv_filename);
+}
+
+
+# do plugin specific processing of doc_obj for HTML type
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+
+    my $result = $self->process_type("pdf",$base_dir,$file,$doc_obj);
+
+    # fix up the extracted date metadata to be in Greenstone date format,
+    # and fix the capitalisation of 'date'
+    my $cursection = $doc_obj->get_top_section();
+    foreach my $datemeta (@{$doc_obj->get_metadata($cursection, "date")}) {
+	$doc_obj->delete_metadata($cursection, "date", $datemeta);
+
+	# We're just interested in the date bit, not the time
+	# some pdf creators (eg "Acrobat 5.0 Scan Plug-in for Windows")
+	# set a /CreationDate, and set /ModDate to 000000000. pdftohtml
+	# extracts the ModDate, so it is 0...
+	$datemeta =~ /(\d+)-(\d+)-(\d+)/;
+	my ($year, $month, $day) = ($1,$2,$3);
+	if (defined($year) && defined($month) && defined($day)) {
+	    if ($year == 0) {next}
+	    if ($year < 100) {$year += 1900} # just to be safe
+	    if ($month =~ /^\d$/) {$month="0$month"} # single digit
+	    if ($day =~ /^\d$/) {$day="0$day"} # single digit
+	    my $date="$year$month$day";
+	    $doc_obj->add_utf8_metadata($cursection, "Date", $date);
+	}
+    }
+
+    $doc_obj->add_utf8_metadata($cursection, "NumPages", $self->{'num_pages'});
+    
+    if ($self->{'use_sections'} && $self->{'converted_to'} eq "HTML") {
+	# we explicitly make it a paged document, cos greenstone won't get it
+	# right if any section has an empty title, or one with letters in it
+	$doc_obj->set_utf8_metadata_element ($cursection, "gsdlthistype", "Paged");
+    }
+
+    return $result;
+}
+
+1;
Index: dl/trunk/perllib/plugins/PPTPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/PPTPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,171 +1,0 @@
-###########################################################################
-#
-# PPTPlug.pm -- plugin for importing Microsoft PowerPoint files.
-#  (currently only versions 95 and 97)
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 2002 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 PPTPlug;
-
-use ConvertToPlug;
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @PPTPlug::ISA = ('ConvertToPlug');
-}
-
-my $convert_to_list =
-    [ {	'name' => "auto",
-	'desc' => "{ConvertToPlug.convert_to.auto}" },
-      {	'name' => "html",
-	'desc' => "{ConvertToPlug.convert_to.html}" },
-      {	'name' => "text",
-	'desc' => "{ConvertToPlug.convert_to.text}" },
-      { 'name' => "pagedimg_jpg",
-	'desc' => "{ConvertToPlug.convert_to.pagedimg_jpg}" },
-      { 'name' => "pagedimg_gif",
-	'desc' => "{ConvertToPlug.convert_to.pagedimg_gif}" },
-      { 'name' => "pagedimg_png",
-	'desc' => "{ConvertToPlug.convert_to.pagedimg_png}" }
-      ];
-
-my $arguments = 
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_process_exp()}
-      ];
-
-my $options = { 'name'     => "PPTPlug",
-		'desc'     => "{PPTPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'srcreplaceable' => "yes", # Source docs in PPT format can be replaced with GS-generated html
-	        'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
-	my $ws_arg =[{ 'name' => "convert_to",
-		       'desc' => "{ConvertToPlug.convert_to}",
-		       'type' => "enum",
-		       'reqd' => "yes",
-		       'list' => $convert_to_list, 
-		       'deft' => "html" },
-		     { 'name' => "windows_scripting",
-		       'desc' => "{PPTPlug.windows_scripting}",
-		       'type' => "flag",
-		       'reqd' => "no" }
-		     ];
-	push(@$arguments,@$ws_arg);
-    }
-    
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-
-    my @arg_array = @$inputargs;
-    my $self = new ConvertToPlug($pluginlist, $inputargs, $hashArgOptLists);
- 
-    if ($self->{'info_only'}) {
-	# don't worry about any options etc
-	return bless $self, $class;
-    }
-
-    # ppthtml outputs utf-8 already.
-    #these are passed through to gsConvert.pl by ConvertToPlug.pm
-    $self->{'convert_options'} = "-windows_scripting" if $self->{'windows_scripting'};
-    my $secondary_plugin_options = $self->{'secondary_plugin_options'};
-
-    if ($self->{'windows_scripting'} && ($self->{'convert_to'} eq "PagedImg")) {
-	$secondary_plugin_options->{'PagedImgPlug'} = [];
-    } else {
-	$secondary_plugin_options->{'HTMLPlug'} = [];
-    }
-    my $html_options = $secondary_plugin_options->{'HTMLPlug'};
-    my $pageimg_options = $secondary_plugin_options->{'PagedImgPlug'};
-
-    if ($self->{'input_encoding'} eq "auto") {
-	$self->{'input_encoding'} = "utf8";
-	if (defined $secondary_plugin_options->{'HTMLPlug'}){
-	    push(@$html_options,"-input_encoding", "utf8");
-	    push(@$html_options,"-extract_language") if $self->{'extract_language'};
-
-	    # Instruct HTMLPlug (when eventually accessed through read_into_doc_obj) 
-	    # to extract these metadata fields from the HEAD META fields
-	    push(@$html_options,"-metadata_fields","Title,GENERATOR,date,author<Creator>");
-	} 
-	if (defined $secondary_plugin_options->{'PagedImgPlug'}){
-	    push(@$pageimg_options,"-input_encoding", "utf8");
-	    push(@$pageimg_options,"-extract_language") if $self->{'extract_language'};
-	}
-    }
-
-    $self = bless $self, $class;
-
-    $self->load_secondary_plugins($class,$secondary_plugin_options,$hashArgOptLists);
-    return $self;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-    return q^(?i)\.ppt$^;
-}
-
-sub get_file_type {
-    my $self = shift (@_);
-    my $file_type = "PPT";
-    return $file_type;
-}
-
-sub convert_post_process
-{
-    my $self = shift (@_);
-    my ($conv_filename) = @_;
-
-    my $outhandle=$self->{'outhandle'};
-    my ($language, $encoding) = $self->textcat_get_language_encoding ($conv_filename);
-    # read in file ($text will be in utf8)
-    my $text = "";
-    $self->read_file ($conv_filename, $encoding, $language, \$text);
- 
-    # turn any high bytes that aren't valid utf-8 into utf-8.
-    unicode::ensure_utf8(\$text);
-    # Write it out again!
-    $self->utf8_write_file (\$text, $conv_filename);
-}
-
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-
-    return $self->process_type("ppt",$base_dir,$file,$doc_obj);
-}
-
-1;
-
Index: /gsdl/trunk/perllib/plugins/PPTPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/PPTPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/PPTPlugin.pm	(revision 15865)
@@ -0,0 +1,171 @@
+###########################################################################
+#
+# PPTPlug.pm -- plugin for importing Microsoft PowerPoint files.
+#  (currently only versions 95 and 97)
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 2002 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 PPTPlug;
+
+use ConvertToPlug;
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @PPTPlug::ISA = ('ConvertToPlug');
+}
+
+my $convert_to_list =
+    [ {	'name' => "auto",
+	'desc' => "{ConvertToPlug.convert_to.auto}" },
+      {	'name' => "html",
+	'desc' => "{ConvertToPlug.convert_to.html}" },
+      {	'name' => "text",
+	'desc' => "{ConvertToPlug.convert_to.text}" },
+      { 'name' => "pagedimg_jpg",
+	'desc' => "{ConvertToPlug.convert_to.pagedimg_jpg}" },
+      { 'name' => "pagedimg_gif",
+	'desc' => "{ConvertToPlug.convert_to.pagedimg_gif}" },
+      { 'name' => "pagedimg_png",
+	'desc' => "{ConvertToPlug.convert_to.pagedimg_png}" }
+      ];
+
+my $arguments = 
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_process_exp()}
+      ];
+
+my $options = { 'name'     => "PPTPlug",
+		'desc'     => "{PPTPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'srcreplaceable' => "yes", # Source docs in PPT format can be replaced with GS-generated html
+	        'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
+	my $ws_arg =[{ 'name' => "convert_to",
+		       'desc' => "{ConvertToPlug.convert_to}",
+		       'type' => "enum",
+		       'reqd' => "yes",
+		       'list' => $convert_to_list, 
+		       'deft' => "html" },
+		     { 'name' => "windows_scripting",
+		       'desc' => "{PPTPlug.windows_scripting}",
+		       'type' => "flag",
+		       'reqd' => "no" }
+		     ];
+	push(@$arguments,@$ws_arg);
+    }
+    
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+
+    my @arg_array = @$inputargs;
+    my $self = new ConvertToPlug($pluginlist, $inputargs, $hashArgOptLists);
+ 
+    if ($self->{'info_only'}) {
+	# don't worry about any options etc
+	return bless $self, $class;
+    }
+
+    # ppthtml outputs utf-8 already.
+    #these are passed through to gsConvert.pl by ConvertToPlug.pm
+    $self->{'convert_options'} = "-windows_scripting" if $self->{'windows_scripting'};
+    my $secondary_plugin_options = $self->{'secondary_plugin_options'};
+
+    if ($self->{'windows_scripting'} && ($self->{'convert_to'} eq "PagedImg")) {
+	$secondary_plugin_options->{'PagedImgPlug'} = [];
+    } else {
+	$secondary_plugin_options->{'HTMLPlug'} = [];
+    }
+    my $html_options = $secondary_plugin_options->{'HTMLPlug'};
+    my $pageimg_options = $secondary_plugin_options->{'PagedImgPlug'};
+
+    if ($self->{'input_encoding'} eq "auto") {
+	$self->{'input_encoding'} = "utf8";
+	if (defined $secondary_plugin_options->{'HTMLPlug'}){
+	    push(@$html_options,"-input_encoding", "utf8");
+	    push(@$html_options,"-extract_language") if $self->{'extract_language'};
+
+	    # Instruct HTMLPlug (when eventually accessed through read_into_doc_obj) 
+	    # to extract these metadata fields from the HEAD META fields
+	    push(@$html_options,"-metadata_fields","Title,GENERATOR,date,author<Creator>");
+	} 
+	if (defined $secondary_plugin_options->{'PagedImgPlug'}){
+	    push(@$pageimg_options,"-input_encoding", "utf8");
+	    push(@$pageimg_options,"-extract_language") if $self->{'extract_language'};
+	}
+    }
+
+    $self = bless $self, $class;
+
+    $self->load_secondary_plugins($class,$secondary_plugin_options,$hashArgOptLists);
+    return $self;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+    return q^(?i)\.ppt$^;
+}
+
+sub get_file_type {
+    my $self = shift (@_);
+    my $file_type = "PPT";
+    return $file_type;
+}
+
+sub convert_post_process
+{
+    my $self = shift (@_);
+    my ($conv_filename) = @_;
+
+    my $outhandle=$self->{'outhandle'};
+    my ($language, $encoding) = $self->textcat_get_language_encoding ($conv_filename);
+    # read in file ($text will be in utf8)
+    my $text = "";
+    $self->read_file ($conv_filename, $encoding, $language, \$text);
+ 
+    # turn any high bytes that aren't valid utf-8 into utf-8.
+    unicode::ensure_utf8(\$text);
+    # Write it out again!
+    $self->utf8_write_file (\$text, $conv_filename);
+}
+
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+
+    return $self->process_type("ppt",$base_dir,$file,$doc_obj);
+}
+
+1;
+
Index: dl/trunk/perllib/plugins/PSPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/PSPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,258 +1,0 @@
-###########################################################################
-#
-# PSPlug.pm -- this might look VERY similar to the PDF plugin...
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999 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.
-#
-###########################################################################
-
-# 12/05/02 Added usage datastructure - John Thompson
-
-package PSPlug;
-
-use ConvertToPlug;
-use sorttools;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @PSPlug::ISA = ('ConvertToPlug');
-}
-
-my $convert_to_list =
-    [ {	'name' => "auto",
-	'desc' => "{ConvertToPlug.convert_to.auto}" },
-      {	'name' => "text",
-	'desc' => "{ConvertToPlug.convert_to.text}" },
-      { 'name' => "pagedimg_jpg",
-	'desc' => "{ConvertToPlug.convert_to.pagedimg_jpg}" },
-      { 'name' => "pagedimg_gif",
-	'desc' => "{ConvertToPlug.convert_to.pagedimg_gif}" },
-      { 'name' => "pagedimg_png",
-	'desc' => "{ConvertToPlug.convert_to.pagedimg_png}" }
-      ];
-
-my $arguments =
-    [ { 'name' => "convert_to",
-	'desc' => "{ConvertToPlug.convert_to}",
-	'type' => "enum",
-	'reqd' => "yes",
-	'list' => $convert_to_list, 
-	'deft' => "text" },
-      { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" },
-      { 'name' => "block_exp",
-	'desc' => "{BasPlug.block_exp}",
-	'type' => 'regexp',
-	'deft' => &get_default_block_exp() },
-      { 'name' => "extract_date",
-	'desc' => "{PSPlug.extract_date}",
-	'type' => "flag" },
-      { 'name' => "extract_pages",
-	'desc' => "{PSPlug.extract_pages}",
-	'type' => "flag" },
-      { 'name' => "extract_title",
-	'desc' => "{PSPlug.extract_title}",
-	'type' => "flag" } ];
-
-my $options = { 'name'     => "PSPlug",
-		'desc'     => "{PSPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'srcreplaceable' => "yes", # Source docs in postscript format can be replaced with GS-generated html
-		'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    #push(@$inputargs,"-convert_to");
-    #push(@$inputargs,"text");
-    push(@$inputargs,"-title_sub");
-    push(@$inputargs,'^(Page\s+\d+)?(\s*1\s+)?');
-    
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-    
-    my $self = new ConvertToPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    if ($self->{'info_only'}) {
-	# don't worry about any options etc
-	return bless $self, $class;
-    }
-
-    my $secondary_plugin_options = $self->{'secondary_plugin_options'};
-
-    if (!defined $secondary_plugin_options->{'TEXTPlug'}) {
-	$secondary_plugin_options->{'TEXTPlug'} = [];
-    }
-
-    my $text_options = $secondary_plugin_options->{'TEXTPlug'};
-
-    if (defined $self->{'convert_to'} && $self->{'convert_to'} =~ /pagedimg.*/i) {
-	if (!defined $secondary_plugin_options->{'PagedImgPlug'}){
-	    $secondary_plugin_options->{'PagedImgPlug'} = [];
-	    my $pagedimg_options = $secondary_plugin_options->{'PagedImgPlug'}; 
-	    push(@$pagedimg_options, "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
-	}
-    }
-    # following title_sub removes "Page 1" added by ps2ascii, and a leading
-    # "1", which is often the page number at the top of the page. Bad Luck
-    # if your document title actually starts with "1 " - is there a better way?
-    #$self->{'input_encoding'} = "utf8";
-    #$self->{'extract_language'} = 1;
-    push(@$text_options, "-input_encoding", "utf8");
-    push(@$text_options,"-extract_language") if $self->{'extract_language'};
-    push(@$text_options , "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
-
-    $self = bless $self, $class;
-
-    $self->load_secondary_plugins($class,$secondary_plugin_options, $hashArgOptLists);
-
-    return $self;
-}
-
-
-sub get_default_block_exp {
-    my $self = shift (@_);
-
-    return q^(?i)\.(eps)$^;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)\.ps$^;
-}
-
-sub convert_post_process
-{
-    my $self = shift (@_);
-    my ($conv_filename) = @_;
-    
-    my $outhandle=$self->{'outhandle'};
-    
-    my ($language, $encoding) = $self->textcat_get_language_encoding ($conv_filename);
-    
-    # read in file ($text will be in utf8)
-    my $text = "";
-    $self->read_file ($conv_filename, $encoding, $language, \$text);
-    
-    # turn any high bytes that aren't valid utf-8 into utf-8.
-    unicode::ensure_utf8(\$text);
-    
-    # Write it out again!
-    $self->utf8_write_file (\$text, $conv_filename);
-}
-
-sub extract_metadata_from_postscript {
-    my $self = shift (@_);
-
-    my ($filename,$doc) = @_;
-
-    my $section = $doc->get_top_section();
-
-    my $title_found = 0;
-    my $pages_found = 0;
-    my $date_found = 0;
-
-    print STDERR "PSPlug: extracting PostScript metadata from \"$filename\"\n" 
-	if $self->{'verbosity'} > 1;
-
-    open(INPUT, "<$filename");
-    my $date;
-
-    while(my $line =<INPUT>) {
-	if ($self->{'extract_title'} && !$title_found) {
-	    foreach my $word ($line =~ m|Title: ([-A-Za-z0-9@/\/\(\):,. ]*)|g) {
-		my $new_word = $word; 
-		$new_word =~ s/\(Untitled\)//i;
-		$new_word =~ s/\(Microsoft Word\)//i;
-		$new_word =~ s/Microsoft Word//i;
-		$new_word =~ s/^\(//i;
-		$new_word =~ s/\)$//i;
-		$new_word =~ s/^ - //i;
-		if ($new_word ne "") {
-		    $doc->add_utf8_metadata($section, "Title", $new_word );
-		    $title_found = 1;
-		}
-	    }
-	}
-	if ($self->{'extract_date'} && !$date_found) {
-            foreach my $word ($line =~ m/(Creation[-A-Za-z0-9@\/\(\):,. ]*)/g) {
-                if ($word =~ m/ ([A-Za-z][A-Za-z][A-Za-z]) ([0-9 ][0-9])  ?[0-9: ]+ ([0-9]{4})/) {
-                    $date = &sorttools::format_date($2,$1,$3);
-		    if (defined $date) {
-			$doc->add_utf8_metadata($section, "Date", $date );
-		    }
-                }
-                if ($word =~ m/D:([0-9]{4})([0-9]{2})([0-9]{2})[0-9]{6}\)/) {
-                    $date = &sorttools::format_date($3,$2,$1);
-		    if (defined $date) {
-			$doc->add_utf8_metadata($section, "Date", $date );
-		    }
-                }
-                if ($word =~ m/CreationDate: ([0-9]{4}) ([A-Za-z][A-Za-z][A-Za-z]) ([0-9 ][0-9]) [0-9:]*/) {
-                    $date = &sorttools::format_date($3,$2,$1);
-		    if (defined $date) {
-			$doc->add_utf8_metadata($section, "Date", $date );
-		    }
-                }
-		$date_found = 1;
-            }
-	}
-	if ($self->{'extract_pages'} && !$pages_found) {
-	    foreach my $word ($line =~ m/(Pages: [0-9]*)/g) {
-                my $digits = $word;
-                $digits =~ s/[^0-9]//g;
-		if ($digits ne "" && $digits ne "0") {
-		    $doc->add_utf8_metadata($section, "Pages", $digits );
-		    $pages_found = 1;
-		}
-            }
-	}
-    }
-}
-
-# do plugin specific processing of doc_obj for HTML type
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-
-#    my $outhandle = $self->{'outhandle'};
-
-#    print $outhandle "PSPlug: passing $file on to $self->{'converted_to'}Plug\n" 
-#	if $self->{'verbosity'} > 1;
-#    print STDERR "<Processing n='$file' p='PSPlug'>\n" if ($gli);
-
-    my $filename = &util::filename_cat($base_dir,$file);
-    $self->extract_metadata_from_postscript($filename, $doc_obj);
-
-    return $self->process_type("ps",$base_dir,$file,$doc_obj);
-}
-
-
-1;
-
Index: /gsdl/trunk/perllib/plugins/PSPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/PSPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/PSPlugin.pm	(revision 15865)
@@ -0,0 +1,258 @@
+###########################################################################
+#
+# PSPlug.pm -- this might look VERY similar to the PDF plugin...
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999 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.
+#
+###########################################################################
+
+# 12/05/02 Added usage datastructure - John Thompson
+
+package PSPlug;
+
+use ConvertToPlug;
+use sorttools;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @PSPlug::ISA = ('ConvertToPlug');
+}
+
+my $convert_to_list =
+    [ {	'name' => "auto",
+	'desc' => "{ConvertToPlug.convert_to.auto}" },
+      {	'name' => "text",
+	'desc' => "{ConvertToPlug.convert_to.text}" },
+      { 'name' => "pagedimg_jpg",
+	'desc' => "{ConvertToPlug.convert_to.pagedimg_jpg}" },
+      { 'name' => "pagedimg_gif",
+	'desc' => "{ConvertToPlug.convert_to.pagedimg_gif}" },
+      { 'name' => "pagedimg_png",
+	'desc' => "{ConvertToPlug.convert_to.pagedimg_png}" }
+      ];
+
+my $arguments =
+    [ { 'name' => "convert_to",
+	'desc' => "{ConvertToPlug.convert_to}",
+	'type' => "enum",
+	'reqd' => "yes",
+	'list' => $convert_to_list, 
+	'deft' => "text" },
+      { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" },
+      { 'name' => "block_exp",
+	'desc' => "{BasPlug.block_exp}",
+	'type' => 'regexp',
+	'deft' => &get_default_block_exp() },
+      { 'name' => "extract_date",
+	'desc' => "{PSPlug.extract_date}",
+	'type' => "flag" },
+      { 'name' => "extract_pages",
+	'desc' => "{PSPlug.extract_pages}",
+	'type' => "flag" },
+      { 'name' => "extract_title",
+	'desc' => "{PSPlug.extract_title}",
+	'type' => "flag" } ];
+
+my $options = { 'name'     => "PSPlug",
+		'desc'     => "{PSPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'srcreplaceable' => "yes", # Source docs in postscript format can be replaced with GS-generated html
+		'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    #push(@$inputargs,"-convert_to");
+    #push(@$inputargs,"text");
+    push(@$inputargs,"-title_sub");
+    push(@$inputargs,'^(Page\s+\d+)?(\s*1\s+)?');
+    
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+    
+    my $self = new ConvertToPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    if ($self->{'info_only'}) {
+	# don't worry about any options etc
+	return bless $self, $class;
+    }
+
+    my $secondary_plugin_options = $self->{'secondary_plugin_options'};
+
+    if (!defined $secondary_plugin_options->{'TEXTPlug'}) {
+	$secondary_plugin_options->{'TEXTPlug'} = [];
+    }
+
+    my $text_options = $secondary_plugin_options->{'TEXTPlug'};
+
+    if (defined $self->{'convert_to'} && $self->{'convert_to'} =~ /pagedimg.*/i) {
+	if (!defined $secondary_plugin_options->{'PagedImgPlug'}){
+	    $secondary_plugin_options->{'PagedImgPlug'} = [];
+	    my $pagedimg_options = $secondary_plugin_options->{'PagedImgPlug'}; 
+	    push(@$pagedimg_options, "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
+	}
+    }
+    # following title_sub removes "Page 1" added by ps2ascii, and a leading
+    # "1", which is often the page number at the top of the page. Bad Luck
+    # if your document title actually starts with "1 " - is there a better way?
+    #$self->{'input_encoding'} = "utf8";
+    #$self->{'extract_language'} = 1;
+    push(@$text_options, "-input_encoding", "utf8");
+    push(@$text_options,"-extract_language") if $self->{'extract_language'};
+    push(@$text_options , "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
+
+    $self = bless $self, $class;
+
+    $self->load_secondary_plugins($class,$secondary_plugin_options, $hashArgOptLists);
+
+    return $self;
+}
+
+
+sub get_default_block_exp {
+    my $self = shift (@_);
+
+    return q^(?i)\.(eps)$^;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)\.ps$^;
+}
+
+sub convert_post_process
+{
+    my $self = shift (@_);
+    my ($conv_filename) = @_;
+    
+    my $outhandle=$self->{'outhandle'};
+    
+    my ($language, $encoding) = $self->textcat_get_language_encoding ($conv_filename);
+    
+    # read in file ($text will be in utf8)
+    my $text = "";
+    $self->read_file ($conv_filename, $encoding, $language, \$text);
+    
+    # turn any high bytes that aren't valid utf-8 into utf-8.
+    unicode::ensure_utf8(\$text);
+    
+    # Write it out again!
+    $self->utf8_write_file (\$text, $conv_filename);
+}
+
+sub extract_metadata_from_postscript {
+    my $self = shift (@_);
+
+    my ($filename,$doc) = @_;
+
+    my $section = $doc->get_top_section();
+
+    my $title_found = 0;
+    my $pages_found = 0;
+    my $date_found = 0;
+
+    print STDERR "PSPlug: extracting PostScript metadata from \"$filename\"\n" 
+	if $self->{'verbosity'} > 1;
+
+    open(INPUT, "<$filename");
+    my $date;
+
+    while(my $line =<INPUT>) {
+	if ($self->{'extract_title'} && !$title_found) {
+	    foreach my $word ($line =~ m|Title: ([-A-Za-z0-9@/\/\(\):,. ]*)|g) {
+		my $new_word = $word; 
+		$new_word =~ s/\(Untitled\)//i;
+		$new_word =~ s/\(Microsoft Word\)//i;
+		$new_word =~ s/Microsoft Word//i;
+		$new_word =~ s/^\(//i;
+		$new_word =~ s/\)$//i;
+		$new_word =~ s/^ - //i;
+		if ($new_word ne "") {
+		    $doc->add_utf8_metadata($section, "Title", $new_word );
+		    $title_found = 1;
+		}
+	    }
+	}
+	if ($self->{'extract_date'} && !$date_found) {
+            foreach my $word ($line =~ m/(Creation[-A-Za-z0-9@\/\(\):,. ]*)/g) {
+                if ($word =~ m/ ([A-Za-z][A-Za-z][A-Za-z]) ([0-9 ][0-9])  ?[0-9: ]+ ([0-9]{4})/) {
+                    $date = &sorttools::format_date($2,$1,$3);
+		    if (defined $date) {
+			$doc->add_utf8_metadata($section, "Date", $date );
+		    }
+                }
+                if ($word =~ m/D:([0-9]{4})([0-9]{2})([0-9]{2})[0-9]{6}\)/) {
+                    $date = &sorttools::format_date($3,$2,$1);
+		    if (defined $date) {
+			$doc->add_utf8_metadata($section, "Date", $date );
+		    }
+                }
+                if ($word =~ m/CreationDate: ([0-9]{4}) ([A-Za-z][A-Za-z][A-Za-z]) ([0-9 ][0-9]) [0-9:]*/) {
+                    $date = &sorttools::format_date($3,$2,$1);
+		    if (defined $date) {
+			$doc->add_utf8_metadata($section, "Date", $date );
+		    }
+                }
+		$date_found = 1;
+            }
+	}
+	if ($self->{'extract_pages'} && !$pages_found) {
+	    foreach my $word ($line =~ m/(Pages: [0-9]*)/g) {
+                my $digits = $word;
+                $digits =~ s/[^0-9]//g;
+		if ($digits ne "" && $digits ne "0") {
+		    $doc->add_utf8_metadata($section, "Pages", $digits );
+		    $pages_found = 1;
+		}
+            }
+	}
+    }
+}
+
+# do plugin specific processing of doc_obj for HTML type
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+
+#    my $outhandle = $self->{'outhandle'};
+
+#    print $outhandle "PSPlug: passing $file on to $self->{'converted_to'}Plug\n" 
+#	if $self->{'verbosity'} > 1;
+#    print STDERR "<Processing n='$file' p='PSPlug'>\n" if ($gli);
+
+    my $filename = &util::filename_cat($base_dir,$file);
+    $self->extract_metadata_from_postscript($filename, $doc_obj);
+
+    return $self->process_type("ps",$base_dir,$file,$doc_obj);
+}
+
+
+1;
+
Index: /gsdl/trunk/perllib/plugins/PagedImagePlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/PagedImagePlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/PagedImagePlugin.pm	(revision 15865)
@@ -0,0 +1,971 @@
+###########################################################################
+#
+# PagedImgPlug.pm -- plugin for sets of images and OCR text that
+#  make up a document
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999 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.
+#
+###########################################################################
+
+# PagedImgPlug
+# processes sequences of images, with optional OCR text
+#
+# This plugin takes *.item files, which contain metadata and lists of image 
+# files, and produces a document containing sections, one for each page.
+# The files should be named something.item, then you can have more than one 
+# book in a directory. You will need to create these files, one for each
+# document/book.
+#
+#There are two formats for the item files: a plain text format, and an xml 
+#format. You can use either format, and can have both formats in the same 
+#collection if you like. If you use the plain format, you must not start the 
+#file off with <PagedDocument>
+
+#### PLAIN FORMAT
+# The format of the xxx.item file is as follows:
+# The first lines contain any metadata for the whole document
+# <metadata-name>metadata-value
+# eg.
+# <Title>Snail farming
+# <Date>19230102
+# Then comes a list of pages, one page per line, each line has the format
+#
+# pagenum:imagefile:textfile:r
+#
+# page num and imagefile are required. pagenum is used for the Title 
+# of the section, and in the display is shown as page <pagenum>. 
+# imagefile is the image for the page. textfile is an optional text 
+# file containing the OCR (or any) text for the page - this gets added 
+# as the text for the section. r is optional, and signals that the image 
+# should be rotated 180deg. Eg use this if the image has been made upside down.
+# So an example item file looks like:
+# <Title>Snail farming
+# <Date>19960403
+# 1:p1.gif:p1.txt:
+# 2:p2.gif::
+# 3:p3.gif:p3.txt:
+# 3b:p3b.gif:p3b.txt:r
+# The second page has no text, the fourth page is a back page, and 
+# should be rotated.
+# 
+
+#### XML FORMAT
+# The xml format looks like the following
+#<PagedDocument>
+#<Metadata name="Title">The Title of the entire document</Metadata>
+#<Page pagenum="1" imgfile="xxx.jpg" txtfile="yyy.txt">
+#<Metadata name="Title">The Title of this page</Metadata>
+#</Page>
+#... more pages
+#</PagedDocument>
+#PagedDocument contains a list of Pages, Metadata and PageGroups. Any metadata 
+#that is not inside another tag will belong to the document.
+#Each Page has a pagenum (not used at the moment), an imgfile and/or a txtfile.
+#These are both optional - if neither is used, the section will have no content.
+#Pages can also have metadata associated with them.
+#PageGroups can be introduced at any point - they can contain Metadata and Pages and other PageGroups. They are used to introduce hierarchical structure into the document.
+#For example
+#<PagedDocument>
+#<PageGroup>
+#<Page>
+#<Page>
+#</PageGroup>
+#<Page>
+#</PagedDocument>
+#would generate a structure like
+#X
+#--X
+#  --X
+#  --X
+#--X
+#PageGroup tags can also have imgfile/textfile metadata if you like - this way they get some content themselves.
+
+#Currently the XML structure doesn't work very well with the paged document type, unless you use numerical Titles for each section.
+#There is still a bit of work to do on this format:
+#* enable other text file types, eg html, pdf etc
+#* make the document paging work properly
+#* add pagenum as Title unless a Title is present?
+
+# All the supplemetary image amd text files should be in the same folder as 
+# the .item file.
+#
+# To display the images instead of the document text, you can use [srcicon] 
+# in the DocumentText format statement.
+# For example, 
+#
+# format DocumentText "<center><table width=_pagewidth_><tr><td>[srcicon]</td></tr></table></center>"
+#
+# To have it create thumbnail size images, use the '-thumbnail' option.
+# To have it create medium size images for display, use the '-screenview'
+# option. As usual, running 
+# 'perl -S pluginfo.pl PagedImgPlug' will list all the options.
+
+# If you want the resulting documents to be presented with a table of 
+# contents, use '-documenttype hierarchy', otherwise they will have 
+# next and previous arrows, and a goto page X box. 
+
+# If you have used -screenview, you can also use [screenicon] in the format
+# statement to display the smaller image.  Here is an example  that switches 
+# between the two: 
+#
+# format DocumentText "<center><table width=_pagewidth_><tr><td>{If}{_cgiargp_ eq full,<a href='_httpdocument_&d=_cgiargd_&p=small'>Switch to small version.</a>,<a href='_httpdocument_&d=_cgiargd_&p=full'>Switch to fullsize version</a>}</td></tr><tr><td>{If}{_cgiargp_ eq full,<a href='_httpdocument_&d=_cgiargd_&p=small' title='Switch to small version'>[srcicon]</a>,<a href='_httpdocument_&d=_cgiargd_&p=full' title='Switch to fullsize version'>[screenicon]</a>}</td></tr></table></center>"
+#
+# Additional metadata can be added into the .item files, alternatively you can 
+# use normal metadata.xml files, with the name of the xxx.item file as the 
+# FileName (only for document level metadata).
+
+package PagedImgPlug;
+
+use XMLPlug;
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @PagedImgPlug::ISA = ('XMLPlug');
+}
+
+my $type_list =
+    [ { 'name' => "paged",
+        'desc' => "{PagedImgPlug.documenttype.paged}" },
+      { 'name' => "hierarchy",
+        'desc' => "{PagedImgPlug.documenttype.hierarchy}" } ];
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "string",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" },
+      { 'name' => "block_exp",
+	'desc' => "{BasPlug.block_exp}",
+	'type' => "string",
+	'deft' => &get_default_block_exp(),
+	'reqd' => "no" },
+      { 'name' => "title_sub",
+	'desc' => "{HTMLPlug.title_sub}",
+	'type' => "string", 
+	'deft' => "" },
+      { 'name' => "noscaleup",
+	'desc' => "{ImagePlug.noscaleup}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "thumbnail",
+	'desc' => "{PagedImgPlug.thumbnail}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "thumbnailsize",
+	'desc' => "{ImagePlug.thumbnailsize}",
+	'type' => "int",
+	'deft' => "100",
+	'range' => "1,",
+	'reqd' => "no" },
+      { 'name' => "thumbnailtype",
+	'desc' => "{ImagePlug.thumbnailtype}",
+	'type' => "string",
+	'deft' => "gif",
+	'reqd' => "no" },
+      { 'name' => "screenview",
+	'desc' => "{PagedImgPlug.screenview}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "screenviewsize",
+	'desc' => "{PagedImgPlug.screenviewsize}",
+	'type' => "int",
+        'deft' => "500",
+        'range' => "1,",
+	'reqd' => "no" },
+      { 'name' => "screenviewtype",
+	'desc' => "{PagedImgPlug.screenviewtype}",
+	'type' => "string",
+	'deft' => "jpg",
+	'reqd' => "no" },
+      { 'name' => "converttotype",
+	'desc' => "{ImagePlug.converttotype}",
+	'type' => "string",
+	'deft' => "",
+	'reqd' => "no" },
+      { 'name' => "minimumsize",
+	'desc' => "{ImagePlug.minimumsize}",
+	'type' => "int",
+	'deft' => "100",
+	'range' => "1,",
+	'reqd' => "no" },
+      { 'name' => "headerpage",
+	'desc' => "{PagedImgPlug.headerpage}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "documenttype",
+	'desc' => "{PagedImgPlug.documenttype}",
+	'type' => "enum",
+	'list' => $type_list,
+	'deft' => "paged",
+	'reqd' => "no" } ];
+
+
+my $options = { 'name'     => "PagedImgPlug",
+		'desc'     => "{PagedImgPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+    
+    my $self = new XMLPlug($pluginlist, $inputargs, $hashArgOptLists);
+    
+    return bless $self, $class;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^\.item$^;
+}
+
+sub get_doctype {
+    my $self = shift(@_);
+    
+    return "PagedDocument";
+}
+
+
+# want to block everything except the .item ones 
+# but instead we will block images and txt files
+sub get_default_block_exp {
+    my $self = shift (@_);
+    
+    return q^(?i)(\.jpe?g|\.gif|\.png|\.tif?f|\.te?xt|\.html?|~)$^
+}
+
+# Create the thumbnail and screenview images, and discover the Image's
+# size, width, and height using the convert utility.
+sub process_image {
+    my $self = shift (@_);
+    my $filename = shift (@_); # filename with full path
+    my $srcfile = shift (@_); # filename without path
+    my $doc_obj = shift (@_);
+    my $section = shift (@_); #the current section
+    my $rotate = shift (@_); # whether to rotate the image or not
+    $rotate = 0 unless defined $rotate;
+    
+    # check that the image file exists!!
+    if (!-f $filename) {
+	print "PagedImgPlug: ERROR: File $filename does not exist, skipping\n";
+	return 0;
+    }
+
+    my $top=0;
+    if ($section eq $doc_obj->get_top_section()) {
+	$top=1;
+    }
+    my $verbosity = $self->{'verbosity'};
+    my $outhandle = $self->{'outhandle'};
+
+    # check the filename is okay
+    return 0 if ($srcfile eq "" || $filename eq "");
+    
+    my $minimumsize = $self->{'minimumsize'};
+    if (defined $minimumsize && (-s $filename < $minimumsize)) {
+        print $outhandle "PagedImgPlug: \"$filename\" too small, skipping\n"
+	    if ($verbosity > 1);
+    }
+
+    # Convert the image to a new type (if required), and rotate if required.
+    my $converttotype = $self->{'converttotype'};
+    my $originalfilename = "";  # only set if we do a conversion
+    my $type = "unknown";
+    my $converted = 0;
+    my $rotated=0;
+
+    if ($converttotype ne "" && $filename !~ /$converttotype$/) {
+	$converted=1;
+	$originalfilename = $filename;
+	my $filehead = &util::get_tmp_filename();
+	$filename = $filehead . ".$converttotype";
+	my $n = 1;
+	while (-e $filename) {
+	    $filename = "$filehead$n\.$converttotype";
+	    $n++;
+	}
+	$self->{'tmp_filename1'} = $filename;
+
+	my $rotate_option = "";
+	if ($rotate eq "r") {
+	    $rotate_option = "-rotate 180 ";
+	}
+	
+	my $command = "convert -verbose \"$originalfilename\" $rotate_option \"$filename\"";
+	print $outhandle "CONVERT: $command\n" if ($verbosity > 2);
+	my $result = '';
+	$result = `$command`;
+	print $outhandle "CONVERT RESULT = $result\n" if ($verbosity > 2);
+
+	$type = $converttotype;
+    } elsif ($rotate eq "r") {
+	$rotated=1;
+	$originalfilename = $filename;
+	$filename  = &util::get_tmp_filename();
+	
+	my $command = "convert \"$originalfilename\" -rotate 180 \"$filename\"";
+	print $outhandle "ROTATE: $command\n" if ($verbosity > 2);
+	my $result = '';
+	$result = `$command`;
+	print $outhandle "ROTATE RESULT = $result\n" if ($verbosity > 2);
+	
+    } 
+    
+
+    # Add the image metadata
+    my $file; # the new file name
+    my $id = $srcfile;
+    $id =~ s/\.([^\.]*)$//;  # the new file name without an extension
+    if ($converted) {
+	# we have converted the image
+	# add on the new extension
+	$file .= "$id.$converttotype";
+    } else {
+	$file = $srcfile;
+    }
+    
+    my $url =$file; # the new file name prepared for a url
+    my $srcurl = $srcfile;
+    ##$url =~ s/ /%20/g;
+    ##$srcurl =~ s/ /%20/g;
+    
+    $doc_obj->add_metadata ($section, "Image", $url);
+
+    # Also want to set filename as 'Source' metadata to be
+    # consistent with other plugins
+    $doc_obj->add_metadata ($section, "Source", $srcurl);
+
+    my ($image_type, $image_width, $image_height, $image_size) 
+	= &identify($filename, $outhandle, $verbosity);
+
+    $doc_obj->add_metadata ($section, "ImageType",   $image_type);
+    $doc_obj->add_metadata ($section, "ImageWidth",  $image_width);
+    $doc_obj->add_metadata ($section, "ImageHeight", $image_height);
+    $doc_obj->add_metadata ($section, "ImageSize",   $image_size);
+    $doc_obj->add_metadata ($section, "FileFormat", "PagedImg");
+    # add NoText metadata which can be used to suppress the dummy text
+    $doc_obj->add_metadata ($section, "NoText", "1");
+
+    if ($type eq "unknown" && $image_type) {
+	$type = $image_type;
+    }
+
+    if ($top) {
+	$doc_obj->add_metadata ($section, "srclink", 
+				"<a href=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Image]\">");
+	$doc_obj->add_metadata ($section, "srcicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Image]\">");
+
+    } else {
+	$doc_obj->add_metadata ($section, "srclink", 
+				"<a href=\"_httpprefix_/collect/[collection]/index/assoc/[parent(Top):assocfilepath]/[Image]\">");
+	$doc_obj->add_metadata ($section, "srcicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[parent(Top):assocfilepath]/[Image]\">");
+
+    }
+    $doc_obj->add_metadata ($section, "/srclink", "</a>");
+
+
+    # Add the image as an associated file
+    $doc_obj->associate_file($filename,$file,"image/$type",$section);
+    print $outhandle "associating file $filename as name $file\n" if ($verbosity > 2);
+
+    if ($self->{'thumbnail'}) {
+	# Make the thumbnail image
+	my $thumbnailsize = $self->{'thumbnailsize'} || 100;
+	my $thumbnailtype = $self->{'thumbnailtype'} || 'gif';
+	
+	my $filehead = &util::get_tmp_filename();
+	my $thumbnailfile = $filehead . ".$thumbnailtype";
+	my $n=1;
+	while (-e $thumbnailfile) {
+	    $thumbnailfile = $filehead . $n . ".$thumbnailtype";
+	    $n++;
+	}
+	
+	$self->{'tmp_filename2'} = $thumbnailfile;
+	
+	# Generate the thumbnail with convert
+	my $command = "convert  -verbose -geometry $thumbnailsize" 
+	    . "x$thumbnailsize \"$filename\" \"$thumbnailfile\"";
+	print $outhandle "THUMBNAIL: $command\n" if ($verbosity > 2);
+	my $result = '';
+	$result = `$command 2>&1` ;
+	print $outhandle "THUMB RESULT: $result\n" if ($verbosity > 2);
+	
+	# Add the thumbnail as an associated file ...
+	if (-e "$thumbnailfile") { 
+	    $doc_obj->associate_file("$thumbnailfile", $id."thumb.$thumbnailtype", "image/$thumbnailtype",$section);
+	    $doc_obj->add_metadata ($section, "ThumbType", $thumbnailtype);
+	    $doc_obj->add_metadata ($section, "Thumb", $id."thumb.$thumbnailtype");
+	    if ($top) {
+		$doc_obj->add_metadata ($section, "thumbicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Thumb]\" width=[ThumbWidth] height=[ThumbHeight]>");
+	    } else {
+		$doc_obj->add_metadata ($section, "thumbicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[parent(Top):assocfilepath]/[Thumb]\" width=[ThumbWidth] height=[ThumbHeight]>");
+	    }
+	}
+	
+	# Extract Thumnail metadata from convert output
+	if ($result =~ m/[0-9]+x[0-9]+=>([0-9]+)x([0-9]+)/) {
+	    $doc_obj->add_metadata ($section, "ThumbWidth", $1);
+	    $doc_obj->add_metadata ($section, "ThumbHeight", $2);
+	}
+    }
+    # Make a screen-sized version of the picture if requested
+    if ($self->{'screenview'}) {
+	
+	# To do: if the actual image is smaller than the screenview size,
+	# we should use the original !
+
+	my $screenviewsize = $self->{'screenviewsize'} || 500;
+	my $screenviewtype = $self->{'screenviewtype'} || 'jpeg';
+	my $filehead = &util::get_tmp_filename();
+	my $screenviewfilename = $filehead . ".$screenviewtype";
+	my $n=1;
+	while (-e $screenviewfilename) {
+	    $screenviewfilename = "$filehead$n\.$screenviewtype";
+	    $n++;
+	}
+	$self->{'tmp_filename3'} = $screenviewfilename;
+
+	# make the screenview image
+	my $command = "convert  -verbose -geometry $screenviewsize" 
+	    . "x$screenviewsize \"$filename\" \"$screenviewfilename\"";
+	print $outhandle "SCREENVIEW: $command\n" if ($verbosity > 2);
+	my $result = "";
+	$result = `$command  2>&1` ;
+	print $outhandle "SCREENVIEW RESULT: $result\n" if ($verbosity > 3);
+
+	# get screenview dimensions, size and type
+        if ($result =~ m/[0-9]+x[0-9]+=>([0-9]+)x([0-9]+)/) {
+	    $doc_obj->add_metadata ($section, "ScreenWidth", $1);
+	    $doc_obj->add_metadata ($section, "ScreenHeight", $2);
+	}elsif ($result =~ m/([0-9]+)x([0-9]+)/) {
+	    #if the image hasn't changed size,  the previous regex doesn't match
+	    $doc_obj->add_metadata ($section, "ScreenWidth", $1);
+	    $doc_obj->add_metadata ($section, "ScreenHeight", $2);
+	}
+    
+	#add the screenview as an associated file ...
+	if (-e "$screenviewfilename") { 
+	    $doc_obj->associate_file("$screenviewfilename", $id."sv.$screenviewtype",
+				     "image/$screenviewtype",$section);
+	    print $outhandle "associating screen file $screenviewfilename as name $id sv.$screenviewtype\n" if ($verbosity > 2);
+	    
+	    $doc_obj->add_metadata ($section, "ScreenType", $screenviewtype);
+	    $doc_obj->add_metadata ($section, "Screen", $id."sv.$screenviewtype");
+
+	    if ($top) {
+		$doc_obj->add_metadata ($section, "screenicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Screen]\" width=[ScreenWidth] height=[ScreenHeight]>");
+	    } else {
+		$doc_obj->add_metadata ($section, "screenicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[parent(Top):assocfilepath]/[Screen]\" width=[ScreenWidth] height=[ScreenHeight]>");
+
+	    }
+	} else {
+	    print $outhandle "PagedImgPlug: couldn't find \"$screenviewfilename\"\n";
+	}
+    }
+
+    return $type;
+
+
+}
+
+
+
+# Discover the characteristics of an image file with the ImageMagick
+# "identify" command.
+
+sub identify { 
+    my ($image, $outhandle, $verbosity) = @_;
+
+    # Use the ImageMagick "identify" command to get the file specs
+    my $command = "identify \"$image\" 2>&1";
+    print $outhandle "$command\n" if ($verbosity > 2);
+    my $result = '';
+    $result = `$command`;
+    print $outhandle "$result\n" if ($verbosity > 3);
+
+    # Read the type, width, and height
+    my $type =   'unknown';
+    my $width =  'unknown';
+    my $height = 'unknown';
+
+    my $image_safe = quotemeta $image;
+    if ($result =~ /^$image_safe (\w+) (\d+)x(\d+)/) {
+	$type = $1;
+	$width = $2;
+	$height = $3;
+    }
+	
+    # Read the size
+    my $size = "unknown";
+    if ($result =~ m/^.* ([0-9]+)b/) {
+	$size = $1;
+    } elsif ($result =~ m/^.* ([0-9]+)kb/) {
+	$size = 1024 * $1;
+    }
+
+    print $outhandle "file: $image:\t $type, $width, $height, $size\n" 
+	if ($verbosity > 3);
+
+    # Return the specs
+    return ($type, $width, $height, $size);
+}
+
+
+# The PagedImgPlug read() function. This function does all the right things
+# to make general options work for a given plugin. It calls the process()
+# function which does all the work specific to a plugin (like the old
+# read functions used to do). Most plugins should define their own 
+# process() function and let this read() function keep control.
+#
+# PagedImgPlug overrides read() because there is no need to read the actual 
+# text of the file in, because the contents of the file is not text...
+#
+# Return number of files processed, undef if can't process
+# Note that $base_dir might be "" and that $file might 
+# include directories
+
+sub read_into_doc_obj {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+    my $outhandle   = $self->{'outhandle'};
+    
+    #check process and block exps, smart block, etc
+    my ($block_status,$filename) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+    
+    print $outhandle "PagedImgPlug processing \"$filename\"\n"
+	if $self->{'verbosity'} > 1;
+    print STDERR "<Processing n='$file' p='PagedImgPlug'>\n" if ($gli);
+    
+    # here we need to decide if we have an old text .item file, or a new xml 
+    # .item file - for now the test is if the first non-empty line is 
+    # <PagedDocument> then its xml
+    my $xml_version = 0;
+    open (ITEMFILE, $filename) || die "couldn't open $filename\n";
+    
+    my $backup_filename = "backup.item";
+    open (BACKUP,">$backup_filename")|| die "couldn't write to $backup_filename\n";
+    my $line = "";
+    my $num = 0;
+    $line = <ITEMFILE>;
+    while ($line !~ /\w/) {
+	$line = <ITEMFILE>;
+    }
+    chomp $line;
+    if ($line =~ /<PagedDocument/) {
+	$xml_version = 1;
+    }
+    close ITEMFILE;
+    open (ITEMFILE, $filename) || die "couldn't open $filename\n";
+    $line = <ITEMFILE>;
+    $line =~ s/^\xEF\xBB\xBF//; # strip BOM
+    $line =~ s/\x0B+//ig;
+    $line =~ s/&/&amp;/g;
+    print BACKUP ($line);
+    #Tidy up the item file some metadata title contains \vt-vertical tab
+    while ($line = <ITEMFILE>) {
+	$line =~ s/\x0B+//ig;
+	$line =~ s/&/&amp;/g;
+	print BACKUP ($line);
+    }
+    close ITEMFILE;
+    close BACKUP;
+    &File::Copy::copy ($backup_filename, $filename);
+    &util::rm($backup_filename);
+
+    my $doc_obj;
+    if ($xml_version) {
+	$file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
+	$self->{'file'} = $file;
+	$self->{'filename'} = $filename;
+	$self->{'processor'} = $processor;
+	$self->{'metadata'} = $metadata;
+
+	eval {
+	    $@ = "";
+	    my $xslt = $self->{'xslt'};
+	    if (defined $xslt && ($xslt ne "")) {
+		# perform xslt
+		my $transformed_xml = $self->apply_xslt($xslt,$filename);
+		
+		# feed transformed file (now in memory as string) into XML parser
+		#$self->{'parser'}->parse($transformed_xml);
+		$self->parse_string($transformed_xml);
+	    }
+	    else {
+		#$self->{'parser'}->parsefile($filename);
+		$self->parse_file($filename);
+	    }
+	};
+	
+	
+	
+	if ($@) {
+	    
+	    # parsefile may either croak somewhere in XML::Parser (e.g. because
+	    # the document is not well formed) or die somewhere in XMLPlug or a
+	    # derived plugin (e.g. because we're attempting to process a
+	    # document whose DOCTYPE is not meant for this plugin). For the
+	    # first case we'll print a warning and continue, for the second
+	    # we'll just continue quietly
+	    
+	    print STDERR "**** XML Parse Error is: $@\n";
+	    
+	    my ($msg) = $@ =~ /Carp::croak\(\'(.*?)\'\)/;
+	    if (defined $msg) {	
+		my $outhandle = $self->{'outhandle'};
+		my $plugin_name = ref ($self);
+		print $outhandle "$plugin_name failed to process $file ($msg)\n";
+	    }
+
+	    # reset ourself for the next document
+	    $self->{'section_level'}=0;
+	    print STDERR "<ProcessingError n='$file'>\n" if ($gli);
+	    return -1; # error during processing
+	}
+	$doc_obj = $self->{'doc_obj'};
+    } else {
+	my ($dir);
+	($dir, $file) = $filename =~ /^(.*?)([^\/\\]*)$/;
+
+	#process the .item file
+	$doc_obj = $self->process_item($filename, $dir, $file, $processor);
+	
+    }
+    
+    if ($self->{'cover_image'}) {
+	$self->associate_cover_image($doc_obj, $filename);
+    }
+
+    # include any metadata passed in from previous plugins 
+    # note that this metadata is associated with the top level section
+    my $section = $doc_obj->get_top_section();
+    $self->extra_metadata ($doc_obj, $section, $metadata);
+    #my $text="";
+    # do plugin specific processing of doc_obj
+    #unless (defined ($self->process(\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj))) {
+	#print STDERR "<ProcessingError n='$file'>\n" if ($gli);
+	#return -1;
+    #}
+    # do any automatic metadata extraction
+    $self->auto_extract_metadata ($doc_obj);
+
+    $self->{'num_processed'}++;
+    return (1,$doc_obj);
+}
+
+sub read
+{
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;    my ($process_status,$doc_obj) = $self->read_into_doc_obj(@_);
+
+    if ((defined $process_status) && ($process_status == 1)) {
+	# process the document
+	$processor->process($doc_obj);
+
+	#if(defined($self->{'places_filename'})){
+	#    &util::rm($self->{'places_filename'});
+	#    $self->{'places_filename'} = undef;
+	#}
+	#$self->{'num_processed'} ++;
+	undef $doc_obj; 
+    }
+    
+    # clean up temporary files - we do this here instead of in  
+    # process_image becuase associated files aren't actually copied 
+    # until after process has been run.
+    if (defined $self->{'tmp_filename1'} && 
+	-e $self->{'tmp_filename1'}) {
+	&util::rm($self->{'tmp_filename1'})
+    }
+    if (defined $self->{'tmp_filename2'} && 
+	-e $self->{'tmp_filename2'}) {
+	&util::rm($self->{'tmp_filename2'})
+    }
+    if (defined $self->{'tmp_filename3'} && 
+	-e $self->{'tmp_filename3'}) {
+      &util::rm($self->{'tmp_filename3'})
+    }
+    # if process_status == 1, then the file has been processed.
+    return $process_status;
+}
+
+sub xml_start_tag {
+    my $self = shift(@_);
+    my ($expat, $element) = @_;
+    $self->{'element'} = $element;
+    
+    my $doc_obj = $self->{'doc_obj'};
+    if ($element eq "PagedDocument") {
+	$self->{'current_section'} = $doc_obj->get_top_section();
+    } elsif ($element eq "PageGroup" || $element eq "Page") {
+	# create a new section as a child
+	$self->{'current_section'} = $doc_obj->insert_section($doc_obj->get_end_child($self->{'current_section'}));
+	$self->{'num_pages'}++;
+	# assign pagenum as  what??
+	my $pagenum = $_{'pagenum'}; #TODO!!
+	if (defined $pagenum) {
+	    $doc_obj->set_utf8_metadata_element($self->{'current_section'}, 'PageNum', $pagenum);
+	}
+	my ($imgfile) = $_{'imgfile'};
+	if (defined $imgfile) {
+	    $self->process_image($self->{'base_dir'}.$imgfile, $imgfile, $doc_obj, $self->{'current_section'});
+	}
+	my ($txtfile) = $_{'txtfile'};
+	if (defined($txtfile)&& $txtfile ne "") {
+	    $self->process_text ($self->{'base_dir'}.$txtfile, $txtfile, $doc_obj, $self->{'current_section'});
+            $doc_obj->set_metadata_element($self->{'current_section'},"NoText","0");
+	} else {
+	    # otherwise add in some dummy text
+	    #create an empty text string so we don't break downstream plugins 
+	    my $text = &gsprintf::lookup_string("{BasPlug.dummy_text}",1);
+	    $doc_obj->add_utf8_text($self->{'current_section'}, $text);
+            $doc_obj->add_metadata($self->{'current_section'},"NoText","1"); 
+	}
+    } elsif ($element eq "Metadata") {
+	$self->{'metadata_name'} = $_{'name'};
+    }
+}
+
+sub xml_end_tag {
+    my $self = shift(@_);
+    my ($expat, $element) = @_;
+    
+    my $doc_obj = $self->{'doc_obj'};
+    if ($element eq "Page" || $element eq "PageGroup") {
+	# if Title hasn't been assigned, set PageNum as Title
+	if (!defined $doc_obj->get_metadata_element ($self->{'current_section'}, "Title") && defined $doc_obj->get_metadata_element ($self->{'current_section'}, "PageNum" )) {
+	    $doc_obj->add_utf8_metadata ($self->{'current_section'}, "Title", $doc_obj->get_metadata_element ($self->{'current_section'}, "PageNum" ));
+	}
+	# move the current section back to the parent
+	$self->{'current_section'} = $doc_obj->get_parent_section($self->{'current_section'});
+    } elsif ($element eq "Metadata") {
+	
+	$doc_obj->add_utf8_metadata ($self->{'current_section'}, $self->{'metadata_name'}, $self->{'metadata_value'});
+	$self->{'metadata_name'} = "";
+	$self->{'metadata_value'} = "";
+
+    }
+    # otherwise we ignore the end tag
+}
+
+
+sub xml_text {
+    my $self = shift(@_);
+    my ($expat) = @_; 
+
+    if ($self->{'element'} eq "Metadata" && $self->{'metadata_name'}) {
+   	$self->{'metadata_value'} .= $_;
+    }
+}
+
+sub xml_doctype {
+}
+
+sub open_document {
+    my $self = shift(@_);
+    
+    # create a new document
+    $self->{'doc_obj'} = new doc ($self->{'filename'}, "indexed_doc");
+    my $doc_obj = $self->{'doc_obj'};
+    $doc_obj->set_OIDtype ($self->{'processor'}->{'OIDtype'});
+    my ($dir, $file) = $self->{'filename'} =~ /^(.*?)([^\/\\]*)$/;
+    $self->{'base_dir'} = $dir;
+    $self->{'num_pages'} = 0;
+    my $topsection = $doc_obj->get_top_section();
+    if ($self->{'documenttype'} eq 'paged') {
+	# set the gsdlthistype metadata to Paged - this ensures this document will
+	# be treated as a Paged doc, even if Titles are not numeric
+    
+	$doc_obj->set_utf8_metadata_element ($topsection, "gsdlthistype", "Paged");
+    } else {
+	$doc_obj->set_utf8_metadata_element ($topsection, "gsdlthistype", "Hierarchy");
+    }
+
+    $doc_obj->add_metadata ($topsection, "Source", $file);
+    if ($self->{'headerpage'}) {
+	$doc_obj->add_text($topsection, &gsprintf::lookup_string("{BasPlug.dummy_text}"));
+    }
+
+}
+
+sub close_document {
+    my $self = shift(@_);
+    my $doc_obj = $self->{'doc_obj'};
+        
+    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
+    $doc_obj->add_metadata($doc_obj->get_top_section(), "FileFormat", "PagedImg");
+    
+    # add numpages metadata
+    $doc_obj->set_utf8_metadata_element ($doc_obj->get_top_section(), 'NumPages', $self->{'num_pages'});
+
+    # add an OID
+    $doc_obj->set_OID();
+    
+}
+
+sub process_item {
+    my $self = shift (@_);
+    my ($filename, $dir, $file, $processor) = @_;
+
+    my $doc_obj = new doc ($filename, "indexed_doc");
+    $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
+    my $topsection = $doc_obj->get_top_section();
+    $doc_obj->add_utf8_metadata($topsection, "Plugin", "$self->{'plugin_type'}");
+    $doc_obj->add_metadata($topsection, "FileFormat", "PagedImg");
+
+    if ($self->{'documenttype'} eq 'paged') {
+	# set the gsdlthistype metadata to Paged - this ensures this document will
+	# be treated as a Paged doc, even if Titles are not numeric
+	$doc_obj->set_utf8_metadata_element ($topsection, "gsdlthistype", "Paged");
+    } else {
+	$doc_obj->set_utf8_metadata_element ($topsection, "gsdlthistype", "Hierarchy");
+    }
+
+    $doc_obj->add_metadata ($topsection, "Source", $file);
+
+    open (ITEMFILE, $filename) || die "couldn't open $filename\n";
+    my $line = "";
+    my $num = 0;
+    while (defined ($line = <ITEMFILE>)) {
+	next unless $line =~ /\w/;
+	chomp $line;
+	next if $line =~ /^#/; # ignore comment lines
+	if ($line =~ /^<([^>]*)>\s*(.*?)\s*$/) {
+	    $doc_obj->set_utf8_metadata_element ($topsection, $1, $2);
+	    #$meta->{$1} = $2;
+	} else {
+	    $num++;
+	    # line should be like page:imagefilename:textfilename:r - the r is optional -> means rotate the image 180 deg
+	    $line =~ s/^\s+//; #remove space at the front
+	    $line =~ s/\s+$//; #remove space at the end
+	    my ($pagenum, $imgname, $txtname, $rotate) = split /:/, $line;
+	    
+	    # create a new section for each image file
+	    my $cursection = $doc_obj->insert_section($doc_obj->get_end_child($topsection));
+	    # the page number becomes the Title
+	    $doc_obj->set_utf8_metadata_element($cursection, 'Title', $pagenum);
+	 
+	    # process the image for this page if there is one
+	    if (defined $imgname && $imgname ne "") {
+		my $result1 = $self->process_image($dir.$imgname, $imgname, $doc_obj, $cursection, $rotate);
+		
+		if (!defined $result1)
+		{
+		    print "PagedImgPlug: couldn't process image \"$dir.$imgname\" for item \"$filename\"\n";
+		}
+	    }
+	    # process the text file if one is there
+	    if (defined $txtname && $txtname ne "") {
+		my $result2 = $self->process_text ($dir.$txtname, $txtname, $doc_obj, $cursection);
+               
+		if (!defined $result2) {
+		    print "PagedImgPlug: couldn't process text file \"$dir.$txtname\" for item \"$filename\"\n";
+		}
+                else{
+		    $doc_obj->set_metadata_element($cursection, "NoText", "0");
+		}
+	    } else {
+		# otherwise add in some dummy text 
+		$doc_obj->add_text($cursection, &gsprintf::lookup_string("{BasPlug.dummy_text}"));
+                 # add NoText metadata which can be used to suppress the dummy text
+	     }
+	}
+    }
+    
+    close ITEMFILE;
+
+    # if we want a header page, we need to add some text into the top section, otherwise this section will become invisible
+    if ($self->{'headerpage'}) {
+	$doc_obj->add_text($topsection, &gsprintf::lookup_string("{BasPlug.dummy_text}"));
+    }
+    $file =~ s/\.item//i;
+    $doc_obj->set_OID ();
+    # add numpages metadata
+    $doc_obj->set_utf8_metadata_element ($topsection, 'NumPages', "$num");
+    return $doc_obj;
+}
+
+sub process_text {
+    my $self = shift (@_);
+    my ($fullpath, $file, $doc_obj, $cursection) = @_;
+    
+    # check that the text file exists!!
+    if (!-f $fullpath) {
+	print "PagedImgPlug: ERROR: File $fullpath does not exist, skipping\n";
+	return 0;
+    }
+
+    # Do encoding stuff
+    my ($language, $encoding) = $self->textcat_get_language_encoding ($fullpath);
+
+    my $text="";
+    &BasPlug::read_file($self, $fullpath, $encoding, $language, \$text);
+    if (!length ($text)) {
+	# It's a bit unusual but not out of the question to have no text, so just give a warning
+        print "PagedImgPlug: WARNING: $fullpath contains no text\n";
+    }
+
+    # we need to escape the escape character, or else mg will convert into
+    # eg literal newlines, instead of leaving the text as '\n'
+    $text =~ s/\\/\\\\/g; # macro language
+    $text =~ s/_/\\_/g; # macro language
+
+
+    if ($text =~ m/<html.*?>\s*<head.*?>.*<\/head>\s*<body.*?>(.*)<\/body>\s*<\/html>\s*$/s) {
+	# looks like HTML input
+	# no need to escape < and > or put in <pre> tags
+
+	$text = $1;
+
+	# insert preformat tags and add text to document object
+	$doc_obj->add_utf8_text($cursection, "$text");
+    }
+    else {
+	$text =~ s/</&lt;/g;
+	$text =~ s/>/&gt;/g;
+
+	# insert preformat tags and add text to document object
+	$doc_obj->add_utf8_text($cursection, "<pre>\n$text\n</pre>");
+    }
+
+    
+    return 1;
+}
+
+# do plugin specific processing of doc_obj
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
+    my $outhandle = $self->{'outhandle'};
+    
+    return 1;
+}
+
+1;
Index: dl/trunk/perllib/plugins/PagedImgPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/PagedImgPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,971 +1,0 @@
-###########################################################################
-#
-# PagedImgPlug.pm -- plugin for sets of images and OCR text that
-#  make up a document
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999 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.
-#
-###########################################################################
-
-# PagedImgPlug
-# processes sequences of images, with optional OCR text
-#
-# This plugin takes *.item files, which contain metadata and lists of image 
-# files, and produces a document containing sections, one for each page.
-# The files should be named something.item, then you can have more than one 
-# book in a directory. You will need to create these files, one for each
-# document/book.
-#
-#There are two formats for the item files: a plain text format, and an xml 
-#format. You can use either format, and can have both formats in the same 
-#collection if you like. If you use the plain format, you must not start the 
-#file off with <PagedDocument>
-
-#### PLAIN FORMAT
-# The format of the xxx.item file is as follows:
-# The first lines contain any metadata for the whole document
-# <metadata-name>metadata-value
-# eg.
-# <Title>Snail farming
-# <Date>19230102
-# Then comes a list of pages, one page per line, each line has the format
-#
-# pagenum:imagefile:textfile:r
-#
-# page num and imagefile are required. pagenum is used for the Title 
-# of the section, and in the display is shown as page <pagenum>. 
-# imagefile is the image for the page. textfile is an optional text 
-# file containing the OCR (or any) text for the page - this gets added 
-# as the text for the section. r is optional, and signals that the image 
-# should be rotated 180deg. Eg use this if the image has been made upside down.
-# So an example item file looks like:
-# <Title>Snail farming
-# <Date>19960403
-# 1:p1.gif:p1.txt:
-# 2:p2.gif::
-# 3:p3.gif:p3.txt:
-# 3b:p3b.gif:p3b.txt:r
-# The second page has no text, the fourth page is a back page, and 
-# should be rotated.
-# 
-
-#### XML FORMAT
-# The xml format looks like the following
-#<PagedDocument>
-#<Metadata name="Title">The Title of the entire document</Metadata>
-#<Page pagenum="1" imgfile="xxx.jpg" txtfile="yyy.txt">
-#<Metadata name="Title">The Title of this page</Metadata>
-#</Page>
-#... more pages
-#</PagedDocument>
-#PagedDocument contains a list of Pages, Metadata and PageGroups. Any metadata 
-#that is not inside another tag will belong to the document.
-#Each Page has a pagenum (not used at the moment), an imgfile and/or a txtfile.
-#These are both optional - if neither is used, the section will have no content.
-#Pages can also have metadata associated with them.
-#PageGroups can be introduced at any point - they can contain Metadata and Pages and other PageGroups. They are used to introduce hierarchical structure into the document.
-#For example
-#<PagedDocument>
-#<PageGroup>
-#<Page>
-#<Page>
-#</PageGroup>
-#<Page>
-#</PagedDocument>
-#would generate a structure like
-#X
-#--X
-#  --X
-#  --X
-#--X
-#PageGroup tags can also have imgfile/textfile metadata if you like - this way they get some content themselves.
-
-#Currently the XML structure doesn't work very well with the paged document type, unless you use numerical Titles for each section.
-#There is still a bit of work to do on this format:
-#* enable other text file types, eg html, pdf etc
-#* make the document paging work properly
-#* add pagenum as Title unless a Title is present?
-
-# All the supplemetary image amd text files should be in the same folder as 
-# the .item file.
-#
-# To display the images instead of the document text, you can use [srcicon] 
-# in the DocumentText format statement.
-# For example, 
-#
-# format DocumentText "<center><table width=_pagewidth_><tr><td>[srcicon]</td></tr></table></center>"
-#
-# To have it create thumbnail size images, use the '-thumbnail' option.
-# To have it create medium size images for display, use the '-screenview'
-# option. As usual, running 
-# 'perl -S pluginfo.pl PagedImgPlug' will list all the options.
-
-# If you want the resulting documents to be presented with a table of 
-# contents, use '-documenttype hierarchy', otherwise they will have 
-# next and previous arrows, and a goto page X box. 
-
-# If you have used -screenview, you can also use [screenicon] in the format
-# statement to display the smaller image.  Here is an example  that switches 
-# between the two: 
-#
-# format DocumentText "<center><table width=_pagewidth_><tr><td>{If}{_cgiargp_ eq full,<a href='_httpdocument_&d=_cgiargd_&p=small'>Switch to small version.</a>,<a href='_httpdocument_&d=_cgiargd_&p=full'>Switch to fullsize version</a>}</td></tr><tr><td>{If}{_cgiargp_ eq full,<a href='_httpdocument_&d=_cgiargd_&p=small' title='Switch to small version'>[srcicon]</a>,<a href='_httpdocument_&d=_cgiargd_&p=full' title='Switch to fullsize version'>[screenicon]</a>}</td></tr></table></center>"
-#
-# Additional metadata can be added into the .item files, alternatively you can 
-# use normal metadata.xml files, with the name of the xxx.item file as the 
-# FileName (only for document level metadata).
-
-package PagedImgPlug;
-
-use XMLPlug;
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @PagedImgPlug::ISA = ('XMLPlug');
-}
-
-my $type_list =
-    [ { 'name' => "paged",
-        'desc' => "{PagedImgPlug.documenttype.paged}" },
-      { 'name' => "hierarchy",
-        'desc' => "{PagedImgPlug.documenttype.hierarchy}" } ];
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "string",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" },
-      { 'name' => "block_exp",
-	'desc' => "{BasPlug.block_exp}",
-	'type' => "string",
-	'deft' => &get_default_block_exp(),
-	'reqd' => "no" },
-      { 'name' => "title_sub",
-	'desc' => "{HTMLPlug.title_sub}",
-	'type' => "string", 
-	'deft' => "" },
-      { 'name' => "noscaleup",
-	'desc' => "{ImagePlug.noscaleup}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "thumbnail",
-	'desc' => "{PagedImgPlug.thumbnail}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "thumbnailsize",
-	'desc' => "{ImagePlug.thumbnailsize}",
-	'type' => "int",
-	'deft' => "100",
-	'range' => "1,",
-	'reqd' => "no" },
-      { 'name' => "thumbnailtype",
-	'desc' => "{ImagePlug.thumbnailtype}",
-	'type' => "string",
-	'deft' => "gif",
-	'reqd' => "no" },
-      { 'name' => "screenview",
-	'desc' => "{PagedImgPlug.screenview}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "screenviewsize",
-	'desc' => "{PagedImgPlug.screenviewsize}",
-	'type' => "int",
-        'deft' => "500",
-        'range' => "1,",
-	'reqd' => "no" },
-      { 'name' => "screenviewtype",
-	'desc' => "{PagedImgPlug.screenviewtype}",
-	'type' => "string",
-	'deft' => "jpg",
-	'reqd' => "no" },
-      { 'name' => "converttotype",
-	'desc' => "{ImagePlug.converttotype}",
-	'type' => "string",
-	'deft' => "",
-	'reqd' => "no" },
-      { 'name' => "minimumsize",
-	'desc' => "{ImagePlug.minimumsize}",
-	'type' => "int",
-	'deft' => "100",
-	'range' => "1,",
-	'reqd' => "no" },
-      { 'name' => "headerpage",
-	'desc' => "{PagedImgPlug.headerpage}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "documenttype",
-	'desc' => "{PagedImgPlug.documenttype}",
-	'type' => "enum",
-	'list' => $type_list,
-	'deft' => "paged",
-	'reqd' => "no" } ];
-
-
-my $options = { 'name'     => "PagedImgPlug",
-		'desc'     => "{PagedImgPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-    
-    my $self = new XMLPlug($pluginlist, $inputargs, $hashArgOptLists);
-    
-    return bless $self, $class;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^\.item$^;
-}
-
-sub get_doctype {
-    my $self = shift(@_);
-    
-    return "PagedDocument";
-}
-
-
-# want to block everything except the .item ones 
-# but instead we will block images and txt files
-sub get_default_block_exp {
-    my $self = shift (@_);
-    
-    return q^(?i)(\.jpe?g|\.gif|\.png|\.tif?f|\.te?xt|\.html?|~)$^
-}
-
-# Create the thumbnail and screenview images, and discover the Image's
-# size, width, and height using the convert utility.
-sub process_image {
-    my $self = shift (@_);
-    my $filename = shift (@_); # filename with full path
-    my $srcfile = shift (@_); # filename without path
-    my $doc_obj = shift (@_);
-    my $section = shift (@_); #the current section
-    my $rotate = shift (@_); # whether to rotate the image or not
-    $rotate = 0 unless defined $rotate;
-    
-    # check that the image file exists!!
-    if (!-f $filename) {
-	print "PagedImgPlug: ERROR: File $filename does not exist, skipping\n";
-	return 0;
-    }
-
-    my $top=0;
-    if ($section eq $doc_obj->get_top_section()) {
-	$top=1;
-    }
-    my $verbosity = $self->{'verbosity'};
-    my $outhandle = $self->{'outhandle'};
-
-    # check the filename is okay
-    return 0 if ($srcfile eq "" || $filename eq "");
-    
-    my $minimumsize = $self->{'minimumsize'};
-    if (defined $minimumsize && (-s $filename < $minimumsize)) {
-        print $outhandle "PagedImgPlug: \"$filename\" too small, skipping\n"
-	    if ($verbosity > 1);
-    }
-
-    # Convert the image to a new type (if required), and rotate if required.
-    my $converttotype = $self->{'converttotype'};
-    my $originalfilename = "";  # only set if we do a conversion
-    my $type = "unknown";
-    my $converted = 0;
-    my $rotated=0;
-
-    if ($converttotype ne "" && $filename !~ /$converttotype$/) {
-	$converted=1;
-	$originalfilename = $filename;
-	my $filehead = &util::get_tmp_filename();
-	$filename = $filehead . ".$converttotype";
-	my $n = 1;
-	while (-e $filename) {
-	    $filename = "$filehead$n\.$converttotype";
-	    $n++;
-	}
-	$self->{'tmp_filename1'} = $filename;
-
-	my $rotate_option = "";
-	if ($rotate eq "r") {
-	    $rotate_option = "-rotate 180 ";
-	}
-	
-	my $command = "convert -verbose \"$originalfilename\" $rotate_option \"$filename\"";
-	print $outhandle "CONVERT: $command\n" if ($verbosity > 2);
-	my $result = '';
-	$result = `$command`;
-	print $outhandle "CONVERT RESULT = $result\n" if ($verbosity > 2);
-
-	$type = $converttotype;
-    } elsif ($rotate eq "r") {
-	$rotated=1;
-	$originalfilename = $filename;
-	$filename  = &util::get_tmp_filename();
-	
-	my $command = "convert \"$originalfilename\" -rotate 180 \"$filename\"";
-	print $outhandle "ROTATE: $command\n" if ($verbosity > 2);
-	my $result = '';
-	$result = `$command`;
-	print $outhandle "ROTATE RESULT = $result\n" if ($verbosity > 2);
-	
-    } 
-    
-
-    # Add the image metadata
-    my $file; # the new file name
-    my $id = $srcfile;
-    $id =~ s/\.([^\.]*)$//;  # the new file name without an extension
-    if ($converted) {
-	# we have converted the image
-	# add on the new extension
-	$file .= "$id.$converttotype";
-    } else {
-	$file = $srcfile;
-    }
-    
-    my $url =$file; # the new file name prepared for a url
-    my $srcurl = $srcfile;
-    ##$url =~ s/ /%20/g;
-    ##$srcurl =~ s/ /%20/g;
-    
-    $doc_obj->add_metadata ($section, "Image", $url);
-
-    # Also want to set filename as 'Source' metadata to be
-    # consistent with other plugins
-    $doc_obj->add_metadata ($section, "Source", $srcurl);
-
-    my ($image_type, $image_width, $image_height, $image_size) 
-	= &identify($filename, $outhandle, $verbosity);
-
-    $doc_obj->add_metadata ($section, "ImageType",   $image_type);
-    $doc_obj->add_metadata ($section, "ImageWidth",  $image_width);
-    $doc_obj->add_metadata ($section, "ImageHeight", $image_height);
-    $doc_obj->add_metadata ($section, "ImageSize",   $image_size);
-    $doc_obj->add_metadata ($section, "FileFormat", "PagedImg");
-    # add NoText metadata which can be used to suppress the dummy text
-    $doc_obj->add_metadata ($section, "NoText", "1");
-
-    if ($type eq "unknown" && $image_type) {
-	$type = $image_type;
-    }
-
-    if ($top) {
-	$doc_obj->add_metadata ($section, "srclink", 
-				"<a href=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Image]\">");
-	$doc_obj->add_metadata ($section, "srcicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Image]\">");
-
-    } else {
-	$doc_obj->add_metadata ($section, "srclink", 
-				"<a href=\"_httpprefix_/collect/[collection]/index/assoc/[parent(Top):assocfilepath]/[Image]\">");
-	$doc_obj->add_metadata ($section, "srcicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[parent(Top):assocfilepath]/[Image]\">");
-
-    }
-    $doc_obj->add_metadata ($section, "/srclink", "</a>");
-
-
-    # Add the image as an associated file
-    $doc_obj->associate_file($filename,$file,"image/$type",$section);
-    print $outhandle "associating file $filename as name $file\n" if ($verbosity > 2);
-
-    if ($self->{'thumbnail'}) {
-	# Make the thumbnail image
-	my $thumbnailsize = $self->{'thumbnailsize'} || 100;
-	my $thumbnailtype = $self->{'thumbnailtype'} || 'gif';
-	
-	my $filehead = &util::get_tmp_filename();
-	my $thumbnailfile = $filehead . ".$thumbnailtype";
-	my $n=1;
-	while (-e $thumbnailfile) {
-	    $thumbnailfile = $filehead . $n . ".$thumbnailtype";
-	    $n++;
-	}
-	
-	$self->{'tmp_filename2'} = $thumbnailfile;
-	
-	# Generate the thumbnail with convert
-	my $command = "convert  -verbose -geometry $thumbnailsize" 
-	    . "x$thumbnailsize \"$filename\" \"$thumbnailfile\"";
-	print $outhandle "THUMBNAIL: $command\n" if ($verbosity > 2);
-	my $result = '';
-	$result = `$command 2>&1` ;
-	print $outhandle "THUMB RESULT: $result\n" if ($verbosity > 2);
-	
-	# Add the thumbnail as an associated file ...
-	if (-e "$thumbnailfile") { 
-	    $doc_obj->associate_file("$thumbnailfile", $id."thumb.$thumbnailtype", "image/$thumbnailtype",$section);
-	    $doc_obj->add_metadata ($section, "ThumbType", $thumbnailtype);
-	    $doc_obj->add_metadata ($section, "Thumb", $id."thumb.$thumbnailtype");
-	    if ($top) {
-		$doc_obj->add_metadata ($section, "thumbicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Thumb]\" width=[ThumbWidth] height=[ThumbHeight]>");
-	    } else {
-		$doc_obj->add_metadata ($section, "thumbicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[parent(Top):assocfilepath]/[Thumb]\" width=[ThumbWidth] height=[ThumbHeight]>");
-	    }
-	}
-	
-	# Extract Thumnail metadata from convert output
-	if ($result =~ m/[0-9]+x[0-9]+=>([0-9]+)x([0-9]+)/) {
-	    $doc_obj->add_metadata ($section, "ThumbWidth", $1);
-	    $doc_obj->add_metadata ($section, "ThumbHeight", $2);
-	}
-    }
-    # Make a screen-sized version of the picture if requested
-    if ($self->{'screenview'}) {
-	
-	# To do: if the actual image is smaller than the screenview size,
-	# we should use the original !
-
-	my $screenviewsize = $self->{'screenviewsize'} || 500;
-	my $screenviewtype = $self->{'screenviewtype'} || 'jpeg';
-	my $filehead = &util::get_tmp_filename();
-	my $screenviewfilename = $filehead . ".$screenviewtype";
-	my $n=1;
-	while (-e $screenviewfilename) {
-	    $screenviewfilename = "$filehead$n\.$screenviewtype";
-	    $n++;
-	}
-	$self->{'tmp_filename3'} = $screenviewfilename;
-
-	# make the screenview image
-	my $command = "convert  -verbose -geometry $screenviewsize" 
-	    . "x$screenviewsize \"$filename\" \"$screenviewfilename\"";
-	print $outhandle "SCREENVIEW: $command\n" if ($verbosity > 2);
-	my $result = "";
-	$result = `$command  2>&1` ;
-	print $outhandle "SCREENVIEW RESULT: $result\n" if ($verbosity > 3);
-
-	# get screenview dimensions, size and type
-        if ($result =~ m/[0-9]+x[0-9]+=>([0-9]+)x([0-9]+)/) {
-	    $doc_obj->add_metadata ($section, "ScreenWidth", $1);
-	    $doc_obj->add_metadata ($section, "ScreenHeight", $2);
-	}elsif ($result =~ m/([0-9]+)x([0-9]+)/) {
-	    #if the image hasn't changed size,  the previous regex doesn't match
-	    $doc_obj->add_metadata ($section, "ScreenWidth", $1);
-	    $doc_obj->add_metadata ($section, "ScreenHeight", $2);
-	}
-    
-	#add the screenview as an associated file ...
-	if (-e "$screenviewfilename") { 
-	    $doc_obj->associate_file("$screenviewfilename", $id."sv.$screenviewtype",
-				     "image/$screenviewtype",$section);
-	    print $outhandle "associating screen file $screenviewfilename as name $id sv.$screenviewtype\n" if ($verbosity > 2);
-	    
-	    $doc_obj->add_metadata ($section, "ScreenType", $screenviewtype);
-	    $doc_obj->add_metadata ($section, "Screen", $id."sv.$screenviewtype");
-
-	    if ($top) {
-		$doc_obj->add_metadata ($section, "screenicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Screen]\" width=[ScreenWidth] height=[ScreenHeight]>");
-	    } else {
-		$doc_obj->add_metadata ($section, "screenicon", "<img src=\"_httpprefix_/collect/[collection]/index/assoc/[parent(Top):assocfilepath]/[Screen]\" width=[ScreenWidth] height=[ScreenHeight]>");
-
-	    }
-	} else {
-	    print $outhandle "PagedImgPlug: couldn't find \"$screenviewfilename\"\n";
-	}
-    }
-
-    return $type;
-
-
-}
-
-
-
-# Discover the characteristics of an image file with the ImageMagick
-# "identify" command.
-
-sub identify { 
-    my ($image, $outhandle, $verbosity) = @_;
-
-    # Use the ImageMagick "identify" command to get the file specs
-    my $command = "identify \"$image\" 2>&1";
-    print $outhandle "$command\n" if ($verbosity > 2);
-    my $result = '';
-    $result = `$command`;
-    print $outhandle "$result\n" if ($verbosity > 3);
-
-    # Read the type, width, and height
-    my $type =   'unknown';
-    my $width =  'unknown';
-    my $height = 'unknown';
-
-    my $image_safe = quotemeta $image;
-    if ($result =~ /^$image_safe (\w+) (\d+)x(\d+)/) {
-	$type = $1;
-	$width = $2;
-	$height = $3;
-    }
-	
-    # Read the size
-    my $size = "unknown";
-    if ($result =~ m/^.* ([0-9]+)b/) {
-	$size = $1;
-    } elsif ($result =~ m/^.* ([0-9]+)kb/) {
-	$size = 1024 * $1;
-    }
-
-    print $outhandle "file: $image:\t $type, $width, $height, $size\n" 
-	if ($verbosity > 3);
-
-    # Return the specs
-    return ($type, $width, $height, $size);
-}
-
-
-# The PagedImgPlug read() function. This function does all the right things
-# to make general options work for a given plugin. It calls the process()
-# function which does all the work specific to a plugin (like the old
-# read functions used to do). Most plugins should define their own 
-# process() function and let this read() function keep control.
-#
-# PagedImgPlug overrides read() because there is no need to read the actual 
-# text of the file in, because the contents of the file is not text...
-#
-# Return number of files processed, undef if can't process
-# Note that $base_dir might be "" and that $file might 
-# include directories
-
-sub read_into_doc_obj {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-    my $outhandle   = $self->{'outhandle'};
-    
-    #check process and block exps, smart block, etc
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-    
-    print $outhandle "PagedImgPlug processing \"$filename\"\n"
-	if $self->{'verbosity'} > 1;
-    print STDERR "<Processing n='$file' p='PagedImgPlug'>\n" if ($gli);
-    
-    # here we need to decide if we have an old text .item file, or a new xml 
-    # .item file - for now the test is if the first non-empty line is 
-    # <PagedDocument> then its xml
-    my $xml_version = 0;
-    open (ITEMFILE, $filename) || die "couldn't open $filename\n";
-    
-    my $backup_filename = "backup.item";
-    open (BACKUP,">$backup_filename")|| die "couldn't write to $backup_filename\n";
-    my $line = "";
-    my $num = 0;
-    $line = <ITEMFILE>;
-    while ($line !~ /\w/) {
-	$line = <ITEMFILE>;
-    }
-    chomp $line;
-    if ($line =~ /<PagedDocument/) {
-	$xml_version = 1;
-    }
-    close ITEMFILE;
-    open (ITEMFILE, $filename) || die "couldn't open $filename\n";
-    $line = <ITEMFILE>;
-    $line =~ s/^\xEF\xBB\xBF//; # strip BOM
-    $line =~ s/\x0B+//ig;
-    $line =~ s/&/&amp;/g;
-    print BACKUP ($line);
-    #Tidy up the item file some metadata title contains \vt-vertical tab
-    while ($line = <ITEMFILE>) {
-	$line =~ s/\x0B+//ig;
-	$line =~ s/&/&amp;/g;
-	print BACKUP ($line);
-    }
-    close ITEMFILE;
-    close BACKUP;
-    &File::Copy::copy ($backup_filename, $filename);
-    &util::rm($backup_filename);
-
-    my $doc_obj;
-    if ($xml_version) {
-	$file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
-	$self->{'file'} = $file;
-	$self->{'filename'} = $filename;
-	$self->{'processor'} = $processor;
-	$self->{'metadata'} = $metadata;
-
-	eval {
-	    $@ = "";
-	    my $xslt = $self->{'xslt'};
-	    if (defined $xslt && ($xslt ne "")) {
-		# perform xslt
-		my $transformed_xml = $self->apply_xslt($xslt,$filename);
-		
-		# feed transformed file (now in memory as string) into XML parser
-		#$self->{'parser'}->parse($transformed_xml);
-		$self->parse_string($transformed_xml);
-	    }
-	    else {
-		#$self->{'parser'}->parsefile($filename);
-		$self->parse_file($filename);
-	    }
-	};
-	
-	
-	
-	if ($@) {
-	    
-	    # parsefile may either croak somewhere in XML::Parser (e.g. because
-	    # the document is not well formed) or die somewhere in XMLPlug or a
-	    # derived plugin (e.g. because we're attempting to process a
-	    # document whose DOCTYPE is not meant for this plugin). For the
-	    # first case we'll print a warning and continue, for the second
-	    # we'll just continue quietly
-	    
-	    print STDERR "**** XML Parse Error is: $@\n";
-	    
-	    my ($msg) = $@ =~ /Carp::croak\(\'(.*?)\'\)/;
-	    if (defined $msg) {	
-		my $outhandle = $self->{'outhandle'};
-		my $plugin_name = ref ($self);
-		print $outhandle "$plugin_name failed to process $file ($msg)\n";
-	    }
-
-	    # reset ourself for the next document
-	    $self->{'section_level'}=0;
-	    print STDERR "<ProcessingError n='$file'>\n" if ($gli);
-	    return -1; # error during processing
-	}
-	$doc_obj = $self->{'doc_obj'};
-    } else {
-	my ($dir);
-	($dir, $file) = $filename =~ /^(.*?)([^\/\\]*)$/;
-
-	#process the .item file
-	$doc_obj = $self->process_item($filename, $dir, $file, $processor);
-	
-    }
-    
-    if ($self->{'cover_image'}) {
-	$self->associate_cover_image($doc_obj, $filename);
-    }
-
-    # include any metadata passed in from previous plugins 
-    # note that this metadata is associated with the top level section
-    my $section = $doc_obj->get_top_section();
-    $self->extra_metadata ($doc_obj, $section, $metadata);
-    #my $text="";
-    # do plugin specific processing of doc_obj
-    #unless (defined ($self->process(\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj))) {
-	#print STDERR "<ProcessingError n='$file'>\n" if ($gli);
-	#return -1;
-    #}
-    # do any automatic metadata extraction
-    $self->auto_extract_metadata ($doc_obj);
-
-    $self->{'num_processed'}++;
-    return (1,$doc_obj);
-}
-
-sub read
-{
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;    my ($process_status,$doc_obj) = $self->read_into_doc_obj(@_);
-
-    if ((defined $process_status) && ($process_status == 1)) {
-	# process the document
-	$processor->process($doc_obj);
-
-	#if(defined($self->{'places_filename'})){
-	#    &util::rm($self->{'places_filename'});
-	#    $self->{'places_filename'} = undef;
-	#}
-	#$self->{'num_processed'} ++;
-	undef $doc_obj; 
-    }
-    
-    # clean up temporary files - we do this here instead of in  
-    # process_image becuase associated files aren't actually copied 
-    # until after process has been run.
-    if (defined $self->{'tmp_filename1'} && 
-	-e $self->{'tmp_filename1'}) {
-	&util::rm($self->{'tmp_filename1'})
-    }
-    if (defined $self->{'tmp_filename2'} && 
-	-e $self->{'tmp_filename2'}) {
-	&util::rm($self->{'tmp_filename2'})
-    }
-    if (defined $self->{'tmp_filename3'} && 
-	-e $self->{'tmp_filename3'}) {
-      &util::rm($self->{'tmp_filename3'})
-    }
-    # if process_status == 1, then the file has been processed.
-    return $process_status;
-}
-
-sub xml_start_tag {
-    my $self = shift(@_);
-    my ($expat, $element) = @_;
-    $self->{'element'} = $element;
-    
-    my $doc_obj = $self->{'doc_obj'};
-    if ($element eq "PagedDocument") {
-	$self->{'current_section'} = $doc_obj->get_top_section();
-    } elsif ($element eq "PageGroup" || $element eq "Page") {
-	# create a new section as a child
-	$self->{'current_section'} = $doc_obj->insert_section($doc_obj->get_end_child($self->{'current_section'}));
-	$self->{'num_pages'}++;
-	# assign pagenum as  what??
-	my $pagenum = $_{'pagenum'}; #TODO!!
-	if (defined $pagenum) {
-	    $doc_obj->set_utf8_metadata_element($self->{'current_section'}, 'PageNum', $pagenum);
-	}
-	my ($imgfile) = $_{'imgfile'};
-	if (defined $imgfile) {
-	    $self->process_image($self->{'base_dir'}.$imgfile, $imgfile, $doc_obj, $self->{'current_section'});
-	}
-	my ($txtfile) = $_{'txtfile'};
-	if (defined($txtfile)&& $txtfile ne "") {
-	    $self->process_text ($self->{'base_dir'}.$txtfile, $txtfile, $doc_obj, $self->{'current_section'});
-            $doc_obj->set_metadata_element($self->{'current_section'},"NoText","0");
-	} else {
-	    # otherwise add in some dummy text
-	    #create an empty text string so we don't break downstream plugins 
-	    my $text = &gsprintf::lookup_string("{BasPlug.dummy_text}",1);
-	    $doc_obj->add_utf8_text($self->{'current_section'}, $text);
-            $doc_obj->add_metadata($self->{'current_section'},"NoText","1"); 
-	}
-    } elsif ($element eq "Metadata") {
-	$self->{'metadata_name'} = $_{'name'};
-    }
-}
-
-sub xml_end_tag {
-    my $self = shift(@_);
-    my ($expat, $element) = @_;
-    
-    my $doc_obj = $self->{'doc_obj'};
-    if ($element eq "Page" || $element eq "PageGroup") {
-	# if Title hasn't been assigned, set PageNum as Title
-	if (!defined $doc_obj->get_metadata_element ($self->{'current_section'}, "Title") && defined $doc_obj->get_metadata_element ($self->{'current_section'}, "PageNum" )) {
-	    $doc_obj->add_utf8_metadata ($self->{'current_section'}, "Title", $doc_obj->get_metadata_element ($self->{'current_section'}, "PageNum" ));
-	}
-	# move the current section back to the parent
-	$self->{'current_section'} = $doc_obj->get_parent_section($self->{'current_section'});
-    } elsif ($element eq "Metadata") {
-	
-	$doc_obj->add_utf8_metadata ($self->{'current_section'}, $self->{'metadata_name'}, $self->{'metadata_value'});
-	$self->{'metadata_name'} = "";
-	$self->{'metadata_value'} = "";
-
-    }
-    # otherwise we ignore the end tag
-}
-
-
-sub xml_text {
-    my $self = shift(@_);
-    my ($expat) = @_; 
-
-    if ($self->{'element'} eq "Metadata" && $self->{'metadata_name'}) {
-   	$self->{'metadata_value'} .= $_;
-    }
-}
-
-sub xml_doctype {
-}
-
-sub open_document {
-    my $self = shift(@_);
-    
-    # create a new document
-    $self->{'doc_obj'} = new doc ($self->{'filename'}, "indexed_doc");
-    my $doc_obj = $self->{'doc_obj'};
-    $doc_obj->set_OIDtype ($self->{'processor'}->{'OIDtype'});
-    my ($dir, $file) = $self->{'filename'} =~ /^(.*?)([^\/\\]*)$/;
-    $self->{'base_dir'} = $dir;
-    $self->{'num_pages'} = 0;
-    my $topsection = $doc_obj->get_top_section();
-    if ($self->{'documenttype'} eq 'paged') {
-	# set the gsdlthistype metadata to Paged - this ensures this document will
-	# be treated as a Paged doc, even if Titles are not numeric
-    
-	$doc_obj->set_utf8_metadata_element ($topsection, "gsdlthistype", "Paged");
-    } else {
-	$doc_obj->set_utf8_metadata_element ($topsection, "gsdlthistype", "Hierarchy");
-    }
-
-    $doc_obj->add_metadata ($topsection, "Source", $file);
-    if ($self->{'headerpage'}) {
-	$doc_obj->add_text($topsection, &gsprintf::lookup_string("{BasPlug.dummy_text}"));
-    }
-
-}
-
-sub close_document {
-    my $self = shift(@_);
-    my $doc_obj = $self->{'doc_obj'};
-        
-    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
-    $doc_obj->add_metadata($doc_obj->get_top_section(), "FileFormat", "PagedImg");
-    
-    # add numpages metadata
-    $doc_obj->set_utf8_metadata_element ($doc_obj->get_top_section(), 'NumPages', $self->{'num_pages'});
-
-    # add an OID
-    $doc_obj->set_OID();
-    
-}
-
-sub process_item {
-    my $self = shift (@_);
-    my ($filename, $dir, $file, $processor) = @_;
-
-    my $doc_obj = new doc ($filename, "indexed_doc");
-    $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
-    my $topsection = $doc_obj->get_top_section();
-    $doc_obj->add_utf8_metadata($topsection, "Plugin", "$self->{'plugin_type'}");
-    $doc_obj->add_metadata($topsection, "FileFormat", "PagedImg");
-
-    if ($self->{'documenttype'} eq 'paged') {
-	# set the gsdlthistype metadata to Paged - this ensures this document will
-	# be treated as a Paged doc, even if Titles are not numeric
-	$doc_obj->set_utf8_metadata_element ($topsection, "gsdlthistype", "Paged");
-    } else {
-	$doc_obj->set_utf8_metadata_element ($topsection, "gsdlthistype", "Hierarchy");
-    }
-
-    $doc_obj->add_metadata ($topsection, "Source", $file);
-
-    open (ITEMFILE, $filename) || die "couldn't open $filename\n";
-    my $line = "";
-    my $num = 0;
-    while (defined ($line = <ITEMFILE>)) {
-	next unless $line =~ /\w/;
-	chomp $line;
-	next if $line =~ /^#/; # ignore comment lines
-	if ($line =~ /^<([^>]*)>\s*(.*?)\s*$/) {
-	    $doc_obj->set_utf8_metadata_element ($topsection, $1, $2);
-	    #$meta->{$1} = $2;
-	} else {
-	    $num++;
-	    # line should be like page:imagefilename:textfilename:r - the r is optional -> means rotate the image 180 deg
-	    $line =~ s/^\s+//; #remove space at the front
-	    $line =~ s/\s+$//; #remove space at the end
-	    my ($pagenum, $imgname, $txtname, $rotate) = split /:/, $line;
-	    
-	    # create a new section for each image file
-	    my $cursection = $doc_obj->insert_section($doc_obj->get_end_child($topsection));
-	    # the page number becomes the Title
-	    $doc_obj->set_utf8_metadata_element($cursection, 'Title', $pagenum);
-	 
-	    # process the image for this page if there is one
-	    if (defined $imgname && $imgname ne "") {
-		my $result1 = $self->process_image($dir.$imgname, $imgname, $doc_obj, $cursection, $rotate);
-		
-		if (!defined $result1)
-		{
-		    print "PagedImgPlug: couldn't process image \"$dir.$imgname\" for item \"$filename\"\n";
-		}
-	    }
-	    # process the text file if one is there
-	    if (defined $txtname && $txtname ne "") {
-		my $result2 = $self->process_text ($dir.$txtname, $txtname, $doc_obj, $cursection);
-               
-		if (!defined $result2) {
-		    print "PagedImgPlug: couldn't process text file \"$dir.$txtname\" for item \"$filename\"\n";
-		}
-                else{
-		    $doc_obj->set_metadata_element($cursection, "NoText", "0");
-		}
-	    } else {
-		# otherwise add in some dummy text 
-		$doc_obj->add_text($cursection, &gsprintf::lookup_string("{BasPlug.dummy_text}"));
-                 # add NoText metadata which can be used to suppress the dummy text
-	     }
-	}
-    }
-    
-    close ITEMFILE;
-
-    # if we want a header page, we need to add some text into the top section, otherwise this section will become invisible
-    if ($self->{'headerpage'}) {
-	$doc_obj->add_text($topsection, &gsprintf::lookup_string("{BasPlug.dummy_text}"));
-    }
-    $file =~ s/\.item//i;
-    $doc_obj->set_OID ();
-    # add numpages metadata
-    $doc_obj->set_utf8_metadata_element ($topsection, 'NumPages', "$num");
-    return $doc_obj;
-}
-
-sub process_text {
-    my $self = shift (@_);
-    my ($fullpath, $file, $doc_obj, $cursection) = @_;
-    
-    # check that the text file exists!!
-    if (!-f $fullpath) {
-	print "PagedImgPlug: ERROR: File $fullpath does not exist, skipping\n";
-	return 0;
-    }
-
-    # Do encoding stuff
-    my ($language, $encoding) = $self->textcat_get_language_encoding ($fullpath);
-
-    my $text="";
-    &BasPlug::read_file($self, $fullpath, $encoding, $language, \$text);
-    if (!length ($text)) {
-	# It's a bit unusual but not out of the question to have no text, so just give a warning
-        print "PagedImgPlug: WARNING: $fullpath contains no text\n";
-    }
-
-    # we need to escape the escape character, or else mg will convert into
-    # eg literal newlines, instead of leaving the text as '\n'
-    $text =~ s/\\/\\\\/g; # macro language
-    $text =~ s/_/\\_/g; # macro language
-
-
-    if ($text =~ m/<html.*?>\s*<head.*?>.*<\/head>\s*<body.*?>(.*)<\/body>\s*<\/html>\s*$/s) {
-	# looks like HTML input
-	# no need to escape < and > or put in <pre> tags
-
-	$text = $1;
-
-	# insert preformat tags and add text to document object
-	$doc_obj->add_utf8_text($cursection, "$text");
-    }
-    else {
-	$text =~ s/</&lt;/g;
-	$text =~ s/>/&gt;/g;
-
-	# insert preformat tags and add text to document object
-	$doc_obj->add_utf8_text($cursection, "<pre>\n$text\n</pre>");
-    }
-
-    
-    return 1;
-}
-
-# do plugin specific processing of doc_obj
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
-    my $outhandle = $self->{'outhandle'};
-    
-    return 1;
-}
-
-1;
Index: dl/trunk/perllib/plugins/ProCitePlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ProCitePlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,241 +1,0 @@
-###########################################################################
-#
-# ProCitePlug.pm -- A plugin for (exported) ProCite databases
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright 1999-2004 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 ProCitePlug;
-
-
-use multiread;
-use SplitPlug;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-# ProCitePlug is a sub-class of SplitPlug
-sub BEGIN {
-    @ProCitePlug::ISA = ('SplitPlug');
-}
-
-
-my $arguments = 
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_process_exp() },
-      { 'name' => "split_exp",
-	'desc' => "{SplitPlug.split_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_split_exp(),
-	'reqd' => "no" }
-      ];
-
-my $options = { 'name'     => "ProCitePlug",
-		'desc'     => "{ProCitePlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'explodes' => "yes",
-		'args'     => $arguments };
-
-
-# This plugin processes exported ProCite files with the suffix ".txt"
-sub get_default_process_exp
-{
-    return q^(?i)(\.txt)$^;
-}
-
-
-# This plugin splits the input text at every line
-sub get_default_split_exp
-{
-    return q^\n^;
-}
-
-
-sub new
-{
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new SplitPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-
-my %crazy_workform_mapping =
-    ( "A", "Book, Long Form",
-      "B", "Book, Short Form",
-      "C", "Journal, Long Form",
-      "D", "Journal, Short Form",
-      "E", "Report",
-      "F", "Newspaper",
-      "G", "Dissertation",
-      "H", "Trade Catalog",
-      "I", "Letter (Correspondence)",
-      "J", "Manuscript",
-      "K", "Conference Proceedings",
-      "L", "Map",
-      "M", "Music Score",
-      "N", "Sound Recording",
-      "O", "Motion Picture",
-      "P", "Audiovisual Material",
-      "Q", "Video Recording",
-      "R", "Art Work",
-      "S", "Computer Program",
-      "T", "Data File" );
-
-
-sub read_file
-{
-    my $self = shift (@_);
-    my ($filename, $encoding, $language, $textref) = @_;
-    
-    # Store the workform definitions for this file
-    my %workform_definitions = ();
-
-    # Read the contents of the file into $textref
-    open(PROCITE_FILE, "<$filename");
-    my $reader = new multiread();
-    $reader->set_handle ('ProCitePlug::PROCITE_FILE');
-    $reader->set_encoding ($encoding);
-    $reader->read_file ($textref);
-    close(PROCITE_FILE);
-
-    # Read the workform definitions at the start of the file
-    while ($$textref =~ /^\<Workform Definition\>/) {
-	# Remove the workform definition line so it is not processed later as a record
-	$$textref =~ s/^\<Workform Definition\>(.*)\n//;
-	my $workform_definition = $1;
-	# Parse the workform definitions and store them for later
-	$workform_definition =~ s/^\"([^\"]*)\",//;
-	my $workform_name = $1;
-	my @workform_values;
-	while ($workform_definition !~ /^\s*$/) {
-	    $workform_definition =~ s/^\"([^\"]*)\",?//;
-	    my $workform_field = $1;
-	    push(@workform_values, $workform_field);
-	}
-
-	# Remember this workform definition for when we're reading the records
-	$workform_definitions{$workform_name} = \@workform_values;
-    }
-
-    $self->{'workform_definitions'}->{$filename} = \%workform_definitions;
-}
-
-
-sub process
-{
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-    my $filename = &util::filename_cat($base_dir, $file);
-    my $cursection = $doc_obj->get_top_section();
-    # Report that we're processing the file
-    print STDERR "<Processing n='$file' p='ProCitePlug'>\n" if ($gli);
-    print $outhandle "ProCitePlug: processing $file\n"
-  	if ($self->{'verbosity'}) > 1;
-
-    # Build up an HTML view of the record for easy display at run-time
-    my $html_record = "<table>";
-
-    # Read the record's workform indicator and record number
-    $$textref =~ s/^\"([^\"]*)\",\"([^\"]*)\",//;
-    my $workform_indicator = $1;
-    my $recordnum = $2;
-
-    # If necessary, map the workform indicator into something useful
-    if ($crazy_workform_mapping{$workform_indicator}) {
-	$workform_indicator = $crazy_workform_mapping{$workform_indicator};
-    }
-
-    # Check we know about the workform of this record
-    my %workform_definitions = %{$self->{'workform_definitions'}->{$filename}};
-    if (!$workform_definitions{$workform_indicator}) {
-	print STDERR "Unknown workform $workform_indicator!\n";
-	return 0;
-    }
-
-    # Store the full record as the document text
-    $doc_obj->add_utf8_text($cursection, $$textref);
-
-    # Store workform and record number as metadata
-    $doc_obj->add_utf8_metadata($cursection, "pc.Workform", $workform_indicator);
-    $doc_obj->add_utf8_metadata($cursection, "pc.RecordNumber", $recordnum);
-    
-    # Store FileFormat metadata
-    $doc_obj->add_metadata($cursection, "FileFormat", "ProCite");
-
-    $html_record .= "<tr><td valign=top><b>Record Number: </b></td><td valign=top>$recordnum</td></tr>";
-
-    my @workform_values = @{$workform_definitions{$workform_indicator}};
-
-    # Read each field (surrounded by quotes) of the record
-    my $fieldnum = 0;
-    while ($$textref !~ /^\s*$/) {
-	$$textref =~ s/^\"([^\"]*)\",?//;
-	my $field_value_raw = $1;
-
-	# Add non-empty metadata values to the document
-	unless ($field_value_raw eq "") {
-	    # Add the display name of the metadata field for format statement convenience
-	    my $field_name = $workform_values[$fieldnum];
-	    unless ($field_name eq "---") {
-		my $meta_name = "pc.Field" . ($fieldnum + 1) . "Name";
-		$doc_obj->add_utf8_metadata($cursection, $meta_name, $field_name);
-	    }
-
-	    $html_record .= "<tr><td valign=top><b>$field_name: </b></td><td valign=top>";
-
-	    # Multiple metadata values are separated with "//"
-	    foreach my $field_value (split(/\/\//, $field_value_raw)) {
-		my $meta_name = "pc.Field" . ($fieldnum + 1) . "Value";
-		$doc_obj->add_utf8_metadata($cursection, $meta_name, $field_value);
-
-		$html_record .= $field_value . "<br>";
-	    }
-
-	    $html_record .= "</td></tr>";
-	}
-
-	$fieldnum++;
-    }
-
-    $html_record .= "</table>";
-    # Store HTML view of record as metadata
-    $doc_obj->add_utf8_metadata($cursection, "HTMLDisplay", $html_record);
-
-    # Record was processed successfully
-    return 1;
-}
-
-
-1;
Index: /gsdl/trunk/perllib/plugins/ProCitePlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ProCitePlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/ProCitePlugin.pm	(revision 15865)
@@ -0,0 +1,241 @@
+###########################################################################
+#
+# ProCitePlug.pm -- A plugin for (exported) ProCite databases
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright 1999-2004 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 ProCitePlug;
+
+
+use multiread;
+use SplitPlug;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+# ProCitePlug is a sub-class of SplitPlug
+sub BEGIN {
+    @ProCitePlug::ISA = ('SplitPlug');
+}
+
+
+my $arguments = 
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_process_exp() },
+      { 'name' => "split_exp",
+	'desc' => "{SplitPlug.split_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_split_exp(),
+	'reqd' => "no" }
+      ];
+
+my $options = { 'name'     => "ProCitePlug",
+		'desc'     => "{ProCitePlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'explodes' => "yes",
+		'args'     => $arguments };
+
+
+# This plugin processes exported ProCite files with the suffix ".txt"
+sub get_default_process_exp
+{
+    return q^(?i)(\.txt)$^;
+}
+
+
+# This plugin splits the input text at every line
+sub get_default_split_exp
+{
+    return q^\n^;
+}
+
+
+sub new
+{
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new SplitPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+
+my %crazy_workform_mapping =
+    ( "A", "Book, Long Form",
+      "B", "Book, Short Form",
+      "C", "Journal, Long Form",
+      "D", "Journal, Short Form",
+      "E", "Report",
+      "F", "Newspaper",
+      "G", "Dissertation",
+      "H", "Trade Catalog",
+      "I", "Letter (Correspondence)",
+      "J", "Manuscript",
+      "K", "Conference Proceedings",
+      "L", "Map",
+      "M", "Music Score",
+      "N", "Sound Recording",
+      "O", "Motion Picture",
+      "P", "Audiovisual Material",
+      "Q", "Video Recording",
+      "R", "Art Work",
+      "S", "Computer Program",
+      "T", "Data File" );
+
+
+sub read_file
+{
+    my $self = shift (@_);
+    my ($filename, $encoding, $language, $textref) = @_;
+    
+    # Store the workform definitions for this file
+    my %workform_definitions = ();
+
+    # Read the contents of the file into $textref
+    open(PROCITE_FILE, "<$filename");
+    my $reader = new multiread();
+    $reader->set_handle ('ProCitePlug::PROCITE_FILE');
+    $reader->set_encoding ($encoding);
+    $reader->read_file ($textref);
+    close(PROCITE_FILE);
+
+    # Read the workform definitions at the start of the file
+    while ($$textref =~ /^\<Workform Definition\>/) {
+	# Remove the workform definition line so it is not processed later as a record
+	$$textref =~ s/^\<Workform Definition\>(.*)\n//;
+	my $workform_definition = $1;
+	# Parse the workform definitions and store them for later
+	$workform_definition =~ s/^\"([^\"]*)\",//;
+	my $workform_name = $1;
+	my @workform_values;
+	while ($workform_definition !~ /^\s*$/) {
+	    $workform_definition =~ s/^\"([^\"]*)\",?//;
+	    my $workform_field = $1;
+	    push(@workform_values, $workform_field);
+	}
+
+	# Remember this workform definition for when we're reading the records
+	$workform_definitions{$workform_name} = \@workform_values;
+    }
+
+    $self->{'workform_definitions'}->{$filename} = \%workform_definitions;
+}
+
+
+sub process
+{
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+    my $filename = &util::filename_cat($base_dir, $file);
+    my $cursection = $doc_obj->get_top_section();
+    # Report that we're processing the file
+    print STDERR "<Processing n='$file' p='ProCitePlug'>\n" if ($gli);
+    print $outhandle "ProCitePlug: processing $file\n"
+  	if ($self->{'verbosity'}) > 1;
+
+    # Build up an HTML view of the record for easy display at run-time
+    my $html_record = "<table>";
+
+    # Read the record's workform indicator and record number
+    $$textref =~ s/^\"([^\"]*)\",\"([^\"]*)\",//;
+    my $workform_indicator = $1;
+    my $recordnum = $2;
+
+    # If necessary, map the workform indicator into something useful
+    if ($crazy_workform_mapping{$workform_indicator}) {
+	$workform_indicator = $crazy_workform_mapping{$workform_indicator};
+    }
+
+    # Check we know about the workform of this record
+    my %workform_definitions = %{$self->{'workform_definitions'}->{$filename}};
+    if (!$workform_definitions{$workform_indicator}) {
+	print STDERR "Unknown workform $workform_indicator!\n";
+	return 0;
+    }
+
+    # Store the full record as the document text
+    $doc_obj->add_utf8_text($cursection, $$textref);
+
+    # Store workform and record number as metadata
+    $doc_obj->add_utf8_metadata($cursection, "pc.Workform", $workform_indicator);
+    $doc_obj->add_utf8_metadata($cursection, "pc.RecordNumber", $recordnum);
+    
+    # Store FileFormat metadata
+    $doc_obj->add_metadata($cursection, "FileFormat", "ProCite");
+
+    $html_record .= "<tr><td valign=top><b>Record Number: </b></td><td valign=top>$recordnum</td></tr>";
+
+    my @workform_values = @{$workform_definitions{$workform_indicator}};
+
+    # Read each field (surrounded by quotes) of the record
+    my $fieldnum = 0;
+    while ($$textref !~ /^\s*$/) {
+	$$textref =~ s/^\"([^\"]*)\",?//;
+	my $field_value_raw = $1;
+
+	# Add non-empty metadata values to the document
+	unless ($field_value_raw eq "") {
+	    # Add the display name of the metadata field for format statement convenience
+	    my $field_name = $workform_values[$fieldnum];
+	    unless ($field_name eq "---") {
+		my $meta_name = "pc.Field" . ($fieldnum + 1) . "Name";
+		$doc_obj->add_utf8_metadata($cursection, $meta_name, $field_name);
+	    }
+
+	    $html_record .= "<tr><td valign=top><b>$field_name: </b></td><td valign=top>";
+
+	    # Multiple metadata values are separated with "//"
+	    foreach my $field_value (split(/\/\//, $field_value_raw)) {
+		my $meta_name = "pc.Field" . ($fieldnum + 1) . "Value";
+		$doc_obj->add_utf8_metadata($cursection, $meta_name, $field_value);
+
+		$html_record .= $field_value . "<br>";
+	    }
+
+	    $html_record .= "</td></tr>";
+	}
+
+	$fieldnum++;
+    }
+
+    $html_record .= "</table>";
+    # Store HTML view of record as metadata
+    $doc_obj->add_utf8_metadata($cursection, "HTMLDisplay", $html_record);
+
+    # Record was processed successfully
+    return 1;
+}
+
+
+1;
Index: dl/trunk/perllib/plugins/RTFPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/RTFPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,108 +1,0 @@
-###########################################################################
-#
-# RTFPlug.pm -- plugin for importing Rich Text Format files.
-#
-# 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.
-#
-###########################################################################
-
-# 12/05/02 Added usage datastructure - John Thompson
-
-package RTFPlug;
-
-use ConvertToPlug;
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @RTFPlug::ISA = ('ConvertToPlug');
-}
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" },
-      { 'name' => "description_tags",
-	'desc' => "{HTMLPlug.description_tags}",
-	'type' => "flag" }
-];
-
-my $options = { 'name'     => "RTFPlug",
-		'desc'     => "{RTFPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'srcreplaceable' => "yes", # Source docs in rtf can be replaced with GS-generated html
-		'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
- 
-    my $self = new ConvertToPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    if ($self->{'info_only'}) {
-	# don't worry about any options etc
-	return bless $self, $class;
-    }
-
-    my $secondary_plugin_options = $self->{'secondary_plugin_options'};
-    if (!defined $secondary_plugin_options->{'TEXTPlug'}) {
-	$secondary_plugin_options->{'TEXTPlug'} = [];
-    }
-    if (!defined $secondary_plugin_options->{'HTMLPlug'}) {
-	$secondary_plugin_options->{'HTMLPlug'} = [];
-    }
-    my $text_options = $secondary_plugin_options->{'TEXTPlug'};
-    my $html_options = $secondary_plugin_options->{'HTMLPlug'};
-    
-    #$self->{'input_encoding'} = "utf8";
-    #$self->{'extract_language'} = 1;
-    push(@$text_options, "-input_encoding", "utf8");
-    push(@$text_options,"-extract_language") if $self->{'extract_language'};
-    push(@$html_options, "-description_tags") if $self->{'description_tags'};
-    push(@$html_options,"-extract_language") if $self->{'extract_language'};
-
-    $self = bless $self, $class;
-
-    $self->load_secondary_plugins($class,$secondary_plugin_options, $hashArgOptLists);
-
-    return $self;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-    return q^(?i)\.rtf$^;
-}
-    
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-
-    return $self->process_type("rtf",$base_dir,$file,$doc_obj);
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/RTFPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/RTFPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/RTFPlugin.pm	(revision 15865)
@@ -0,0 +1,108 @@
+###########################################################################
+#
+# RTFPlug.pm -- plugin for importing Rich Text Format files.
+#
+# 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.
+#
+###########################################################################
+
+# 12/05/02 Added usage datastructure - John Thompson
+
+package RTFPlug;
+
+use ConvertToPlug;
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @RTFPlug::ISA = ('ConvertToPlug');
+}
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" },
+      { 'name' => "description_tags",
+	'desc' => "{HTMLPlug.description_tags}",
+	'type' => "flag" }
+];
+
+my $options = { 'name'     => "RTFPlug",
+		'desc'     => "{RTFPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'srcreplaceable' => "yes", # Source docs in rtf can be replaced with GS-generated html
+		'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+ 
+    my $self = new ConvertToPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    if ($self->{'info_only'}) {
+	# don't worry about any options etc
+	return bless $self, $class;
+    }
+
+    my $secondary_plugin_options = $self->{'secondary_plugin_options'};
+    if (!defined $secondary_plugin_options->{'TEXTPlug'}) {
+	$secondary_plugin_options->{'TEXTPlug'} = [];
+    }
+    if (!defined $secondary_plugin_options->{'HTMLPlug'}) {
+	$secondary_plugin_options->{'HTMLPlug'} = [];
+    }
+    my $text_options = $secondary_plugin_options->{'TEXTPlug'};
+    my $html_options = $secondary_plugin_options->{'HTMLPlug'};
+    
+    #$self->{'input_encoding'} = "utf8";
+    #$self->{'extract_language'} = 1;
+    push(@$text_options, "-input_encoding", "utf8");
+    push(@$text_options,"-extract_language") if $self->{'extract_language'};
+    push(@$html_options, "-description_tags") if $self->{'description_tags'};
+    push(@$html_options,"-extract_language") if $self->{'extract_language'};
+
+    $self = bless $self, $class;
+
+    $self->load_secondary_plugins($class,$secondary_plugin_options, $hashArgOptLists);
+
+    return $self;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+    return q^(?i)\.rtf$^;
+}
+    
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+
+    return $self->process_type("rtf",$base_dir,$file,$doc_obj);
+}
+
+1;
Index: /gsdl/trunk/perllib/plugins/ReadXMLFile.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ReadXMLFile.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/ReadXMLFile.pm	(revision 15865)
@@ -0,0 +1,427 @@
+###########################################################################
+#
+# XMLPlug.pm -- base class for XML plugins
+# 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.
+#
+###########################################################################
+
+package XMLPlug;
+
+use BasPlug;
+use doc;
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @XMLPlug::ISA = ('BasPlug');
+    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
+}
+
+use XMLParser;
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" },
+      { 'name' => "xslt",
+	'desc' => "{XMLPlug.xslt}",
+	'type' => "string",
+	'deft' => "",
+	'reqd' => "no" } ];
+
+my $options = { 'name'     => "XMLPlug",
+		'desc'     => "{XMLPlug.desc}",
+		'abstract' => "yes",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+    
+    # $self is global for use within subroutines called by XML::Parser
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    if ($self->{'info_only'}) {
+	# don't worry about any options etc
+	return bless $self, $class;
+    }
+
+    my $parser = new XML::Parser('Style' => 'Stream',
+                                 'Pkg' => 'XMLPlug',
+                                 'PluginObj' => $self,
+				 'Handlers' => {'Char' => \&Char,
+						'XMLDecl' => \&XMLDecl,
+						'Entity' => \&Entity,
+						'Doctype' => \&Doctype,
+						'Default' => \&Default,
+                                 });
+
+    $self->{'parser'} = $parser;
+
+    return bless $self, $class;
+}
+
+# the inheriting class must implement this method to tell whether to parse this doc type
+sub get_doctype {
+    my $self = shift(@_);
+    die "$self The inheriting class must implement get_doctype method";
+}
+
+
+sub apply_xslt
+{
+    my $self = shift @_;
+    my ($xslt,$filename) = @_;
+    
+    my $outhandle = $self->{'outhandle'};
+
+    my $xslt_filename = $xslt;
+
+    if (! -e $xslt_filename) {
+	# Look in main site directory
+	my $gsdlhome = $ENV{'GSDLHOME'};
+	$xslt_filename = &util::filename_cat($gsdlhome,$xslt);
+    }
+
+    if (! -e $xslt_filename) {
+	# Look in collection directory
+	my $coldir = $ENV{'GSDLCOLLECTDIR'};
+	$xslt_filename = &util::filename_cat($coldir,$xslt);
+    }
+
+    if (! -e $xslt_filename) {
+	print $outhandle "Warning: Unable to find XSLT $xslt\n";
+	if (open(XMLIN,"<$filename")) {
+
+	    my $untransformed_xml = "";
+	    while (defined (my $line = <XMLIN>)) {
+
+		$untransformed_xml .= $line;
+	    }
+	    close(XMLIN);
+	    
+	    return $untransformed_xml;
+	}
+	else {
+	    print $outhandle "Error: Unable to open file $filename\n";
+	    print $outhandle "       $!\n";
+	    return "";
+	}
+	
+    }
+
+    my $bin_java = &util::filename_cat($ENV{'GSDLHOME'},"bin","java");
+    my $jar_filename = &util::filename_cat($bin_java,"xalan.jar");
+    my $xslt_base_cmd = "java -jar $jar_filename";
+    my $xslt_cmd = "$xslt_base_cmd -IN \"$filename\" -XSL \"$xslt_filename\"";
+
+    my $transformed_xml = "";
+
+    if (open(XSLT_IN,"$xslt_cmd |")) {
+	while (defined (my $line = <XSLT_IN>)) {
+
+	    $transformed_xml .= $line;
+	}
+	close(XSLT_IN);
+    }
+    else {
+	print $outhandle "Error: Unable to run command $xslt_cmd\n";
+	print $outhandle "       $!\n";
+    }
+
+    return $transformed_xml;
+
+}
+
+sub check_doctype {
+    my $self = shift (@_);
+    
+    my ($filename) = @_;
+
+    if (open(XMLIN,"<$filename")) {
+	my $doctype = $self->get_doctype();
+	## check whether the doctype has the same name as the root element tag
+	while (defined (my $line = <XMLIN>)) {
+	    ## find the root element
+	    if ($line =~ /<([\w\d:]+)[\s>]/){
+		my $root = $1;
+		if ($root !~ $doctype){
+		    close(XMLIN);
+		    return 0;
+		}
+		else {
+		    close(XMLIN); 
+		    return 1;
+		}
+	    }
+	}
+	close(XMLIN);
+    }
+    
+    return undef; # haven't found a valid line
+    
+}
+
+# because we are not just using process_exp to determine whether to process or not, we need to implement this too, so that a file can be passed down if we are not actually processing it
+sub metadata_read {
+    my $self = shift (@_);
+    
+    my ($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli) = @_;
+ 
+    my $result = $self->SUPER::metadata_read($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli);
+
+    if (defined $result) {
+	# we think we are processing this, but check that we actually are
+	my $filename = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
+
+	if ($self->check_doctype($filename)) {
+	    return $result;
+	}
+    }
+    return undef;
+}
+
+sub read {
+    my $self = shift (@_);  
+  
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    # Make sure we're processing the correct file, do blocking etc
+    my ($block_status,$filename) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+
+    ## check the doctype to see whether we really want to process the file
+    if (!$self->check_doctype($filename)) {
+	# this file is not for us
+	return undef;
+    }
+
+    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
+    $self->{'base_dir'} = $base_dir;
+    $self->{'file'} = $file;
+    $self->{'filename'} = $filename;
+    $self->{'processor'} = $processor;
+    $self->{'metadata'} = $metadata;
+
+    eval {
+	my $xslt = $self->{'xslt'};
+	if (defined $xslt && ($xslt ne "")) {
+	    # perform xslt
+	    my $transformed_xml = $self->apply_xslt($xslt,$filename);
+
+	    # feed transformed file (now in memory as string) into XML parser
+	    $self->{'parser'}->parse($transformed_xml);
+	}
+	else {
+	    $self->{'parser'}->parsefile($filename);
+	}
+    };
+  
+    if ($@) {
+
+	# parsefile may either croak somewhere in XML::Parser (e.g. because
+	# the document is not well formed) or die somewhere in XMLPlug or a
+	# derived plugin (e.g. because we're attempting to process a
+	# document whose DOCTYPE is not meant for this plugin). For the
+	# first case we'll print a warning and continue, for the second
+	# we'll just continue quietly
+
+	print STDERR "**** Error is: $@\n";
+
+	my ($msg) = $@ =~ /Carp::croak\(\'(.*?)\'\)/;
+	if (defined $msg) {	
+	    my $outhandle = $self->{'outhandle'};
+	    my $plugin_name = ref ($self);
+	    print $outhandle "$plugin_name failed to process $file ($msg)\n";
+	}
+
+	# reset ourself for the next document
+	$self->{'section_level'}=0;
+	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
+	return -1; # error during processing
+    }
+
+    
+    return 1; # processed the file
+}
+
+# the following two methods are for if you want to do the parsing from a
+# plugin that inherits from this. it seems that you can't call the parse 
+# methods directly. WHY???
+#
+# [Stefan 27/5/07] These two methods may not be necessary any more as I've
+# fixed XMLPlug so $self is no longer required to be a global variable
+# (that was why inheritance wasn't working quite right with XMLPlug I
+# think). I don't really know what other plugins rely on these methods
+# though so have left them here for now.
+sub parse_file {
+    my $self = shift (@_); 
+    my ($filename) = @_;
+    $self->{'parser'}->parsefile($filename);
+}
+
+sub parse_string {
+    my $self = shift (@_); 
+    my ($xml_string) = @_;
+    $self->{'parser'}->parse($xml_string);
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)\.xml$^;
+}
+
+sub StartDocument {$_[0]->{'PluginObj'}->xml_start_document(@_);}
+sub XMLDecl {$_[0]->{'PluginObj'}->xml_xmldecl(@_);}
+sub Entity {$_[0]->{'PluginObj'}->xml_entity(@_);}
+sub Doctype {$_[0]->{'PluginObj'}->xml_doctype(@_);}
+sub StartTag {$_[0]->{'PluginObj'}->xml_start_tag(@_);}
+sub EndTag {$_[0]->{'PluginObj'}->xml_end_tag(@_);}
+sub Text {$_[0]->{'PluginObj'}->xml_text(@_);}
+sub PI {$_[0]->{'PluginObj'}->xml_pi(@_);}
+sub EndDocument {$_[0]->{'PluginObj'}->xml_end_document(@_);}
+sub Default {$_[0]->{'PluginObj'}->xml_default(@_);}
+
+# This Char function overrides the one in XML::Parser::Stream to overcome a
+# problem where $expat->{Text} is treated as the return value, slowing
+# things down significantly in some cases.
+sub Char {
+    use bytes;  # Necessary to prevent encoding issues with XML::Parser 2.31+
+    $_[0]->{'Text'} .= $_[1];
+    return undef;
+}
+
+# Called at the beginning of the XML document.
+sub xml_start_document {
+    my $self = shift(@_);
+    my ($expat) = @_;
+
+    $self->open_document();
+}
+
+# Called for XML declarations
+sub xml_xmldecl {
+    my $self = shift(@_);
+    my ($expat, $version, $encoding, $standalone) = @_;
+}
+
+# Called for XML entities
+sub xml_entity {
+  my $self = shift(@_);
+  my ($expat, $name, $val, $sysid, $pubid, $ndata) = @_;
+}
+
+# Called for DOCTYPE declarations - use die to bail out if this doctype
+# is not meant for this plugin
+sub xml_doctype {
+    my $self = shift(@_);
+
+    my ($expat, $name, $sysid, $pubid, $internal) = @_;
+    die "XMLPlug Cannot process XML document with DOCTYPE of $name";
+}
+
+
+# Called for every start tag. The $_ variable will contain a copy of the
+# tag and the %_ variable will contain the element's attributes.
+sub xml_start_tag {
+    my $self = shift(@_);
+    my ($expat, $element) = @_;
+}
+
+# Called for every end tag. The $_ variable will contain a copy of the tag.
+sub xml_end_tag {
+    my $self = shift(@_);
+    my ($expat, $element) = @_;
+}
+
+# Called just before start or end tags with accumulated non-markup text in
+# the $_ variable.
+sub xml_text {
+    my $self = shift(@_);
+    my ($expat) = @_;
+}
+
+# Called for processing instructions. The $_ variable will contain a copy
+# of the pi.
+sub xml_pi {
+    my $self = shift(@_);
+    my ($expat, $target, $data) = @_;
+}
+
+# Called at the end of the XML document.
+sub xml_end_document {
+    my $self = shift(@_);
+    my ($expat) = @_;
+
+    $self->close_document();
+}
+
+# Called for any characters not handled by the above functions.
+sub xml_default {
+    my $self = shift(@_);
+    my ($expat, $text) = @_;
+}
+
+sub open_document {
+    my $self = shift(@_);
+
+    # create a new document
+    $self->{'doc_obj'} = new doc ($self->{'filename'}, "indexed_doc");
+    $self->{'doc_obj'}->set_OIDtype ($self->{'processor'}->{'OIDtype'}, $self->{'processor'}->{'OIDmetadata'});
+}
+
+sub close_document {
+    my $self = shift(@_);
+    my $doc_obj = $self->{'doc_obj'};
+    # include any metadata passed in from previous plugins 
+    # note that this metadata is associated with the top level section
+    $self->extra_metadata ($doc_obj, 
+			   $doc_obj->get_top_section(), 
+			   $self->{'metadata'});
+   
+    # do any automatic metadata extraction
+    $self->auto_extract_metadata ($doc_obj);
+   
+    # add an OID
+    $doc_obj->set_OID();
+    
+    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
+    $doc_obj->add_metadata($doc_obj->get_top_section(), "FileFormat", "XML");
+
+    # process the document
+    $self->{'processor'}->process($doc_obj);
+    
+    $self->{'num_processed'} ++;
+}
+
+1;
+
+
+
+
Index: dl/trunk/perllib/plugins/RealMediaPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/RealMediaPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,168 +1,0 @@
-###########################################################################
-#
-# RealMediaPlug.pm -- Extract metadata from Real Media files
-#
-# Original code by Xin Gao
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 2005 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 RealMediaPlug;
-
-
-use UnknownPlug;
-use rm::Header::PurePerl;
-
-use strict;
-no strict 'refs'; # make an exception so we can use variables as filehandles
-
-
-sub BEGIN {
-    @RealMediaPlug::ISA = ('UnknownPlug');
-}
-
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" } ];
-
-my $options = { 'name'     => "RealMediaPlug",
-		'desc'     => "{RealMediaPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-
-# This plugin processes Real Media files with the suffixes ".rm" and ".rmvb"
-sub get_default_process_exp
-{
-    return q^(?i)(\.rm|rmvb)$^;
-}
-
-
-sub new
-{
-    my ($class) = shift(@_);
-    my ($pluginlist, $inputargs, $hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if (defined $arguments) { push(@{$hashArgOptLists->{"ArgList"}}, @{$arguments}); }
-    if (defined $options) { push(@{$hashArgOptLists->{"OptList"}}, $options); }
-
-    my $self = new UnknownPlug($pluginlist, $inputargs, $hashArgOptLists);
-    
-    return bless $self, $class;
-}
-
-
-# do plugin specific processing of doc_obj
-sub read
-{
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-
-    #check process and block exps, smart block, etc
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-
-    # Report that we're processing the file
-    print STDERR "<Processing n='$file' p='RealMediaPlug'>\n" if ($gli);
-    print $outhandle "RealMediaPlug: processing $file\n"
-  	if ($self->{'verbosity'}) > 1;
-
-    # create a new index document
-    my $doc_obj = new doc ($filename, "indexed_doc");
-    if ($processor->{'OIDtype'} =~ /^(assigned|dirname)$/) {
-	$doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
-    }
-    else {
-	$doc_obj->set_OIDtype ("incremental");    # this is done to avoid hashing content of file
-    }
-    my $top_section = $doc_obj->get_top_section();
-
-    #if there's a leading directory name, eat it...
-    $file =~ s/^.*[\/\\]//;
-         
-    my $url = $file;
-  
-    # Source (filename) to be consistent with other plugins
-    $doc_obj->add_metadata($top_section, "Source", $url);
-  
-  
-    my $text = "";
-    my $real_media = rm::Header::PurePerl->new($filename);
-    foreach my $key (keys %{$real_media->info})
-    {
-	my $value = $real_media->info->{$key};
-	$doc_obj->add_metadata($top_section, $key, $value);
-	$text .= "$key: $value\n";
-    }
-
-    $doc_obj->add_utf8_text($top_section, "<pre>\n$text\n</pre>");
-
-    # srclink
-    $doc_obj->add_metadata($top_section, "FileFormat", "RealMedia");
-    $doc_obj->add_metadata($top_section, "srclink", "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Source]\">");
-    $doc_obj->add_metadata($top_section, "/srclink", "</a>");
-    # srcicon (need to include "irmvideo.gif" in the greenstone images directory
-    $doc_obj->add_metadata($top_section, "srcicon", "<img src=\"_httpprefix_/images/irmvideo.gif\" title=\"Download\" border=0>");
-
-    # Add the actual file as an associated file
-    $doc_obj->associate_file($filename, $file, "RealMedia", $top_section);
-
-    # include any metadata passed in from previous plugins
-    my $section = $doc_obj->get_top_section();
-    $self->extra_metadata ($doc_obj, $section, $metadata);
-
-    # do plugin specific processing of doc_obj
-    return undef unless defined ($self->process (\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj));
-
-    # do any automatic metadata extraction
-    $self->auto_extract_metadata($doc_obj);
-    
-    # have we found a Title?? is the Title empty??
-    if(!defined $doc_obj->get_metadata_element($section, "Title") or $doc_obj->get_metadata_element($section, "Title") eq ""){         	
-    	my $file_derived_title = &BasPlug::filename_based_title($self, $file); 
-    	if(!defined $doc_obj->get_metadata_element($section, "Title")) {
-    		$doc_obj->add_metadata ($section, "Title", $file_derived_title);
-    	}
-    	else {
-    		$doc_obj->set_metadata_element ($section, "Title", $file_derived_title);
-    	}
-    } 
-
-    # add an OID
-    $doc_obj->set_OID();
-
-    # process the document
-    $processor->process($doc_obj);
-
-    $self->{'num_processed'}++;
-    return 1;
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/RealMediaPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/RealMediaPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/RealMediaPlugin.pm	(revision 15865)
@@ -0,0 +1,168 @@
+###########################################################################
+#
+# RealMediaPlug.pm -- Extract metadata from Real Media files
+#
+# Original code by Xin Gao
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 2005 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 RealMediaPlug;
+
+
+use UnknownPlug;
+use rm::Header::PurePerl;
+
+use strict;
+no strict 'refs'; # make an exception so we can use variables as filehandles
+
+
+sub BEGIN {
+    @RealMediaPlug::ISA = ('UnknownPlug');
+}
+
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" } ];
+
+my $options = { 'name'     => "RealMediaPlug",
+		'desc'     => "{RealMediaPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+
+# This plugin processes Real Media files with the suffixes ".rm" and ".rmvb"
+sub get_default_process_exp
+{
+    return q^(?i)(\.rm|rmvb)$^;
+}
+
+
+sub new
+{
+    my ($class) = shift(@_);
+    my ($pluginlist, $inputargs, $hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if (defined $arguments) { push(@{$hashArgOptLists->{"ArgList"}}, @{$arguments}); }
+    if (defined $options) { push(@{$hashArgOptLists->{"OptList"}}, $options); }
+
+    my $self = new UnknownPlug($pluginlist, $inputargs, $hashArgOptLists);
+    
+    return bless $self, $class;
+}
+
+
+# do plugin specific processing of doc_obj
+sub read
+{
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+
+    #check process and block exps, smart block, etc
+    my ($block_status,$filename) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+
+    # Report that we're processing the file
+    print STDERR "<Processing n='$file' p='RealMediaPlug'>\n" if ($gli);
+    print $outhandle "RealMediaPlug: processing $file\n"
+  	if ($self->{'verbosity'}) > 1;
+
+    # create a new index document
+    my $doc_obj = new doc ($filename, "indexed_doc");
+    if ($processor->{'OIDtype'} =~ /^(assigned|dirname)$/) {
+	$doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
+    }
+    else {
+	$doc_obj->set_OIDtype ("incremental");    # this is done to avoid hashing content of file
+    }
+    my $top_section = $doc_obj->get_top_section();
+
+    #if there's a leading directory name, eat it...
+    $file =~ s/^.*[\/\\]//;
+         
+    my $url = $file;
+  
+    # Source (filename) to be consistent with other plugins
+    $doc_obj->add_metadata($top_section, "Source", $url);
+  
+  
+    my $text = "";
+    my $real_media = rm::Header::PurePerl->new($filename);
+    foreach my $key (keys %{$real_media->info})
+    {
+	my $value = $real_media->info->{$key};
+	$doc_obj->add_metadata($top_section, $key, $value);
+	$text .= "$key: $value\n";
+    }
+
+    $doc_obj->add_utf8_text($top_section, "<pre>\n$text\n</pre>");
+
+    # srclink
+    $doc_obj->add_metadata($top_section, "FileFormat", "RealMedia");
+    $doc_obj->add_metadata($top_section, "srclink", "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[Source]\">");
+    $doc_obj->add_metadata($top_section, "/srclink", "</a>");
+    # srcicon (need to include "irmvideo.gif" in the greenstone images directory
+    $doc_obj->add_metadata($top_section, "srcicon", "<img src=\"_httpprefix_/images/irmvideo.gif\" title=\"Download\" border=0>");
+
+    # Add the actual file as an associated file
+    $doc_obj->associate_file($filename, $file, "RealMedia", $top_section);
+
+    # include any metadata passed in from previous plugins
+    my $section = $doc_obj->get_top_section();
+    $self->extra_metadata ($doc_obj, $section, $metadata);
+
+    # do plugin specific processing of doc_obj
+    return undef unless defined ($self->process (\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj));
+
+    # do any automatic metadata extraction
+    $self->auto_extract_metadata($doc_obj);
+    
+    # have we found a Title?? is the Title empty??
+    if(!defined $doc_obj->get_metadata_element($section, "Title") or $doc_obj->get_metadata_element($section, "Title") eq ""){         	
+    	my $file_derived_title = &BasPlug::filename_based_title($self, $file); 
+    	if(!defined $doc_obj->get_metadata_element($section, "Title")) {
+    		$doc_obj->add_metadata ($section, "Title", $file_derived_title);
+    	}
+    	else {
+    		$doc_obj->set_metadata_element ($section, "Title", $file_derived_title);
+    	}
+    } 
+
+    # add an OID
+    $doc_obj->set_OID();
+
+    # process the document
+    $processor->process($doc_obj);
+
+    $self->{'num_processed'}++;
+    return 1;
+}
+
+1;
Index: dl/trunk/perllib/plugins/RecPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/RecPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,455 +1,0 @@
-###########################################################################
-#
-# RecPlug.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) 1999 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.
-#
-###########################################################################
-
-# RecPlug is a plugin which recurses through directories processing
-# each file it finds.
-
-# RecPlug has one option: use_metadata_files.  When this is set, it will
-# check each directory for an XML file called "metadata.xml" that specifies
-# metadata for the files (and subdirectories) in the directory.
-#
-# Here's an example of a metadata file that uses three FileSet structures
-# (ignore the # characters):
-
-#<?xml version="1.0" encoding="UTF-8" standalone="no"?>
-#<!DOCTYPE DirectoryMetadata SYSTEM "http://greenstone.org/dtd/DirectoryMetadata/1.0/DirectoryMetadata.dtd">
-#<DirectoryMetadata>
-#  <FileSet>
-#    <FileName>nugget.*</FileName>
-#    <Description>
-#      <Metadata name="Title">Nugget Point, The Catlins</Metadata>
-#      <Metadata name="Place" mode="accumulate">Nugget Point</Metadata>
-#    </Description>
-#  </FileSet>
-#  <FileSet>
-#    <FileName>nugget-point-1.jpg</FileName>
-#    <Description>
-#      <Metadata name="Title">Nugget Point Lighthouse, The Catlins</Metadata>
-#      <Metadata name="Subject">Lighthouse</Metadata>
-#    </Description>
-#  </FileSet>
-#  <FileSet>
-#    <FileName>kaka-point-dir</FileName>
-#    <Description>
-#      <Metadata name="Title">Kaka Point, The Catlins</Metadata>
-#    </Description>
-#  </FileSet>
-#</DirectoryMetadata>
-
-# Metadata elements are read and applied to files in the order they appear
-# in the file.
-#
-# The FileName element describes the subfiles in the directory that the
-# metadata applies to as a perl regular expression (a FileSet group may
-# contain multiple FileName elements). So, <FileName>nugget.*</FileName>
-# indicates that the metadata records in the following Description block
-# apply to every subfile that starts with "nugget".  For these files, a
-# Title metadata element is set, overriding any old value that the Title
-# might have had.
-#
-# Occasionally, we want to have multiple metadata values applied to a
-# document; in this case we use the "mode=accumulate" attribute of the
-# particular Metadata element.  In the second metadata element of the first
-# FileSet above, the "Place" metadata is accumulating, and may therefore be
-# given several values.  If we wanted to override these values and use a
-# single metadata element again, we could set the mode attribute to
-# "override" instead.  Remember: every element is assumed to be in override
-# mode unless you specify otherwise, so if you want to accumulate metadata
-# for some field, every occurance must have "mode=accumulate" specified.
-#
-# The second FileSet element above applies to a specific file, called
-# nugget-point-1.jpg.  This element overrides the Title metadata set in the
-# first FileSet, and adds a "Subject" metadata field.
-#
-# The third and final FileSet sets metadata for a subdirectory rather than
-# a file.  The metadata specified (a Title) will be passed into the
-# subdirectory and applied to every file that occurs in the subdirectory
-# (and to every subsubdirectory and its contents, and so on) unless the
-# metadata is explictly overridden later in the import.
-
-
-
-package RecPlug;
-
-use BasPlug;
-use plugin;
-use util;
-use metadatautil;
-
-use File::Basename;
-use strict;
-no strict 'refs';
-use Encode;
-
-BEGIN {
-    @RecPlug::ISA = ('BasPlug');
-}
-
-my $arguments =
-    [ { 'name' => "block_exp",
-	'desc' => "{BasPlug.block_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_block_exp(),
-	'reqd' => "no" },
-      # this option has been deprecated. leave it here for now so we can warn people not to use it
-      { 'name' => "use_metadata_files",
-	'desc' => "{RecPlug.use_metadata_files}",
-	'type' => "flag",
-	'reqd' => "no",
-	'hiddengli' => "yes" },
-      { 'name' => "recheck_directories",
-	'desc' => "{RecPlug.recheck_directories}",
-	'type' => "flag",
-	'reqd' => "no" } ];
-    
-my $options = { 'name'     => "RecPlug",
-		'desc'     => "{RecPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-    
-    if ($self->{'info_only'}) {
-	# don't worry about any options or initialisations etc
-	return bless $self, $class;
-    }
-
-    # we have left this option in so we can warn people who are still using it
-    if ($self->{'use_metadata_files'}) {
-	die "ERROR: RecPlug -use_metadata_files option has been deprecated. Please remove the option and add MetadataXMLPlug to your plugin list instead!\n";
-    }
-	    
-    $self->{'subdir_extrametakeys'} = {};
-
-    return bless $self, $class;
-}
-
-sub begin {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $processor, $maxdocs) = @_;
-
-    my $proc_package_name = ref $processor;
-
-    if ($proc_package_name !~ /buildproc$/ && $self->{'incremental'} == 1) {
-
-	# Only lookup timestamp info for import.pl, and only if incremental is set
-
-	my $output_dir = $processor->getoutputdir();
-	my $archives_inf = &util::filename_cat($output_dir,"archives.inf");
-    
-	if ( -e $archives_inf ) {
-	    $self->{'inf_timestamp'} = -M $archives_inf;
-	}
-    }
-
-    $self->SUPER::begin($pluginfo, $base_dir, $processor, $maxdocs);
-}
-
-
-# return 1 if this class might recurse using $pluginfo
-sub is_recursive {
-    my $self = shift (@_);
-    
-    return 1;
-}
-
-sub get_default_block_exp {
-    my $self = shift (@_);
-    
-    return '(CVS|\.svn)';
-}
-
-# return number of files processed, undef if can't process
-# Note that $base_dir might be "" and that $file might 
-# include directories
-
-# This function passes around metadata hash structures.  Metadata hash
-# structures are hashes that map from a (scalar) key (the metadata element
-# name) to either a scalar metadata value or a reference to an array of
-# such values.
-
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $in_metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-    
-    my $outhandle = $self->{'outhandle'};
-    my $verbosity = $self->{'verbosity'};
-    my $read_metadata_files = $self->{'use_metadata_files'};
-
-    # Calculate the directory name and ensure it is a directory and
-    # that it is not explicitly blocked.
-    my $dirname = $file;
-    $dirname = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
-    return undef unless (-d $dirname);
-    return 0 if ($self->{'block_exp'} ne "" && $dirname =~ /$self->{'block_exp'}/);
-
-    # check to make sure we're not reading the archives or index directory
-    my $gsdlhome = quotemeta($ENV{'GSDLHOME'});
-    if ($dirname =~ m/^$gsdlhome\/.*?\/import.*?\/(archives|index)$/) {
-	print $outhandle "RecPlug: $dirname appears to be a reference to a Greenstone collection, skipping.\n";
-        return 0;
-    }
-    
-    # check to see we haven't got a cyclic path...
-    if ($dirname =~ m%(/.*){,41}%) {
-	print $outhandle "RecPlug: $dirname is 40 directories deep, is this a recursive path? if not increase constant in RecPlug.pm.\n";
-	return 0;
-    }
-    
-    # check to see we haven't got a cyclic path...
-    if ($dirname =~ m%.*?import/(.+?)/import/\1.*%) {
-	print $outhandle "RecPlug: $dirname appears to be in a recursive loop...\n";
-	return 0;
-    }
-    
-    if (($verbosity > 2) && ((scalar keys %$in_metadata) > 0)) {
-        print $outhandle "RecPlug: metadata passed in: ", 
-	join(", ", keys %$in_metadata), "\n";
-    }
-    
-    # Recur over directory contents.
-    my (@dir, $subfile);
-    my $count = 0;
-    
-    print $outhandle "RecPlug: getting directory $dirname\n" if ($verbosity);
-    
-    # find all the files in the directory
-    if (!opendir (DIR, $dirname)) {
-	if ($gli) {
-	    print STDERR "<ProcessingError n='$file' r='Could not read directory $dirname'>\n";
-	}
-	print $outhandle "RecPlug: WARNING - couldn't read directory $dirname\n";
-	return -1; # error in processing
-    }
-    @dir = readdir (DIR);
-    closedir (DIR);
-
-    # Re-order the files in the list so any directories ending with .all are moved to the end
-    for (my $i = scalar(@dir) - 1; $i >= 0; $i--) {
-	if (-d &util::filename_cat($dirname, $dir[$i]) && $dir[$i] =~ /\.all$/) {
-	    push(@dir, splice(@dir, $i, 1));
-	}
-    }
-
-    # setup the metadata structures. we do a metadata_read pass to see if there is any additional metadata, then pass it to read
-    
-    my $additionalmetadata = 0;      # is there extra metadata available?
-    my %extrametadata;               # maps from filespec to extra metadata keys
-    my @extrametakeys;               # keys of %extrametadata in order read
-
-    my $os_dirsep = &util::get_os_dirsep();
-    my $dirsep    = &util::get_dirsep();
-    my $base_dir_regexp = $base_dir;
-    $base_dir_regexp =~ s/\//$os_dirsep/g;
-    my $local_dirname = $dirname;
-    $local_dirname =~ s/^$base_dir_regexp($os_dirsep)//;
-    $local_dirname .= $dirsep;
-
-    if (defined $self->{'subdir_extrametakeys'}->{$local_dirname}) {
-	my $extrakeys = $self->{'subdir_extrametakeys'}->{$local_dirname};
-	foreach my $ek (@$extrakeys) {
-	    my $extrakeys_re  = $ek->{'re'};
-	    my $extrakeys_md  = $ek->{'md'};
-	    push(@extrametakeys,$extrakeys_re);
-	    $extrametadata{$extrakeys_re} = $extrakeys_md;
-	}
-	delete($self->{'subdir_extrametakeys'}->{$local_dirname});
-    }
-    
-    # apply metadata pass for each of the files in the directory
-    my $out_metadata; 
-    my $num_files = scalar(@dir);
-    for (my $i = 0; $i < scalar(@dir); $i++) {
-	my $subfile = $dir[$i];
-	my $this_file_base_dir = $base_dir;
-	last if ($maxdocs != -1 && $count >= $maxdocs);
-	next if ($subfile =~ m/^\.\.?$/);
-
-	# Recursively read each $subfile
-	print $outhandle "RecPlug metadata recurring: $subfile\n" if ($verbosity > 2);
-	
-	$count += &plugin::metadata_read ($pluginfo, $this_file_base_dir,
-					  &util::filename_cat($file, $subfile),
-					  $out_metadata, \@extrametakeys, \%extrametadata,
-					  $processor, $maxdocs, $gli);
-	$additionalmetadata = 1;
-    }
-   
-    # filter out any extrametakeys that mention subdirectories and store
-    # for later use (i.e. when that sub-directory is being processed)
-
-    foreach my $ek (@extrametakeys) {
-	my ($subdir_re,$extrakey_dir) = &File::Basename::fileparse($ek);
-	$extrakey_dir =~ s/\\\./\./g; # remove RE syntax
-
-	my $dirsep_re = &util::get_re_dirsep();
-
-	my $ek_non_re = $ek;
-	$ek_non_re =~ s/\\\./\./g; # remove RE syntax
-
-	if ($ek_non_re =~ m/$dirsep_re/) { # specifies at least one directory
-	    my $md = $extrametadata{$ek};
-
-	    my $subdir_extrametakeys = $self->{'subdir_extrametakeys'};
-
-	    my $subdir_rec = { 're' => $subdir_re, 'md' => $md };
-
-	    push(@{$subdir_extrametakeys->{$extrakey_dir}},$subdir_rec);
-	}
-    }
-    
-    # import each of the files in the directory
-    $count=0;
-    for (my $i = 0; $i <= scalar(@dir); $i++) {
-	# When every file in the directory has been done, pause for a moment (figuratively!)
-	# If the -recheck_directories argument hasn't been provided, stop now (default)
-	# Otherwise, re-read the contents of the directory to check for new files
-	#   Any new files are added to the @dir list and are processed as normal
-	#   This is necessary when documents to be indexed are specified in bibliographic DBs
-	#   These files are copied/downloaded and stored in a new folder at import time
-	if ($i == $num_files) {
-	    last unless $self->{'recheck_directories'};
-
-	    # Re-read the files in the directory to see if there are any new files
-	    last if (!opendir (DIR, $dirname));
-	    my @dirnow = readdir (DIR);
-	    closedir (DIR);
-
-	    # We're only interested if there are more files than there were before
-	    last if (scalar(@dirnow) <= scalar(@dir));
-
-	    # Any new files are added to the end of @dir to get processed by the loop
-	    my $j;
-	    foreach my $subfilenow (@dirnow) {
-		for ($j = 0; $j < $num_files; $j++) {
-		    last if ($subfilenow eq $dir[$j]);
-		}
-		if ($j == $num_files) {
-		    # New file
-		    push(@dir, $subfilenow);
-		}
-	    }
-	    # When the new files have been processed, check again
-	    $num_files = scalar(@dir);
-	}
-
-	my $subfile = $dir[$i];
-	my $this_file_base_dir = $base_dir;
-	last if ($maxdocs != -1 && ($count + $total_count) >= $maxdocs);
-	next if ($subfile =~ /^\.\.?$/);
-
-	# Follow Windows shortcuts
-	if ($subfile =~ /(?i)\.lnk$/ && $ENV{'GSDLOS'} =~ /^windows$/i) {
-	    require Win32::Shortcut;
-	    my $shortcut = new Win32::Shortcut(&util::filename_cat($dirname, $subfile));
-	    if ($shortcut) {
-		# The file to be processed is now the target of the shortcut
-		$this_file_base_dir = "";
-		$file = "";
-		$subfile = $shortcut->Path;
-	    }
-	}
-
-	# check for a symlink pointing back to a leading directory
-	if (-d "$dirname/$subfile" && -l "$dirname/$subfile") {
-	    # readlink gives a "fatal error" on systems that don't implement
-	    # symlinks. This assumes the the -l test above would fail on those.
-	    my $linkdest=readlink "$dirname/$subfile";
-	    if (!defined ($linkdest)) {
-		# system error - file not found?
-		warn "RecPlug: symlink problem - $!";
-	    } else {
-		# see if link points to current or a parent directory
-		if ($linkdest =~ m@^[\./\\]+$@ ||
-		    index($dirname, $linkdest) != -1) {
-		    warn "RecPlug: Ignoring recursive symlink ($dirname/$subfile -> $linkdest)\n";
-		    next;
-		    ;
-		}
-	    }
-	}
-
-	print $outhandle "RecPlug: preparing metadata for $subfile\n" if ($verbosity > 2);
-
-	# Make a copy of $in_metadata to pass to $subfile
-	$out_metadata = {};
-	&metadatautil::combine_metadata_structures($out_metadata, $in_metadata);
-
-        ## encode the filename as perl5 doesn't handle unicode filenames       
-        my $tmpfile = Encode::encode_utf8($subfile); 
-
-	# Next add metadata read in XML files (if it is supplied)
-	if ($additionalmetadata == 1) {
-	    
-	    my ($filespec, $mdref);
-	    foreach $filespec (@extrametakeys) {
-                ## use the utf8 encoded filename to do the filename comparison
-		if ($tmpfile =~ /^$filespec$/) {
-		    print $outhandle "File \"$subfile\" matches filespec \"$filespec\"\n" 
-			if ($verbosity > 2);
-		    $mdref = $extrametadata{$filespec};
-		    &metadatautil::combine_metadata_structures($out_metadata, $mdref);
-		}
-	    }
-	}
-
-
-	my $file_subfile = &util::filename_cat($file, $subfile);
-	my $filename_subfile 
-	    = &util::filename_cat($this_file_base_dir,$file_subfile);
-	if (defined $self->{'inf_timestamp'}) {
-	    my $inf_timestamp = $self->{'inf_timestamp'};
-
-	    if (! -d $filename_subfile) {
-		my $filename_timestamp = -M $filename_subfile;
-		if ($filename_timestamp > $inf_timestamp) {
-		    # filename has been around for longer than inf
-#####		    print $outhandle "**** Skipping $subfile\n";
-		    next;
-		}
-	    }
-	}
-
-	# Recursively read each $subfile
-	print $outhandle "RecPlug recurring: $subfile\n" if ($verbosity > 2);
-	
-	$count += &plugin::read ($pluginfo, $this_file_base_dir,
-				 $file_subfile,
-				 $out_metadata, $processor, $maxdocs, ($total_count + $count), $gli);
-    }
-
-    return $count;
-}
-
-1;
Index: dl/trunk/perllib/plugins/ReferPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ReferPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,314 +1,0 @@
-###########################################################################
-#
-# ReferPlug.pm - a plugin for bibliography records in Refer format
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright 2000 Gordon W. Paynter
-# Copyright 1999-2000 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.
-#
-###########################################################################
-
-# ReferPlug reads bibliography files in Refer format.
-#
-# by Gordon W. Paynter (gwp@cs.waikato.ac.nz), November 2000
-#
-# Loosely based on hcibib2Plug by Steve Jones (stevej@cs.waikato.ac.nz).
-# Which was based on EMAILPlug by Gordon Paynter (gwp@cs.waikato.ac.nz).
-# Which was based on old versions of HTMLplug and HCIBIBPlugby by Stefan
-# Boddie and others -- it's hard to tell what came from where, now.
-#
-#
-# ReferPlug creates a document object for every reference in the file.
-# It is a subclass of SplitPlug, so if there are multiple records, all
-# are read.
-#
-# Document text:
-#   The document text consists of the reference in Refer format
-#
-# Metadata:
-#	$Creator	%A	Author name
-#	$Title		%T	Title of article of book
-#	$Journal	%J	Title of Journal
-#	$Booktitle	%B	Title of book containing the publication
-#	$Report		%R	Type of Report, paper or thesis
-#	$Volume		%V	Volume Number of Journal
-#	$Number		%N	Number of Journal within Volume
-#	$Editor		%E	Editor name
-#	$Pages		%P	Page Number of article
-#	$Publisher	%I	Name of Publisher
-#	$Publisheraddr	%C	Publisher's address
-#	$Date		%D	Date of publication
-#	$Keywords	%K	Keywords associated with publication 
-#	$Abstract	%X	Abstract of publication
-#	$Copyright	%*	Copyright information for the article
-#
-
-# 12/05/02 Added usage datastructure - John Thompson
-
-package ReferPlug;
-
-use SplitPlug;
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-# ReferPlug is a sub-class of BasPlug.
-sub BEGIN {
-    @ReferPlug::ISA = ('SplitPlug');
-}
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" },
-      { 'name' => "split_exp",
-	'desc' => "{SplitPlug.split_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_split_exp() } 
-      ];
-
-my $options = { 'name'     => "ReferPlug",
-		'desc'     => "{ReferPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'explodes' => "yes",
-		'args'     => $arguments };
-
-# This plugin processes files with the suffix ".bib"
-sub get_default_process_exp {
-    return q^(?i)\.bib$^;
-}
-
-# This plugin splits the input text at blank lines
-sub get_default_split_exp {
-    return q^\n\s*\n^;
-}
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new SplitPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-# The process function reads a single bibliogrphic record and stores
-# it as a new document.
-
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    # Check that we're dealing with a valid Refer file
-    return undef unless ($$textref =~ /^\s*%/);
-
-    my $cursection = $doc_obj->get_top_section();
-    # Report that we're processing the file
-    print STDERR "<Processing n='$file' p='ReferPlug'>\n" if ($gli);
-    print $outhandle "ReferPlug: processing $file\n"
-	if ($self->{'verbosity'}) > 1;
-
-    my %field = ('H', 'Header',
-		 'A', 'Creator',
-		 'T', 'Title',
-		 'J', 'Journal',
-		 'B', 'Booktitle',
-		 'R', 'Report',
-		 'V', 'Volume',
-		 'N', 'Number',
-		 'E', 'Editor',
-		 'P', 'Pages',
-		 'I', 'Publisher',
-		 'C', 'PublisherAddress',
-		 'D', 'Date',
-		 'O', 'OtherInformation',
-		 'K', 'Keywords',
-		 'X', 'Abstract',
-		 '*', 'Copyright');
-
-    # Metadata fields 
-    my %metadata;
-    my ($id, $Creator, $Keywords, $text);
-    my @lines = split(/\n+/, $$textref);
-
-    
-    # Read and process each line in the bib file.
-    # Each file consists of a set of metadata items, one to each line
-    # with the Refer key followed by a space then the associated data
-    foreach my $line (@lines) {
-	
-	# Add each line.  Most lines consist of a field identifer and
-	# then data, and we simply store them, though we treat some
-	# of the fields a bit differently.
-
-	$line =~ s/\s+/ /g;
-	$text .= "$line\n";
-	# $ReferFormat .= "$line\n"; # what is this???
-	
-	next unless ($line =~ /^%[A-Z\*]/);
-	$id = substr($line,1,1);
-	$line =~ s/^%. //;
-   	
-	# Add individual authors in "Lastname, Firstname" format.
-	# (The full set of authors will be added below as "Creator".)
-	if ($id eq "A") {
-
-	    # Reformat and add author name
-	    my @words = split(/ /, $line);
-	    my $lastname = pop @words;
-	    my $firstname = join(" ",  @words);
-	    my $fullname = $lastname . ", " . $firstname;
-	    
-	    # Add each name to set of Authors
-	    if ($fullname =~ /\w/) {
-		$fullname = &text_into_html($fullname);
-		$doc_obj->add_metadata ($cursection, "Author", $fullname);
-	    }
-	}
-
-	# Add individual keywords.
-	# (The full set of authors will be added below as "Keywords".)
-	if ($id eq "K") {
-	    my @keywordlist = split(/,/, $line);
-	    foreach my $k (@keywordlist) {
-		$k = lc($k);
-		$k =~ s/\s*$//; 
-		$k =~ s/^\s*//; 
-		if ($k =~ /\w/) {
-		    $k = &text_into_html($k);
-		    $doc_obj->add_metadata ($cursection, "Keyword", $k);
-		}
-	    } 
-	}
-	
-	# Add this line of metadata
-	$metadata{$id} .= "$line\n";
-    }
-
-
-
-    # Add the various field as metadata
-    my ($f, $name, $value);
-    foreach $f (keys %metadata) {
-	
-	next unless (defined $field{$f});
-	next unless (defined $metadata{$f});	
-
-	$name = $field{$f};
-	$value = $metadata{$f};
-
-	# Add the various field as metadata	
-	
-	# The Creator metadata is found by concatenating authors.
-	if ($f eq "A") {
-
-	    my @authorlist = split(/\n/, $value);
-	    my $lastauthor = pop @authorlist;
-	    my $Creator = "";
-	    if (scalar @authorlist) {
-		$Creator = join(", ", @authorlist) . " and $lastauthor";
-	    } else {
-		$Creator = $lastauthor;
-	    }
-
-	    if ($Creator =~ /\w/) {
-		$Creator = &text_into_html($Creator);
-		$doc_obj->add_metadata ($cursection, "Creator", $Creator);
-	    }
-	}
-
-	# The rest are added in a standard way
-	else {
-	    $value = &text_into_html($value);
-	    $doc_obj->add_metadata ($cursection, $name, $value);
-	}
-
-	# Books and Journals are additionally marked for display purposes
-	if ($f eq "B") {
-	    $doc_obj->add_metadata($cursection, "BookConfOnly", 1);
-	} elsif ($f eq "J") {
-	    $doc_obj->add_metadata($cursection, "JournalsOnly", 1); 
-	}
-
-
-    }
-
-    # Add the text in refer format(all fields)
-    if ($text =~ /\w/) {
-	$text = &text_into_html($text);
-	$doc_obj->add_text ($cursection, $text);
-    }
-    # Add FileFormat as the metadata
-    $doc_obj->add_metadata($cursection,"FileFormat","Refer");
-
-    return 1; # processed the file
-}
-
-1;
-#
-# Convert a text string into HTML.
-#
-# The HTML is going to be inserted into a GML file, so 
-# we have to be careful not to use symbols like ">",
-# which ocurs frequently in email messages (and use
-# &gt instead.
-#
-# This function also turns links and email addresses into hyperlinks,
-# and replaces carriage returns with <BR> tags (and multiple carriage
-# returns with <P> tags).
-#
-
-sub text_into_html {
-    my ($text) = @_;
-
-
-    # Convert problem charaters into HTML symbols
-    $text =~ s/&/&amp;/g;
-    $text =~ s/</&lt;/g;
-    $text =~ s/>/&gt;/g;
-    $text =~ s/\"/&quot;/g;
-    $text =~ s/\'/ /g;
-    $text =~ s/\+/ /g;
-    $text =~ s/\(/ /g;
-    $text =~ s/\)/ /g;
-
-    # convert email addresses and URLs into links
-    $text =~ s/([\w\d\.\-]+@[\w\d\.\-]+)/<a href=\"mailto:$1\">$1<\/a>/g;
-    $text =~ s/(http:\/\/[\w\d\.\-]+[\/\w\d\.\-]*)/<a href=\"$1">$1<\/a>/g;
-
-    # Clean up whitespace and convert \n charaters to <BR> or <P>
-    $text =~ s/ +/ /g;
-    $text =~ s/\s*$//; 
-    $text =~ s/^\s*//; 
-    $text =~ s/\n/\n<BR>/g;
-    $text =~ s/<BR>\s*<BR>/<P>/g;
-
-    return $text;
-}
-
-
Index: /gsdl/trunk/perllib/plugins/ReferPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ReferPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/ReferPlugin.pm	(revision 15865)
@@ -0,0 +1,314 @@
+###########################################################################
+#
+# ReferPlug.pm - a plugin for bibliography records in Refer format
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright 2000 Gordon W. Paynter
+# Copyright 1999-2000 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.
+#
+###########################################################################
+
+# ReferPlug reads bibliography files in Refer format.
+#
+# by Gordon W. Paynter (gwp@cs.waikato.ac.nz), November 2000
+#
+# Loosely based on hcibib2Plug by Steve Jones (stevej@cs.waikato.ac.nz).
+# Which was based on EMAILPlug by Gordon Paynter (gwp@cs.waikato.ac.nz).
+# Which was based on old versions of HTMLplug and HCIBIBPlugby by Stefan
+# Boddie and others -- it's hard to tell what came from where, now.
+#
+#
+# ReferPlug creates a document object for every reference in the file.
+# It is a subclass of SplitPlug, so if there are multiple records, all
+# are read.
+#
+# Document text:
+#   The document text consists of the reference in Refer format
+#
+# Metadata:
+#	$Creator	%A	Author name
+#	$Title		%T	Title of article of book
+#	$Journal	%J	Title of Journal
+#	$Booktitle	%B	Title of book containing the publication
+#	$Report		%R	Type of Report, paper or thesis
+#	$Volume		%V	Volume Number of Journal
+#	$Number		%N	Number of Journal within Volume
+#	$Editor		%E	Editor name
+#	$Pages		%P	Page Number of article
+#	$Publisher	%I	Name of Publisher
+#	$Publisheraddr	%C	Publisher's address
+#	$Date		%D	Date of publication
+#	$Keywords	%K	Keywords associated with publication 
+#	$Abstract	%X	Abstract of publication
+#	$Copyright	%*	Copyright information for the article
+#
+
+# 12/05/02 Added usage datastructure - John Thompson
+
+package ReferPlug;
+
+use SplitPlug;
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+# ReferPlug is a sub-class of BasPlug.
+sub BEGIN {
+    @ReferPlug::ISA = ('SplitPlug');
+}
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" },
+      { 'name' => "split_exp",
+	'desc' => "{SplitPlug.split_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_split_exp() } 
+      ];
+
+my $options = { 'name'     => "ReferPlug",
+		'desc'     => "{ReferPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'explodes' => "yes",
+		'args'     => $arguments };
+
+# This plugin processes files with the suffix ".bib"
+sub get_default_process_exp {
+    return q^(?i)\.bib$^;
+}
+
+# This plugin splits the input text at blank lines
+sub get_default_split_exp {
+    return q^\n\s*\n^;
+}
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new SplitPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+# The process function reads a single bibliogrphic record and stores
+# it as a new document.
+
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    # Check that we're dealing with a valid Refer file
+    return undef unless ($$textref =~ /^\s*%/);
+
+    my $cursection = $doc_obj->get_top_section();
+    # Report that we're processing the file
+    print STDERR "<Processing n='$file' p='ReferPlug'>\n" if ($gli);
+    print $outhandle "ReferPlug: processing $file\n"
+	if ($self->{'verbosity'}) > 1;
+
+    my %field = ('H', 'Header',
+		 'A', 'Creator',
+		 'T', 'Title',
+		 'J', 'Journal',
+		 'B', 'Booktitle',
+		 'R', 'Report',
+		 'V', 'Volume',
+		 'N', 'Number',
+		 'E', 'Editor',
+		 'P', 'Pages',
+		 'I', 'Publisher',
+		 'C', 'PublisherAddress',
+		 'D', 'Date',
+		 'O', 'OtherInformation',
+		 'K', 'Keywords',
+		 'X', 'Abstract',
+		 '*', 'Copyright');
+
+    # Metadata fields 
+    my %metadata;
+    my ($id, $Creator, $Keywords, $text);
+    my @lines = split(/\n+/, $$textref);
+
+    
+    # Read and process each line in the bib file.
+    # Each file consists of a set of metadata items, one to each line
+    # with the Refer key followed by a space then the associated data
+    foreach my $line (@lines) {
+	
+	# Add each line.  Most lines consist of a field identifer and
+	# then data, and we simply store them, though we treat some
+	# of the fields a bit differently.
+
+	$line =~ s/\s+/ /g;
+	$text .= "$line\n";
+	# $ReferFormat .= "$line\n"; # what is this???
+	
+	next unless ($line =~ /^%[A-Z\*]/);
+	$id = substr($line,1,1);
+	$line =~ s/^%. //;
+   	
+	# Add individual authors in "Lastname, Firstname" format.
+	# (The full set of authors will be added below as "Creator".)
+	if ($id eq "A") {
+
+	    # Reformat and add author name
+	    my @words = split(/ /, $line);
+	    my $lastname = pop @words;
+	    my $firstname = join(" ",  @words);
+	    my $fullname = $lastname . ", " . $firstname;
+	    
+	    # Add each name to set of Authors
+	    if ($fullname =~ /\w/) {
+		$fullname = &text_into_html($fullname);
+		$doc_obj->add_metadata ($cursection, "Author", $fullname);
+	    }
+	}
+
+	# Add individual keywords.
+	# (The full set of authors will be added below as "Keywords".)
+	if ($id eq "K") {
+	    my @keywordlist = split(/,/, $line);
+	    foreach my $k (@keywordlist) {
+		$k = lc($k);
+		$k =~ s/\s*$//; 
+		$k =~ s/^\s*//; 
+		if ($k =~ /\w/) {
+		    $k = &text_into_html($k);
+		    $doc_obj->add_metadata ($cursection, "Keyword", $k);
+		}
+	    } 
+	}
+	
+	# Add this line of metadata
+	$metadata{$id} .= "$line\n";
+    }
+
+
+
+    # Add the various field as metadata
+    my ($f, $name, $value);
+    foreach $f (keys %metadata) {
+	
+	next unless (defined $field{$f});
+	next unless (defined $metadata{$f});	
+
+	$name = $field{$f};
+	$value = $metadata{$f};
+
+	# Add the various field as metadata	
+	
+	# The Creator metadata is found by concatenating authors.
+	if ($f eq "A") {
+
+	    my @authorlist = split(/\n/, $value);
+	    my $lastauthor = pop @authorlist;
+	    my $Creator = "";
+	    if (scalar @authorlist) {
+		$Creator = join(", ", @authorlist) . " and $lastauthor";
+	    } else {
+		$Creator = $lastauthor;
+	    }
+
+	    if ($Creator =~ /\w/) {
+		$Creator = &text_into_html($Creator);
+		$doc_obj->add_metadata ($cursection, "Creator", $Creator);
+	    }
+	}
+
+	# The rest are added in a standard way
+	else {
+	    $value = &text_into_html($value);
+	    $doc_obj->add_metadata ($cursection, $name, $value);
+	}
+
+	# Books and Journals are additionally marked for display purposes
+	if ($f eq "B") {
+	    $doc_obj->add_metadata($cursection, "BookConfOnly", 1);
+	} elsif ($f eq "J") {
+	    $doc_obj->add_metadata($cursection, "JournalsOnly", 1); 
+	}
+
+
+    }
+
+    # Add the text in refer format(all fields)
+    if ($text =~ /\w/) {
+	$text = &text_into_html($text);
+	$doc_obj->add_text ($cursection, $text);
+    }
+    # Add FileFormat as the metadata
+    $doc_obj->add_metadata($cursection,"FileFormat","Refer");
+
+    return 1; # processed the file
+}
+
+1;
+#
+# Convert a text string into HTML.
+#
+# The HTML is going to be inserted into a GML file, so 
+# we have to be careful not to use symbols like ">",
+# which ocurs frequently in email messages (and use
+# &gt instead.
+#
+# This function also turns links and email addresses into hyperlinks,
+# and replaces carriage returns with <BR> tags (and multiple carriage
+# returns with <P> tags).
+#
+
+sub text_into_html {
+    my ($text) = @_;
+
+
+    # Convert problem charaters into HTML symbols
+    $text =~ s/&/&amp;/g;
+    $text =~ s/</&lt;/g;
+    $text =~ s/>/&gt;/g;
+    $text =~ s/\"/&quot;/g;
+    $text =~ s/\'/ /g;
+    $text =~ s/\+/ /g;
+    $text =~ s/\(/ /g;
+    $text =~ s/\)/ /g;
+
+    # convert email addresses and URLs into links
+    $text =~ s/([\w\d\.\-]+@[\w\d\.\-]+)/<a href=\"mailto:$1\">$1<\/a>/g;
+    $text =~ s/(http:\/\/[\w\d\.\-]+[\/\w\d\.\-]*)/<a href=\"$1">$1<\/a>/g;
+
+    # Clean up whitespace and convert \n charaters to <BR> or <P>
+    $text =~ s/ +/ /g;
+    $text =~ s/\s*$//; 
+    $text =~ s/^\s*//; 
+    $text =~ s/\n/\n<BR>/g;
+    $text =~ s/<BR>\s*<BR>/<P>/g;
+
+    return $text;
+}
+
+
Index: dl/trunk/perllib/plugins/RogPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/RogPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,282 +1,0 @@
-###########################################################################
-#
-# RogPlug.pm -- simple text plugin
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999 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.
-#
-###########################################################################
-
-# creates simple single-level document from .rog or .mdb files 
-
-package RogPlug;
-
-use BasPlug;
-use sorttools;
-use doc; 
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @RogPlug::ISA = ('BasPlug');
-}
-
-my $arguments = 
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'reqd' => "no",
-	'deft' => &get_default_process_exp() },
-      ];
-
-my $options = { 'name'     => "RogPlug",
-		'desc'     => "{RogPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args' => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-
-# This plugin processes files with the suffix ".mdb" or ".rog"
-sub get_default_process_exp {
-    return q^(?i)\.(mdb|rog)$^;
-}
-
-sub read_rog_record
-{
-    my ($self,$file_buffer, $seclevel) = @_;
-
-    my $next_line = $file_buffer->{'next_line'};
-
-    return 0 if (!defined $next_line);
-
-    if ($next_line eq "")
-    {
-	my $line;
-	while(defined($line=<FILE>))  
-	{
-	    $line =~ s/\r$//;
-	    $file_buffer->{'line_no'}++;
-	    next if ($line =~ m/^\#/);
-	    $next_line = $line;
-	    last;
-	}
-    }
-	    
-    if ($next_line !~ m/^song( +)\"([^\"]*)\"( +)\"([^\"]*)\"( +)(\d+)( *)$/) 
-    {
-	print STDERR "Error: Malformed Rog file: $next_line";
-	return 0;
-    }
-    else
-    {
-	# init default values
-	$file_buffer->{'song'}->{'tempo'}    = 120;
-	$file_buffer->{'song'}->{'ks_type'}  = 0;
-	$file_buffer->{'song'}->{'ks_num'}   = 0;
-	$file_buffer->{'song'}->{'metadata'} = [];
-	$file_buffer->{'song'}->{'content'}  = "";
-	
-	$file_buffer->{'song'}->{'subcol'} = $2;
-	$file_buffer->{'song'}->{'title'}  = $4;
-	$file_buffer->{'song'}->{'tval'}   = $6;
-
-	chomp($next_line);
-	my $content = $next_line;
-	if (defined $seclevel) 
-	{
-	    $content.= " $seclevel";
-	}
-	$content .= "\n";
-
-	$file_buffer->{'song'}->{'content'} = $content;
-
-
-	my $line;
-	while(defined($line=<FILE>))  
-	{
-	    $line =~ s/\r$//;
-
-	    $file_buffer->{'line_no'}++;
-	    next if ($line =~ m/^\#/);
-	
-	    if ($line =~ m/^song/) 
-	    {	
-		$file_buffer->{'next_line'} = $line;
-		return 1;
-	    }
-	    elsif ($line =~ m/^tempo( +)(\d+)( *)$/) 
-	    {
-		$file_buffer->{'song'}->{'tempo'} = $2;
-		$file_buffer->{'song'}->{'content'} .= $line;
-	    } 
-	    elsif ($line =~ m/^keysig( +)(\d+)( +)(\d+)( *)$/) 
-	    {
-		$file_buffer->{'song'}->{'ks_type'} = $2;
-		$file_buffer->{'song'}->{'ks_num'}  = $4;
-		$file_buffer->{'song'}->{'content'} .= $line;	   
-	    } 
-	    elsif ($line =~ m/^timesig( +)(\d+)( +)(\d+)( *)$/) 
-	    {
-		$file_buffer->{'song'}->{'ts_numer'} = $2;
-		$file_buffer->{'song'}->{'ts_denom'} = $4;
-		$file_buffer->{'song'}->{'content'} .= $line;
-	    }
-	    elsif ($line =~ m/^metadata ([^:]*): (.*)/)
-	    {
-		push(@{$file_buffer->{'song'}->{'metadata'}},[$1,$2]);
-		$file_buffer->{'song'}->{'content'} .= $line;
-	    }
-	    else
-	    {
-		$file_buffer->{'song'}->{'content'} .= $line;
-	    }
-	}
-	
-	$file_buffer->{'next_line'} = undef;
-    }
-
-    return 1;
-}
-
-sub process_rog_record
-{
-    my ($self,$file,$metadata,$song,$processor) = @_;
-
-    # create a new document
-    my $doc_obj = new doc ($file, "indexed_doc");
-    my $cursection = $doc_obj->get_top_section();
-    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
-
-    my $title = $song->{'title'};
-    my $title_safe = $title;
-    $title_safe =~ s/\'/\\\\&apos;/g;
-
-    # add metadata 
-    $doc_obj->add_metadata($cursection, "Tempo",         $song->{'tempo'}); 
-    $doc_obj->add_metadata($cursection, "KeySigType",    $song->{'ks_type'}); 
-    $doc_obj->add_metadata($cursection, "KeySigNum",     $song->{'ks_num'}); 
-    $doc_obj->add_metadata($cursection, "SubCollection", $song->{'subcol'}); 
-    $doc_obj->add_metadata($cursection, "Title",         $title); 
-    $doc_obj->add_metadata($cursection, "TitleSafe",     $title_safe); 
-    $doc_obj->add_metadata($cursection, "TVal",          $song->{'tval'}); 
-    $doc_obj->add_metadata($cursection, "FileFormat",    "Rog");
-    $doc_obj->add_metadata($cursection, "FileSize",      (-s $file));
-
-    foreach my $md ( @{$song->{'metadata'}} )
-    {
-	$doc_obj->add_metadata($cursection, $md->[0], $md->[1]); 
-    }
-
-    # add contents as text
-    $doc_obj->add_text($cursection,$song->{'content'});
-
-    $self->extra_metadata($doc_obj,$cursection, $metadata);
-    
-    # add OID
-    $doc_obj->set_OID ();
-
-    my $oid = $doc_obj->get_OID();
-    my $appletlink = "<a href=\"javascript:meldexout(\'$oid\','[TitleSafe]')\">";
-
-    $doc_obj->add_utf8_metadata ($cursection, "audiolink",  $appletlink); 
-    $doc_obj->add_utf8_metadata ($cursection, "audioicon",  "_iconaudio_"); 
-    $doc_obj->add_utf8_metadata ($cursection, "/audiolink", "</a>"); 
-
-    # process the document
-    $processor->process($doc_obj);
-}
-
-# return number of files processed, undef if can't process
-# Note that $base_dir might be "" and that $file might 
-# include directories
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    my $filename = &util::filename_cat($base_dir, $file);
-
-    return undef unless ($filename =~ /\.((rog|mdb)(\.gz)?)$/i && (-e $filename));
-
-    my $gz = (defined $3) ? 1: 0;
-
-    	print STDERR "<Processing n='$file' p='RogPlug'>\n" if ($gli);
-    print STDERR "RogPlug: processing $filename\n" if $processor->{'verbosity'};
-    
-    if ($gz) {
-	open (FILE, "zcat $filename |") 
-	    || die "RogPlug::read - zcat can't open $filename\n";
-    } else {
-	open (FILE, $filename) 
-	    || die "RogPlug::read - can't open $filename\n";
-    }
-
-    my $doc_count = 0;
-    my $dot_count = 0;
-    my $file_buffer = { line_no => 0, next_line => "", song => {} };
-
-    while ($self->read_rog_record($file_buffer))
-    {
-	$self->process_rog_record($file,$metadata,$file_buffer->{'song'},$processor);
-	$doc_count++;
-
-	last if ($maxdocs !=-1 && ($total_count+$doc_count) >= $maxdocs);
-	
-	if (($doc_count % 10) == 0)
-	{
-	    print STDERR ".";
-	    $dot_count++;
-	    print STDERR "\n" if (($dot_count % 80) == 0);
-	}
-    }
-
-    close FILE;
-
-    print STDERR "\n";
-
-    $self->{'num_processed'} = $doc_count;
-
-    return 1; # processed the file
-}
-
-1;
-
-
-
-
-
-
-
-
-
-
-
Index: /gsdl/trunk/perllib/plugins/RogPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/RogPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/RogPlugin.pm	(revision 15865)
@@ -0,0 +1,282 @@
+###########################################################################
+#
+# RogPlug.pm -- simple text plugin
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999 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.
+#
+###########################################################################
+
+# creates simple single-level document from .rog or .mdb files 
+
+package RogPlug;
+
+use BasPlug;
+use sorttools;
+use doc; 
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @RogPlug::ISA = ('BasPlug');
+}
+
+my $arguments = 
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'reqd' => "no",
+	'deft' => &get_default_process_exp() },
+      ];
+
+my $options = { 'name'     => "RogPlug",
+		'desc'     => "{RogPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args' => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+
+# This plugin processes files with the suffix ".mdb" or ".rog"
+sub get_default_process_exp {
+    return q^(?i)\.(mdb|rog)$^;
+}
+
+sub read_rog_record
+{
+    my ($self,$file_buffer, $seclevel) = @_;
+
+    my $next_line = $file_buffer->{'next_line'};
+
+    return 0 if (!defined $next_line);
+
+    if ($next_line eq "")
+    {
+	my $line;
+	while(defined($line=<FILE>))  
+	{
+	    $line =~ s/\r$//;
+	    $file_buffer->{'line_no'}++;
+	    next if ($line =~ m/^\#/);
+	    $next_line = $line;
+	    last;
+	}
+    }
+	    
+    if ($next_line !~ m/^song( +)\"([^\"]*)\"( +)\"([^\"]*)\"( +)(\d+)( *)$/) 
+    {
+	print STDERR "Error: Malformed Rog file: $next_line";
+	return 0;
+    }
+    else
+    {
+	# init default values
+	$file_buffer->{'song'}->{'tempo'}    = 120;
+	$file_buffer->{'song'}->{'ks_type'}  = 0;
+	$file_buffer->{'song'}->{'ks_num'}   = 0;
+	$file_buffer->{'song'}->{'metadata'} = [];
+	$file_buffer->{'song'}->{'content'}  = "";
+	
+	$file_buffer->{'song'}->{'subcol'} = $2;
+	$file_buffer->{'song'}->{'title'}  = $4;
+	$file_buffer->{'song'}->{'tval'}   = $6;
+
+	chomp($next_line);
+	my $content = $next_line;
+	if (defined $seclevel) 
+	{
+	    $content.= " $seclevel";
+	}
+	$content .= "\n";
+
+	$file_buffer->{'song'}->{'content'} = $content;
+
+
+	my $line;
+	while(defined($line=<FILE>))  
+	{
+	    $line =~ s/\r$//;
+
+	    $file_buffer->{'line_no'}++;
+	    next if ($line =~ m/^\#/);
+	
+	    if ($line =~ m/^song/) 
+	    {	
+		$file_buffer->{'next_line'} = $line;
+		return 1;
+	    }
+	    elsif ($line =~ m/^tempo( +)(\d+)( *)$/) 
+	    {
+		$file_buffer->{'song'}->{'tempo'} = $2;
+		$file_buffer->{'song'}->{'content'} .= $line;
+	    } 
+	    elsif ($line =~ m/^keysig( +)(\d+)( +)(\d+)( *)$/) 
+	    {
+		$file_buffer->{'song'}->{'ks_type'} = $2;
+		$file_buffer->{'song'}->{'ks_num'}  = $4;
+		$file_buffer->{'song'}->{'content'} .= $line;	   
+	    } 
+	    elsif ($line =~ m/^timesig( +)(\d+)( +)(\d+)( *)$/) 
+	    {
+		$file_buffer->{'song'}->{'ts_numer'} = $2;
+		$file_buffer->{'song'}->{'ts_denom'} = $4;
+		$file_buffer->{'song'}->{'content'} .= $line;
+	    }
+	    elsif ($line =~ m/^metadata ([^:]*): (.*)/)
+	    {
+		push(@{$file_buffer->{'song'}->{'metadata'}},[$1,$2]);
+		$file_buffer->{'song'}->{'content'} .= $line;
+	    }
+	    else
+	    {
+		$file_buffer->{'song'}->{'content'} .= $line;
+	    }
+	}
+	
+	$file_buffer->{'next_line'} = undef;
+    }
+
+    return 1;
+}
+
+sub process_rog_record
+{
+    my ($self,$file,$metadata,$song,$processor) = @_;
+
+    # create a new document
+    my $doc_obj = new doc ($file, "indexed_doc");
+    my $cursection = $doc_obj->get_top_section();
+    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
+
+    my $title = $song->{'title'};
+    my $title_safe = $title;
+    $title_safe =~ s/\'/\\\\&apos;/g;
+
+    # add metadata 
+    $doc_obj->add_metadata($cursection, "Tempo",         $song->{'tempo'}); 
+    $doc_obj->add_metadata($cursection, "KeySigType",    $song->{'ks_type'}); 
+    $doc_obj->add_metadata($cursection, "KeySigNum",     $song->{'ks_num'}); 
+    $doc_obj->add_metadata($cursection, "SubCollection", $song->{'subcol'}); 
+    $doc_obj->add_metadata($cursection, "Title",         $title); 
+    $doc_obj->add_metadata($cursection, "TitleSafe",     $title_safe); 
+    $doc_obj->add_metadata($cursection, "TVal",          $song->{'tval'}); 
+    $doc_obj->add_metadata($cursection, "FileFormat",    "Rog");
+    $doc_obj->add_metadata($cursection, "FileSize",      (-s $file));
+
+    foreach my $md ( @{$song->{'metadata'}} )
+    {
+	$doc_obj->add_metadata($cursection, $md->[0], $md->[1]); 
+    }
+
+    # add contents as text
+    $doc_obj->add_text($cursection,$song->{'content'});
+
+    $self->extra_metadata($doc_obj,$cursection, $metadata);
+    
+    # add OID
+    $doc_obj->set_OID ();
+
+    my $oid = $doc_obj->get_OID();
+    my $appletlink = "<a href=\"javascript:meldexout(\'$oid\','[TitleSafe]')\">";
+
+    $doc_obj->add_utf8_metadata ($cursection, "audiolink",  $appletlink); 
+    $doc_obj->add_utf8_metadata ($cursection, "audioicon",  "_iconaudio_"); 
+    $doc_obj->add_utf8_metadata ($cursection, "/audiolink", "</a>"); 
+
+    # process the document
+    $processor->process($doc_obj);
+}
+
+# return number of files processed, undef if can't process
+# Note that $base_dir might be "" and that $file might 
+# include directories
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    my $filename = &util::filename_cat($base_dir, $file);
+
+    return undef unless ($filename =~ /\.((rog|mdb)(\.gz)?)$/i && (-e $filename));
+
+    my $gz = (defined $3) ? 1: 0;
+
+    	print STDERR "<Processing n='$file' p='RogPlug'>\n" if ($gli);
+    print STDERR "RogPlug: processing $filename\n" if $processor->{'verbosity'};
+    
+    if ($gz) {
+	open (FILE, "zcat $filename |") 
+	    || die "RogPlug::read - zcat can't open $filename\n";
+    } else {
+	open (FILE, $filename) 
+	    || die "RogPlug::read - can't open $filename\n";
+    }
+
+    my $doc_count = 0;
+    my $dot_count = 0;
+    my $file_buffer = { line_no => 0, next_line => "", song => {} };
+
+    while ($self->read_rog_record($file_buffer))
+    {
+	$self->process_rog_record($file,$metadata,$file_buffer->{'song'},$processor);
+	$doc_count++;
+
+	last if ($maxdocs !=-1 && ($total_count+$doc_count) >= $maxdocs);
+	
+	if (($doc_count % 10) == 0)
+	{
+	    print STDERR ".";
+	    $dot_count++;
+	    print STDERR "\n" if (($dot_count % 80) == 0);
+	}
+    }
+
+    close FILE;
+
+    print STDERR "\n";
+
+    $self->{'num_processed'} = $doc_count;
+
+    return 1; # processed the file
+}
+
+1;
+
+
+
+
+
+
+
+
+
+
+
Index: dl/trunk/perllib/plugins/SRCPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/SRCPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,249 +1,0 @@
-###########################################################################
-#
-# SRCPlug.pm -- source code plugin
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999 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.
-#
-###########################################################################
-# John McPherson Nov 2000
-# originally based on TEXTPlug
-
-# filename is currently used for Title ( optionally minus some prefix )
-
-# Current languages:
-#   text: READMEs/Makefiles
-#   C/C++   (currently extracts #include statements and C++ class decls)
-#   Perl    (currently only done as text)
-#   Shell   (currently only done as text)
-
-# 12/05/02 Added usage datastructure - John Thompson
-
-package SRCPlug;
-
-use BasPlug;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @SRCPlug::ISA = ('BasPlug');
-}
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" } ,
-      { 'name' => "block_exp",
-	'desc' => "{BasPlug.block_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_block_exp(),
-	'reqd' => "no" },
-      { 'name' => "remove_prefix",
-	'desc' => "{SRCPlug.remove_prefix}",
-	'type' => "regexp",
-	'deft' => "^.*[/\\]",
-	'reqd' => "no" } ];
-
-my $options = { 'name'     => "SRCPlug",
-		'desc'     => "{SRCPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-sub get_default_block_exp {
-    my $self = shift (@_);
-
-    return q^(?i)\.(o|obj|a|so|dll)$^;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-#    return q^(?i)\.te?xt$^;
-    return q^(Makefile.*|README.*|(?i)\.(c|cc|cpp|C|h|hpp|pl|pm|sh))$^;
-}
-
-
-
-# do plugin specific processing of doc_obj
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-    
-    	print STDERR "<Processing n='$file' p='SRCPlug'>\n" if ($gli);
-    print $outhandle "SRCPlug: processing $file\n" 
-	if $self->{'verbosity'} > 1;
-    
-    my $cursection = $doc_obj->get_top_section();
-
-    my $filetype="text";  # Makefiles, READMEs, ...
-    if ($file =~ /\.(cc|h|cpp|C)$/) {$filetype="C++";} # assume all .h files...
-    elsif ($file =~ /\.c$/)         {$filetype="C";}
-    elsif ($file =~ /\.p(l|m)$/)    {$filetype="perl";}
-    elsif ($file =~ /\.sh$/)        {$filetype="sh";}
-
-    # modify '<' and '>' for GML... (even though inside <pre> tags!!)
-    $$textref =~ s/</&lt;/g;
-    $$textref =~ s/>/&gt;/g;
-    $$textref =~ s/_/&#95;/g;
-    # try _escape_text($text) from doc.pm....
-
-    # don't want mg to turn escape chars into actual values
-    $$textref =~ s/\\/\\\\/g;
-
-    # use filename (minus any prefix) as the title.
-    my $title;
-    if ($self->{'remove_prefix' ne ""}) {
-	($title = $file) =~ s/^$self->{'remove_prefix'}//;
-    } else {
-	($title = $file) =~ s@^.*[/\\]@@; # remove pathname by default
-    }
-    $doc_obj->add_utf8_metadata ($cursection, "Title", $title);
-    $doc_obj->add_metadata ($cursection, "FileFormat", "SRC");
-
-    # remove the gsdl prefix from the filename
-    my $relative_filename=$file;
-    $relative_filename =~ s@^.*?gsdl[/\\]@@;
-    $doc_obj->add_utf8_metadata ($cursection, "filename", $relative_filename);
-
-    # class information from .h and .cc and .C and .cpp files
-    if ($filetype eq "C++") 
-    {
-	process_c_plus_plus($textref,$pluginfo, $base_dir, 
-				   $file, $metadata, $doc_obj);
-    } elsif ($filetype eq "C")
-    {
-	get_includes_metadata($textref, $doc_obj);
-    }
-
-
-     # default operation...
-     # insert preformat tags and add text to document object
-    $doc_obj->add_utf8_text($cursection, "<pre>\n$$textref\n</pre>");
-    
-    return 1;
-}
-
-
-
-
-sub get_includes_metadata {
-    my ($textref, $doc_obj) = @_;
-    
-    my $topsection = $doc_obj->get_top_section();
-
-    # Get '#include' directives for metadata
-    if ($$textref !~ /\#\s*include\b/) {
-	return;
-    }
-
-    my @includes =
-	($$textref =~ m/^\s*\#\s*include\s*(?:\"|&lt;)(.*?)(?:\"|&gt;)/mg);
-    
-    my $incs_done_ref=$doc_obj->get_metadata($topsection, "includes");
-    my @incs_done;
-    if (defined($incs_done_ref)) {
-	@incs_done=@$incs_done_ref;
-    } else {
-	@incs_done=();
-    }
-
-    foreach my $inc (@includes) {
-	# add entries, but only if they don't already exist
-	if (!join('', map {$_ eq "$inc"?1:""} @incs_done)) {
-	    push @incs_done, $inc;
-	    $doc_obj->add_utf8_metadata($topsection, "includes", $inc);
-	}
-    }
-}
-
-
-
-sub process_c_plus_plus {
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
-
-    my $topsection = $doc_obj->get_top_section();
-
-
-    # Check for include metadata
-    get_includes_metadata($textref, $doc_obj);
-
-
-
-    # Get class declarations (but not forward declarations...) as metadata
-    if ($$textref =~ /\bclass\b/ ) {
-	my $classnames=$$textref;
-	
-	# remove commented lines
-	$classnames =~ s@/\*.*?\*/@@sg;
-	$classnames =~ s@//.*$@@mg;
-	while ($classnames =~ /\bclass\b/) {
-
-	    # delete all lines up to the next "class"
-	    while ($classnames !~ /^[^\n]*\bclass\b[^\n]*\n/)
-	    {$classnames =~ s/.*\n//;}
-	    
-#	    $classnames =~ s/^([^c][^l])*(.)?$//mg; # delete unneccessary lines
-
-	    # get the line including the next "class" and remove it from
-	    # our tmp text.
-	    $classnames =~ s/^(.*\bclass\b.*)$//m;
-
-	    # don't index if merely a reference/fwd decl. of another class
-	    if ($1 !~ /(friend\Wclass)|(class\W\w+\W?\;)|(\/\/.*class)/) {
-		# $1 is still the whole line - eg:
-		# "class StaffSystem: public BaseStaffSystem"
-		my $wholeline=$1;
-		my $classname=$1;
-		$classname =~ s/.*class\W(\w+).*/$1/;
-		my $classes=$doc_obj->get_metadata($topsection, "class");
-		foreach my $elem (@$classes) {
-		    if ("$elem" eq "$classname") {goto class_done;}
-		}
-		$doc_obj->add_utf8_metadata($topsection, "class", $classname);
-	      class_done:
-		$doc_obj->add_utf8_metadata($topsection, "classdecl", $wholeline);
-	    }
-	}
-    } # end of "class"
-
-    return 1;
-}
-
-1;
-
Index: /gsdl/trunk/perllib/plugins/SourceCodePlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/SourceCodePlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/SourceCodePlugin.pm	(revision 15865)
@@ -0,0 +1,249 @@
+###########################################################################
+#
+# SRCPlug.pm -- source code plugin
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999 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.
+#
+###########################################################################
+# John McPherson Nov 2000
+# originally based on TEXTPlug
+
+# filename is currently used for Title ( optionally minus some prefix )
+
+# Current languages:
+#   text: READMEs/Makefiles
+#   C/C++   (currently extracts #include statements and C++ class decls)
+#   Perl    (currently only done as text)
+#   Shell   (currently only done as text)
+
+# 12/05/02 Added usage datastructure - John Thompson
+
+package SRCPlug;
+
+use BasPlug;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @SRCPlug::ISA = ('BasPlug');
+}
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" } ,
+      { 'name' => "block_exp",
+	'desc' => "{BasPlug.block_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_block_exp(),
+	'reqd' => "no" },
+      { 'name' => "remove_prefix",
+	'desc' => "{SRCPlug.remove_prefix}",
+	'type' => "regexp",
+	'deft' => "^.*[/\\]",
+	'reqd' => "no" } ];
+
+my $options = { 'name'     => "SRCPlug",
+		'desc'     => "{SRCPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+sub get_default_block_exp {
+    my $self = shift (@_);
+
+    return q^(?i)\.(o|obj|a|so|dll)$^;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+#    return q^(?i)\.te?xt$^;
+    return q^(Makefile.*|README.*|(?i)\.(c|cc|cpp|C|h|hpp|pl|pm|sh))$^;
+}
+
+
+
+# do plugin specific processing of doc_obj
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+    
+    	print STDERR "<Processing n='$file' p='SRCPlug'>\n" if ($gli);
+    print $outhandle "SRCPlug: processing $file\n" 
+	if $self->{'verbosity'} > 1;
+    
+    my $cursection = $doc_obj->get_top_section();
+
+    my $filetype="text";  # Makefiles, READMEs, ...
+    if ($file =~ /\.(cc|h|cpp|C)$/) {$filetype="C++";} # assume all .h files...
+    elsif ($file =~ /\.c$/)         {$filetype="C";}
+    elsif ($file =~ /\.p(l|m)$/)    {$filetype="perl";}
+    elsif ($file =~ /\.sh$/)        {$filetype="sh";}
+
+    # modify '<' and '>' for GML... (even though inside <pre> tags!!)
+    $$textref =~ s/</&lt;/g;
+    $$textref =~ s/>/&gt;/g;
+    $$textref =~ s/_/&#95;/g;
+    # try _escape_text($text) from doc.pm....
+
+    # don't want mg to turn escape chars into actual values
+    $$textref =~ s/\\/\\\\/g;
+
+    # use filename (minus any prefix) as the title.
+    my $title;
+    if ($self->{'remove_prefix' ne ""}) {
+	($title = $file) =~ s/^$self->{'remove_prefix'}//;
+    } else {
+	($title = $file) =~ s@^.*[/\\]@@; # remove pathname by default
+    }
+    $doc_obj->add_utf8_metadata ($cursection, "Title", $title);
+    $doc_obj->add_metadata ($cursection, "FileFormat", "SRC");
+
+    # remove the gsdl prefix from the filename
+    my $relative_filename=$file;
+    $relative_filename =~ s@^.*?gsdl[/\\]@@;
+    $doc_obj->add_utf8_metadata ($cursection, "filename", $relative_filename);
+
+    # class information from .h and .cc and .C and .cpp files
+    if ($filetype eq "C++") 
+    {
+	process_c_plus_plus($textref,$pluginfo, $base_dir, 
+				   $file, $metadata, $doc_obj);
+    } elsif ($filetype eq "C")
+    {
+	get_includes_metadata($textref, $doc_obj);
+    }
+
+
+     # default operation...
+     # insert preformat tags and add text to document object
+    $doc_obj->add_utf8_text($cursection, "<pre>\n$$textref\n</pre>");
+    
+    return 1;
+}
+
+
+
+
+sub get_includes_metadata {
+    my ($textref, $doc_obj) = @_;
+    
+    my $topsection = $doc_obj->get_top_section();
+
+    # Get '#include' directives for metadata
+    if ($$textref !~ /\#\s*include\b/) {
+	return;
+    }
+
+    my @includes =
+	($$textref =~ m/^\s*\#\s*include\s*(?:\"|&lt;)(.*?)(?:\"|&gt;)/mg);
+    
+    my $incs_done_ref=$doc_obj->get_metadata($topsection, "includes");
+    my @incs_done;
+    if (defined($incs_done_ref)) {
+	@incs_done=@$incs_done_ref;
+    } else {
+	@incs_done=();
+    }
+
+    foreach my $inc (@includes) {
+	# add entries, but only if they don't already exist
+	if (!join('', map {$_ eq "$inc"?1:""} @incs_done)) {
+	    push @incs_done, $inc;
+	    $doc_obj->add_utf8_metadata($topsection, "includes", $inc);
+	}
+    }
+}
+
+
+
+sub process_c_plus_plus {
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
+
+    my $topsection = $doc_obj->get_top_section();
+
+
+    # Check for include metadata
+    get_includes_metadata($textref, $doc_obj);
+
+
+
+    # Get class declarations (but not forward declarations...) as metadata
+    if ($$textref =~ /\bclass\b/ ) {
+	my $classnames=$$textref;
+	
+	# remove commented lines
+	$classnames =~ s@/\*.*?\*/@@sg;
+	$classnames =~ s@//.*$@@mg;
+	while ($classnames =~ /\bclass\b/) {
+
+	    # delete all lines up to the next "class"
+	    while ($classnames !~ /^[^\n]*\bclass\b[^\n]*\n/)
+	    {$classnames =~ s/.*\n//;}
+	    
+#	    $classnames =~ s/^([^c][^l])*(.)?$//mg; # delete unneccessary lines
+
+	    # get the line including the next "class" and remove it from
+	    # our tmp text.
+	    $classnames =~ s/^(.*\bclass\b.*)$//m;
+
+	    # don't index if merely a reference/fwd decl. of another class
+	    if ($1 !~ /(friend\Wclass)|(class\W\w+\W?\;)|(\/\/.*class)/) {
+		# $1 is still the whole line - eg:
+		# "class StaffSystem: public BaseStaffSystem"
+		my $wholeline=$1;
+		my $classname=$1;
+		$classname =~ s/.*class\W(\w+).*/$1/;
+		my $classes=$doc_obj->get_metadata($topsection, "class");
+		foreach my $elem (@$classes) {
+		    if ("$elem" eq "$classname") {goto class_done;}
+		}
+		$doc_obj->add_utf8_metadata($topsection, "class", $classname);
+	      class_done:
+		$doc_obj->add_utf8_metadata($topsection, "classdecl", $wholeline);
+	    }
+	}
+    } # end of "class"
+
+    return 1;
+}
+
+1;
+
Index: dl/trunk/perllib/plugins/SplitPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/SplitPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,290 +1,0 @@
-###########################################################################
-#
-# SplitPlug.pm - a plugin for splitting input files into segments that
-#                will then be individually processed.
-#
-#
-# Copyright 2000 Gordon W. Paynter (gwp@cs.waikato.ac.nz)
-# Copyright 2000 The New Zealand Digital Library Project
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# 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.
-#
-###########################################################################
-
-
-# SplitPlug is a plugin for splitting input files into segments that will
-# then be individually processed.  
-
-# This plugin should not be called directly.  Instead, if you need to
-# process input files that contain several documents, you should write a
-# plugin with a process function that will handle one of those documents
-# and have it inherit from SplitPlug.  See ReferPlug for an example.
-
-
-package SplitPlug;
-
-use BasPlug;
-use gsprintf 'gsprintf';
-use util;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-# SplitPlug is a sub-class of BasPlug.
-sub BEGIN {
-    @SplitPlug::ISA = ('BasPlug');
-}
-
-
-my $arguments =
-    [ { 'name' => "split_exp",
-	'desc' => "{SplitPlug.split_exp}",
-	'type' => "regexp",
-	#'deft' => &get_default_split_exp(),
-	'deft' => "",
-	'reqd' => "no" } ];
-
-my $options = { 'name'     => "SplitPlug",
-		'desc'     => "{SplitPlug.desc}",
-		'abstract' => "yes",
-		'inherits' => "yes",
-	        'args'     => $arguments };
-
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    $self->{'textcat_store'} = {};
-    $self->{'metapass_srcdoc'} = {}; # which segments have valid metadata_srcdoc
-    return bless $self, $class;
-}
-
-sub init {
-    my $self = shift (@_);
-    my ($verbosity, $outhandle, $failhandle) = @_;
-
-    $self->BasPlug::init($verbosity, $outhandle, $failhandle);
-
-    if ((!defined $self->{'process_exp'}) || ($self->{'process_exp'} eq "")) {
-
-	$self->{'process_exp'} = $self->get_default_process_exp ();
-	if ($self->{'process_exp'} eq "") {
-	    warn ref($self) . " Warning: plugin has no process_exp\n";
-	}
-    }
-
-
-    # set split_exp to default unless explicitly set
-    if (!$self->{'split_exp'}) {
-	$self->{'split_exp'} = $self->get_default_split_exp ();
-    }
-
-}
-
-# This plugin recurs over the segments it finds
-sub is_recursive {
-    return 1;
-}
-
-# By default, we split the input text at blank lines
-sub get_default_split_exp {
-    return q^\n\s*\n^;
-}
-
-sub metadata_read {
-    my $self = shift (@_);  
-    my ($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli) = @_;
-
-    my $matched = $self->SUPER::metadata_read($pluginfo, $base_dir, $file, 
-					      $metadata, $extrametakeys, 
-					      $extrametadata, $processor, 
-					      $maxdocs, $gli);
-    my $split_matched = undef;
-
-    if ($matched) {
-
-	my $outhandle = $self->{'outhandle'};
-	my $filename = &util::filename_cat($base_dir, $file);
-
-	my $plugin_name = ref ($self);
-	$file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
-
-	$self->{'metapass_srcdoc'}->{$file} = {};
-
-	# Do encoding stuff
-	my ($language, $encoding) = $self->textcat_get_language_encoding ($filename);
-	my $le_rec = { 'language' => $language, 'encoding' => $encoding };
-	$self->{'textcat_store'}->{$file} = $le_rec;
-
-	# Read in file ($text will be in utf8)
-	my $text = "";
-	$self->read_file ($filename, $encoding, $language, \$text);
-
- 
-	if ($text !~ /\w/) {
-	    gsprintf($outhandle, "$plugin_name: {BasPlug.file_has_no_text}\n",
-		     $file)
-		if $self->{'verbosity'};
-	    
-	    my $failhandle = $self->{'failhandle'};
-	    print $failhandle "$file: " . ref($self) . ": file contains no text\n";
-	    $self->{'num_not_processed'} ++;
-
-	    $self->{'textcat_store'}->{$file} = undef;
-
-	    return 0; 
-	}
-    
-    
-	# Split the text into several smaller segments
-	my $split_exp = $self->{'split_exp'};
-        my @tmp  = split(/$split_exp/i, $text);
-	my @segments =();
-	## get rid of empty segments
-	foreach my $seg (@tmp){
-	    if ($seg ne ""){
-		push @segments, $seg;
-	    }
-	}
-
-	print $outhandle "SplitPlug found " . (scalar @segments) . " documents in $filename\n" 
-	    if $self->{'verbosity'};
-	
-	$self->{'split_segments'}->{$file} = \@segments;
-	$split_matched = scalar(@segments);
-    }
-    
-    return $split_matched;
-}
-
-
-
-# The read function opens a file and splits it into parts. 
-# Each part is sent to the process function
-#
-# Returns: Number of document objects created (or undef if it fails)
-
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-    my $verbosity = $self->{'verbosity'};
-
-    #check process and block exps, smart block, etc
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-
-    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
-
-    my $le_rec = $self->{'textcat_store'}->{$file};
-    if (!defined $le_rec) {
-	# means no text was found;
-	return 0; # not processed but no point in passing it on
-    }
-
-    my $language = $le_rec->{'language'};
-    my $encoding = $le_rec->{'encoding'};
-    $self->{'textcat_store'}->{$file} = undef;
-
-    my $segments = $self->{'split_segments'}->{$file};
-    $self->{'split_segments'}->{$file} = undef;
-
-    # Process each segment in turn
-    my ($count, $segment, $segtext, $status, $id);
-    $segment = 0;
-    $count = 0;
-    foreach $segtext (@$segments) {
-     	$segment++;
-
-	if (defined $self->{'metapass_srcdoc'}->{$file}->{$segment}) {
-	    # metadata is attached to a srcdoc
-	    next;
-	}
-
-	# create a new document
-	my $doc_obj = new doc ($filename, "indexed_doc");
-	$doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
-	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Language", $language);
-	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Encoding", $encoding);
-	my ($filemeta) = $file =~ /([^\\\/]+)$/;
-	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Source", &ghtml::dmsafe($filemeta));
-	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "SourceSegment", "$segment");
-	if ($self->{'cover_image'}) {
-	    $self->associate_cover_image($doc_obj, $filename);
-	}
-	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
-	#$doc_obj->add_metadata($doc_obj->get_top_section(), "FileFormat", "Split");
-
-	# Calculate a "base" document ID.
-	if (!defined $id) {
-	    $doc_obj->set_OID();
-	    $id = $doc_obj->get_OID();
-	}
-    
-	# include any metadata passed in from previous plugins 
-	# note that this metadata is associated with the top level section
-	$self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
-
-	# do plugin specific processing of doc_obj
-	print $outhandle "segment $segment - " if ($self->{'verbosity'});
-	$status = $self->process (\$segtext, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli);
-	if (!defined $status) {
-	    print $outhandle "WARNING - no plugin could process segment $segment of $file\n" 
-		if ($verbosity >= 2);
-	    next;
-	}
-	# If the plugin returned 0, it threw away this part
-	if ($status == 0) {
-	    next;
-	}
-	$count += $status;
-
-	# do any automatic metadata extraction
-	$self->auto_extract_metadata ($doc_obj);
-
-	# add an OID
-	$self->set_OID($doc_obj, $id, $segment);
-
-	# process the document
-	$processor->process($doc_obj);
-
-	$self->{'num_processed'} ++;
-    }
-
-    delete $self->{'metapass_srcdoc'}->{$file};
-
-    # Return number of document objects produced
-    return $count; 
-}
-
-sub set_OID {
-    my $self = shift (@_);
-    my ($doc_obj, $id, $segment_number) = @_;
-    
-    $doc_obj->set_OID($id . "s" . $segment_number);
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/SplitTextFile.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/SplitTextFile.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/SplitTextFile.pm	(revision 15865)
@@ -0,0 +1,290 @@
+###########################################################################
+#
+# SplitPlug.pm - a plugin for splitting input files into segments that
+#                will then be individually processed.
+#
+#
+# Copyright 2000 Gordon W. Paynter (gwp@cs.waikato.ac.nz)
+# Copyright 2000 The New Zealand Digital Library Project
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# 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.
+#
+###########################################################################
+
+
+# SplitPlug is a plugin for splitting input files into segments that will
+# then be individually processed.  
+
+# This plugin should not be called directly.  Instead, if you need to
+# process input files that contain several documents, you should write a
+# plugin with a process function that will handle one of those documents
+# and have it inherit from SplitPlug.  See ReferPlug for an example.
+
+
+package SplitPlug;
+
+use BasPlug;
+use gsprintf 'gsprintf';
+use util;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+# SplitPlug is a sub-class of BasPlug.
+sub BEGIN {
+    @SplitPlug::ISA = ('BasPlug');
+}
+
+
+my $arguments =
+    [ { 'name' => "split_exp",
+	'desc' => "{SplitPlug.split_exp}",
+	'type' => "regexp",
+	#'deft' => &get_default_split_exp(),
+	'deft' => "",
+	'reqd' => "no" } ];
+
+my $options = { 'name'     => "SplitPlug",
+		'desc'     => "{SplitPlug.desc}",
+		'abstract' => "yes",
+		'inherits' => "yes",
+	        'args'     => $arguments };
+
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    $self->{'textcat_store'} = {};
+    $self->{'metapass_srcdoc'} = {}; # which segments have valid metadata_srcdoc
+    return bless $self, $class;
+}
+
+sub init {
+    my $self = shift (@_);
+    my ($verbosity, $outhandle, $failhandle) = @_;
+
+    $self->BasPlug::init($verbosity, $outhandle, $failhandle);
+
+    if ((!defined $self->{'process_exp'}) || ($self->{'process_exp'} eq "")) {
+
+	$self->{'process_exp'} = $self->get_default_process_exp ();
+	if ($self->{'process_exp'} eq "") {
+	    warn ref($self) . " Warning: plugin has no process_exp\n";
+	}
+    }
+
+
+    # set split_exp to default unless explicitly set
+    if (!$self->{'split_exp'}) {
+	$self->{'split_exp'} = $self->get_default_split_exp ();
+    }
+
+}
+
+# This plugin recurs over the segments it finds
+sub is_recursive {
+    return 1;
+}
+
+# By default, we split the input text at blank lines
+sub get_default_split_exp {
+    return q^\n\s*\n^;
+}
+
+sub metadata_read {
+    my $self = shift (@_);  
+    my ($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli) = @_;
+
+    my $matched = $self->SUPER::metadata_read($pluginfo, $base_dir, $file, 
+					      $metadata, $extrametakeys, 
+					      $extrametadata, $processor, 
+					      $maxdocs, $gli);
+    my $split_matched = undef;
+
+    if ($matched) {
+
+	my $outhandle = $self->{'outhandle'};
+	my $filename = &util::filename_cat($base_dir, $file);
+
+	my $plugin_name = ref ($self);
+	$file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
+
+	$self->{'metapass_srcdoc'}->{$file} = {};
+
+	# Do encoding stuff
+	my ($language, $encoding) = $self->textcat_get_language_encoding ($filename);
+	my $le_rec = { 'language' => $language, 'encoding' => $encoding };
+	$self->{'textcat_store'}->{$file} = $le_rec;
+
+	# Read in file ($text will be in utf8)
+	my $text = "";
+	$self->read_file ($filename, $encoding, $language, \$text);
+
+ 
+	if ($text !~ /\w/) {
+	    gsprintf($outhandle, "$plugin_name: {BasPlug.file_has_no_text}\n",
+		     $file)
+		if $self->{'verbosity'};
+	    
+	    my $failhandle = $self->{'failhandle'};
+	    print $failhandle "$file: " . ref($self) . ": file contains no text\n";
+	    $self->{'num_not_processed'} ++;
+
+	    $self->{'textcat_store'}->{$file} = undef;
+
+	    return 0; 
+	}
+    
+    
+	# Split the text into several smaller segments
+	my $split_exp = $self->{'split_exp'};
+        my @tmp  = split(/$split_exp/i, $text);
+	my @segments =();
+	## get rid of empty segments
+	foreach my $seg (@tmp){
+	    if ($seg ne ""){
+		push @segments, $seg;
+	    }
+	}
+
+	print $outhandle "SplitPlug found " . (scalar @segments) . " documents in $filename\n" 
+	    if $self->{'verbosity'};
+	
+	$self->{'split_segments'}->{$file} = \@segments;
+	$split_matched = scalar(@segments);
+    }
+    
+    return $split_matched;
+}
+
+
+
+# The read function opens a file and splits it into parts. 
+# Each part is sent to the process function
+#
+# Returns: Number of document objects created (or undef if it fails)
+
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+    my $verbosity = $self->{'verbosity'};
+
+    #check process and block exps, smart block, etc
+    my ($block_status,$filename) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+
+    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
+
+    my $le_rec = $self->{'textcat_store'}->{$file};
+    if (!defined $le_rec) {
+	# means no text was found;
+	return 0; # not processed but no point in passing it on
+    }
+
+    my $language = $le_rec->{'language'};
+    my $encoding = $le_rec->{'encoding'};
+    $self->{'textcat_store'}->{$file} = undef;
+
+    my $segments = $self->{'split_segments'}->{$file};
+    $self->{'split_segments'}->{$file} = undef;
+
+    # Process each segment in turn
+    my ($count, $segment, $segtext, $status, $id);
+    $segment = 0;
+    $count = 0;
+    foreach $segtext (@$segments) {
+     	$segment++;
+
+	if (defined $self->{'metapass_srcdoc'}->{$file}->{$segment}) {
+	    # metadata is attached to a srcdoc
+	    next;
+	}
+
+	# create a new document
+	my $doc_obj = new doc ($filename, "indexed_doc");
+	$doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});
+	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Language", $language);
+	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Encoding", $encoding);
+	my ($filemeta) = $file =~ /([^\\\/]+)$/;
+	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Source", &ghtml::dmsafe($filemeta));
+	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "SourceSegment", "$segment");
+	if ($self->{'cover_image'}) {
+	    $self->associate_cover_image($doc_obj, $filename);
+	}
+	$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
+	#$doc_obj->add_metadata($doc_obj->get_top_section(), "FileFormat", "Split");
+
+	# Calculate a "base" document ID.
+	if (!defined $id) {
+	    $doc_obj->set_OID();
+	    $id = $doc_obj->get_OID();
+	}
+    
+	# include any metadata passed in from previous plugins 
+	# note that this metadata is associated with the top level section
+	$self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
+
+	# do plugin specific processing of doc_obj
+	print $outhandle "segment $segment - " if ($self->{'verbosity'});
+	$status = $self->process (\$segtext, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli);
+	if (!defined $status) {
+	    print $outhandle "WARNING - no plugin could process segment $segment of $file\n" 
+		if ($verbosity >= 2);
+	    next;
+	}
+	# If the plugin returned 0, it threw away this part
+	if ($status == 0) {
+	    next;
+	}
+	$count += $status;
+
+	# do any automatic metadata extraction
+	$self->auto_extract_metadata ($doc_obj);
+
+	# add an OID
+	$self->set_OID($doc_obj, $id, $segment);
+
+	# process the document
+	$processor->process($doc_obj);
+
+	$self->{'num_processed'} ++;
+    }
+
+    delete $self->{'metapass_srcdoc'}->{$file};
+
+    # Return number of document objects produced
+    return $count; 
+}
+
+sub set_OID {
+    my $self = shift (@_);
+    my ($doc_obj, $id, $segment_number) = @_;
+    
+    $doc_obj->set_OID($id . "s" . $segment_number);
+}
+
+1;
Index: dl/trunk/perllib/plugins/StructuredHTMLPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/StructuredHTMLPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,405 +1,0 @@
-###########################################################################
-#
-# StructuredHTMLPlug.pm -- html plugin with extra facilities for teasing out 
-# hierarchical structure (such as h1, h2, h3, or user-defined tags) in an 
-# HTML document
-#
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999 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.
-#
-###########################################################################
-# This plugin is to process an HTML file where sections are divided by 
-# user-defined headings tags. As it is difficult to predict what user's definition
-# this plugin allows to detect the user-defined titles up to three levels (level1, level2, level3...)
-# as well as allows to get rid of user-defined Table of Content (TOC)...
-# format:e.g. level1 (Abstract_title|ChapterTitle|Referencing Heading) level2(SectionHeading)...
-
-package StructuredHTMLPlug;
-
-use HTMLPlug;
-use ImagePlug;
-
-#use strict; # every perl program should have this!
-#no strict 'refs'; # make an exception so we can use variables as filehandles
-
-sub BEGIN {
-    @StructuredHTMLPlug::ISA = ('HTMLPlug');
-}
-
-my $arguments = 
-    [
-     { 'name' => "level1_header",
-       'desc' => "{StructuredHTMLPlug.level1_header}",
-       'type' => "regexp",
-       'reqd' => "no",
-       'deft' => "" },
-     { 'name' => "level2_header",
-       'desc' => "{StructuredHTMLPlug.level2_header}",
-       'type' => "regexp",
-       'reqd' => "no",
-       'deft' => "" },
-     { 'name' => "level3_header",
-       'desc' => "{StructuredHTMLPlug.level3_header}",
-       'type' => "regexp",
-       'reqd' => "no",
-       'deft' => "" },
-     { 'name' => "title_header",
-       'desc' => "{StructuredHTMLPlug.title_header}",
-       'type' => "regexp",
-       'reqd' => "no",
-       'deft' => "" },
-     { 'name' => "delete_toc",
-       'desc' => "{StructuredHTMLPlug.delete_toc}",
-       'type' => "flag",
-       'reqd' => "no"},
-     { 'name' => "toc_header",
-       'desc' => "{StructuredHTMLPlug.toc_header}",
-       'type' => "regexp",
-       'reqd' => "no",
-       'deft' => "" }     
-     ];
-
-my $options = { 'name'     => "StructuredHTMLPlug",
-		'desc'     => "{StructuredHTMLPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-    
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-    
-    my $self = new HTMLPlug($pluginlist, $inputargs, $hashArgOptLists);
-    
-    return bless $self, $class;
-}
-
-
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    print $outhandle "StructuredHTMLPlug: processing $file\n"
-        if $self->{'verbosity'} > 1;
-    
-    my @head_and_body = split(/<body/i,$$textref);
-    my $head = shift(@head_and_body);
-    my $body_text = join("<body", @head_and_body);
-    $head =~ m/<title>(.+)<\/title>/i;
-    my $doctitle = $1 if defined $1;
-    if (defined $self->{'metadata_fields'} && $self->{'metadata_fields'}=~ /\S/) {
-	my @doc_properties = split(/<xml>/i,$head);
-	my $doc_heading = shift(@doc_properties);
-	my $rest_doc_properties = join(" ", @doc_properties);
-
-	my @extracted_metadata = split(/<\/xml>/i, $rest_doc_properties);
-	my $extracted_metadata = shift (@extracted_metadata);
-	$self->extract_metadata($extracted_metadata, $metadata, $doc_obj);
-    }
-    
-    # set the title here if we haven't found it yet
-    if (!defined $doc_obj->get_metadata_element ($doc_obj->get_top_section(), "Title")) {
-	if (defined $doctitle && $doctitle =~ /\S/) {
-	    $doc_obj->add_metadata($doc_obj->get_top_section(), "Title", $doctitle);
-	} else {
-	    $self->title_fallback($doc_obj,$doc_obj->get_top_section(),$file);
-	}
-    }
-
-    # If delete_toc is enabled, it means to get rid of toc and tof contents.
-    # get rid of TOC and TOF sections and their title
-    if (defined $self->{'delete_toc'} && ($self->{'delete_toc'} == 1)){
-	if (defined $self->{'toc_header'}&& $self->{'toc_header'} =~ /\S/){
-	    $body_text =~ s/<p class=(($self->{'toc_header'})[^>]*)>(.+?)<\/p>//isg;
-	}
-    }
-    
-    if (defined $self->{'title_header'} && $self->{'title_header'}=~ /\S/){
-	$self->{'title_header'} =~ s/^(\()(.*)(\))/$2/is;
-	$body_text =~ s/<p class=(($self->{'title_header'})[^>]*)>(.+?)<\/p>/<p class=$1><h1>$3<\/h1><\/p>/isg;
-    }
-
-    if (defined $self->{'level1_header'} && $self->{'level1_header'}=~ /\S/ ){
-     	$self->{'level1_header'} =~ s/^\((.*)\)/$1/i;
-	$body_text =~ s/<p class=(($self->{'level1_header'})[^>]*)>(.+?)<\/p>/<p class=$1><h1>$3<\/h1><\/p>/isg;
-    }
-    
-    if (defined $self->{'level2_header'} && $self->{'level2_header'}=~ /\S/){
-	$self->{'level2_header'} =~ s/^\((.*)\)/$1/i;
-	$body_text =~ s/<p class=(($self->{'level2_header'})[^>]*)>(.+?)<\/p>/<p class=$1><h2>$3<\/h2><\/p>/isg;
-    }
-    
-    if (defined $self->{'level3_header'} && $self->{'level3_header'}=~ /\S/ ){
-	$self->{'level3_header'} =~ s/^\((.*)\)/$1/is;
-	$body_text =~ s/<p class=(($self->{'level3_header'})[^>]*)>(.+?)<\/p>/<p class=$1><h3>$3<\/h3><\/p>/isg;
-    }
-    
-    # Tidy up extra new lines
-    $body_text =~ s/(<p[^>]*><span[^>]*><o:p>&nbsp;<\/o:p><\/span><\/p>)//isg;
-    $body_text =~ s/(<p[^>]*><o:p>&nbsp;<\/o:p><\/p>)//isg;
-    
-    $section_text .= "<!--\n<Section>\n-->\n";
-    #my $top_section_tag = "<!--\n<Section>\n-->\n";
-    #$body_text =~ s/(<div.*)/$top_section_text$doctitle$1/i;
-    #$body_text =~ s/(<div.*)/$top_section_tag$1/i;
-    my $body = "<body".$body_text;
-    
-    my $section_text = $head;
-    
-    # split HTML text on <h1>, <h2> etc tags
-    my @h_split = split(/<h/i,$body);
-    
-    my $hnum = 0;
-
-    my $sectionh1 = 0;
-    $section_text .= shift(@h_split);
-    
-    my $hc;
-    foreach $hc ( @h_split )
-    {
-	if ($hc =~ m/^([1-3])\s*.*?>(.*)$/s)
-	{
-	    my $new_hnum = $1;
-	    my $hc_after = $2;
-	    
-	    if ($hc_after =~ m/^(.*?)<\/h$new_hnum>/is)
-	    {
-		my $h_text = $1;
-		$hc =~ s/^(\&nbsp\;)+/\&nbsp\;/g;
-		# boil HTML down to some interesting text
-		$h_text =~ s/^[1-3]>//;
-		$h_text =~ s/<\/?.*?>//sg;
-		$h_text =~ s/\s+/ /sg;
-		$h_text =~ s/^\s$//s;
-		$h_text =~ s/(&nbsp;)+\W*/&nbsp;/sg;
-		
-		if ($h_text =~ m/\w+/)
-		{
-		    if ($new_hnum > $hnum)
-		    {
-			# increase section nesting
-			$hnum++;
-			while ($hnum < $new_hnum)
-			{
-			    my $spacing = "  " x $hnum;
-			    $section_text .= "<!--\n";
-			    $section_text .= $spacing."<Section>\n";
-			    $section_text .= "-->\n";
-			    $hnum++;
-			}
-		    }
-		    else # ($new_hnum <= $hnum)
-		    {
-			# descrease section nesting
-			while ($hnum >= $new_hnum)
-			{
-			    my $spacing = "  " x $hnum;
-			    $section_text .= "<!--\n";
-			    $section_text .= $spacing."</Section>\n";
-			    $section_text .= "-->\n";
-			    $hnum--;
-			}
-			$hnum++;
-		    }
-
-		    my $spacing = "  " x $hnum;
-		    $section_text .= "<!--\n";
-		    $section_text .= $spacing."<Section>\n";
-		    $section_text .= $spacing."  <Description>\n";
-		    $section_text .= $spacing."    <Metadata name=\"Title\">$h_text</Metadata>";
-		    $section_text .= $spacing."  </Description>\n";
-		    $section_text .= "-->\n";
-		    
-		    #print $outhandle $spacing."$h_text\n"
-		    #	if $self->{'verbosity'} > 2;
-		    
-		    $sectionh1++ if ($hnum==1);
-		}
-	    }
-	    else {
-###		print STDERR "***** hc = <h$hc\n\n";
-	    }
-	    $section_text .= "<h$hc";
-	}
-	else
-	{
-	    $section_text .= "<h$hc";
-	}
-    }
-
-    while ($hnum >= 1)
-    {
-	my $spacing = "  " x $hnum;
-	$section_text .= "<!--\n";
-	$section_text .= $spacing."</Section>\n";
-	$section_text .= "-->\n";
-	$hnum--;
-    }
-
-    $section_text .= "<!--\n</Section>\n-->\n";
-
-    $$textref = $section_text;
-    
-#    if ($sectionh1>0)
-#    {
-#	print $outhandle "  Located section headings ..."
-#	    if $self->{'verbosity'} > 1;
-#    }
-    
-    $$textref =~ s/<!\[if !vml\]>/<![if vml]>/g;
-    
-    $$textref =~ s/(&nbsp;)+/&nbsp;/sg;    
-    
-    ## $$textref =~ s/<o:p>&nbsp;<\/o:p>//g; # used with VML to space figures?
-    
-    $self->SUPER::process(@_);
-    
-}
-
-
-sub resize_if_necessary
-{
-    my ($self,$front,$back,$base_dir,$href) = @_;
-    
-    # dig out width and height of image, if there
-    my $img_attributes = "$front back";
-    my ($img_width)  = ($img_attributes =~ m/\s+width=\"?(\d+)\"?/i);
-    my ($img_height) = ($img_attributes =~ m/\s+height=\"?(\d+)\"?/i);
-    
-    # derive local filename for image based on its URL
-    my $img_filename = $href;
-    $img_filename =~ s/^[^:]*:\/\///;
-    $img_filename = &util::filename_cat($base_dir, $img_filename);
-    
-    # Replace %20's in URL with a space if required. Note that the filename
-    # may include the %20 in some situations
-    if ($img_filename =~ /\%20/) {
-	if (!-e $img_filename) {
-	    $img_filename =~ s/\%20/ /g;
-	}
-    }
-    if ((-e $img_filename) && (defined $img_width) && (defined $img_height)) {
-	# get image info on width and height
-	
-	my $outhandle = $self->{'outhandle'};
-	my $verbosity = $self->{'verbosity'};
-
-	my ($image_type, $actual_width, $actual_height, $image_size) 
-	    = &ImagePlug::identify($img_filename, $outhandle, $verbosity);
-	
-	#print STDERR "**** $actual_width x $actual_height";
-	#print STDERR " (requested: $img_width x $img_height)\n";
-
-	if (($img_width < $actual_width) || ($img_height < $actual_height)) {
-	    #print $outhandle "Resizing $img_filename\n" if ($verbosity > 0);
-	    
-	    # derive new image name based on current image
-	    my ($tailname, $dirname, $suffix)
-		= &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
-	    
-	    my $resized_filename 
-		= &util::filename_cat($dirname, $tailname."_resized".$suffix);
-	    
-	    #print STDERR "**** suffix = $suffix\n";
-	    
-	    # Generate smaller image with convert
-	    my $newsize = "$img_widthx$image_height";
-	    my $command = "convert -interlace plane -verbose "
-		."-geometry $newsize \"img_$filename\" \"$resized_filename\"";
-	    #print $outhandle "ImageResize: $command\n" if ($verbosity > 2);
-	    #my $result = '';
-	    #print $outhandle "ImageResize result: $result\n" if ($verbosity > 2);
-	}
-    }
-    return $href;
-}
-
-sub replace_images {
-    my $self = shift (@_);
-    my ($front, $link, $back, $base_dir, 
-	$file, $doc_obj, $section) = @_;
-    # remove quotes from link at start and end if necessary
-    if ($link=~/^\"/) {
-	$link=~s/^\"//;$link=~s/\"$//;
-	$front.='"';
-	$back="\"$back";
-    }
-    
-    $link =~ s/\n/ /g;
-    
-    my ($href, $hash_part, $rl) = $self->format_link ($link, $base_dir, $file);
-    
-##    $href = $self->resize_if_necessary($front,$back,$base_dir,$href);
-    
-    my $middle = $self->add_file ($href, $rl, $hash_part, $base_dir, $doc_obj, $section);
-    
-    return $front . $middle . $back;
-}
-
-sub extract_metadata 
-{
-    my $self = shift (@_);
-    my ($textref, $metadata, $doc_obj) = @_;
-    my $outhandle = $self->{'outhandle'};
-    
-    return if (!defined $textref);
-
-    # metadata fields to extract/save. 'key' is the (lowercase) name of the
-    # html meta, 'value' is the metadata name for greenstone to use
-    my %find_fields = ();
-    my ($tag,$value);
-
-    my $orig_field = "";
-    foreach my $field (split /,/, $self->{'metadata_fields'}) {
-	# support tag<tagname>
-	if ($field =~ /^(.*?)<(.*?)>$/) {
-	    # "$2" is the user's preferred gs metadata name
-	    $find_fields{lc($1)}=$2; # lc = lowercase
-	    $orig_field = $1;
-	} else { # no <tagname> for mapping
-	    # "$field" is the user's preferred gs metadata name
-	    $find_fields{lc($field)}=$field; # lc = lowercase
-	    $orig_field = $field;
-	}
-
-	if ($textref =~ m/<o:$orig_field>(.*)<\/o:$orig_field>/i){
-	    $tag = $orig_field;
-	    $value = $1;
-	    if (!defined $value || !defined $tag){
-		#print $outhandle "StructuredHTMLPlug: can't find VALUE in \"$tag\"\n";
-		next;
-	    } else {
-		# clean up and add
-		chomp($value); # remove trailing \n, if any
-		$tag = $find_fields{lc($tag)};
-		#print $outhandle " extracted \"$tag\" metadata \"$value\"\n" 
-		#    if ($self->{'verbosity'} > 2);
-		$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), $tag, $value);
-	    }
-	}
-    }
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/StructuredHTMLPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/StructuredHTMLPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/StructuredHTMLPlugin.pm	(revision 15865)
@@ -0,0 +1,405 @@
+###########################################################################
+#
+# StructuredHTMLPlug.pm -- html plugin with extra facilities for teasing out 
+# hierarchical structure (such as h1, h2, h3, or user-defined tags) in an 
+# HTML document
+#
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999 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.
+#
+###########################################################################
+# This plugin is to process an HTML file where sections are divided by 
+# user-defined headings tags. As it is difficult to predict what user's definition
+# this plugin allows to detect the user-defined titles up to three levels (level1, level2, level3...)
+# as well as allows to get rid of user-defined Table of Content (TOC)...
+# format:e.g. level1 (Abstract_title|ChapterTitle|Referencing Heading) level2(SectionHeading)...
+
+package StructuredHTMLPlug;
+
+use HTMLPlug;
+use ImagePlug;
+
+#use strict; # every perl program should have this!
+#no strict 'refs'; # make an exception so we can use variables as filehandles
+
+sub BEGIN {
+    @StructuredHTMLPlug::ISA = ('HTMLPlug');
+}
+
+my $arguments = 
+    [
+     { 'name' => "level1_header",
+       'desc' => "{StructuredHTMLPlug.level1_header}",
+       'type' => "regexp",
+       'reqd' => "no",
+       'deft' => "" },
+     { 'name' => "level2_header",
+       'desc' => "{StructuredHTMLPlug.level2_header}",
+       'type' => "regexp",
+       'reqd' => "no",
+       'deft' => "" },
+     { 'name' => "level3_header",
+       'desc' => "{StructuredHTMLPlug.level3_header}",
+       'type' => "regexp",
+       'reqd' => "no",
+       'deft' => "" },
+     { 'name' => "title_header",
+       'desc' => "{StructuredHTMLPlug.title_header}",
+       'type' => "regexp",
+       'reqd' => "no",
+       'deft' => "" },
+     { 'name' => "delete_toc",
+       'desc' => "{StructuredHTMLPlug.delete_toc}",
+       'type' => "flag",
+       'reqd' => "no"},
+     { 'name' => "toc_header",
+       'desc' => "{StructuredHTMLPlug.toc_header}",
+       'type' => "regexp",
+       'reqd' => "no",
+       'deft' => "" }     
+     ];
+
+my $options = { 'name'     => "StructuredHTMLPlug",
+		'desc'     => "{StructuredHTMLPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+    
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+    
+    my $self = new HTMLPlug($pluginlist, $inputargs, $hashArgOptLists);
+    
+    return bless $self, $class;
+}
+
+
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    print $outhandle "StructuredHTMLPlug: processing $file\n"
+        if $self->{'verbosity'} > 1;
+    
+    my @head_and_body = split(/<body/i,$$textref);
+    my $head = shift(@head_and_body);
+    my $body_text = join("<body", @head_and_body);
+    $head =~ m/<title>(.+)<\/title>/i;
+    my $doctitle = $1 if defined $1;
+    if (defined $self->{'metadata_fields'} && $self->{'metadata_fields'}=~ /\S/) {
+	my @doc_properties = split(/<xml>/i,$head);
+	my $doc_heading = shift(@doc_properties);
+	my $rest_doc_properties = join(" ", @doc_properties);
+
+	my @extracted_metadata = split(/<\/xml>/i, $rest_doc_properties);
+	my $extracted_metadata = shift (@extracted_metadata);
+	$self->extract_metadata($extracted_metadata, $metadata, $doc_obj);
+    }
+    
+    # set the title here if we haven't found it yet
+    if (!defined $doc_obj->get_metadata_element ($doc_obj->get_top_section(), "Title")) {
+	if (defined $doctitle && $doctitle =~ /\S/) {
+	    $doc_obj->add_metadata($doc_obj->get_top_section(), "Title", $doctitle);
+	} else {
+	    $self->title_fallback($doc_obj,$doc_obj->get_top_section(),$file);
+	}
+    }
+
+    # If delete_toc is enabled, it means to get rid of toc and tof contents.
+    # get rid of TOC and TOF sections and their title
+    if (defined $self->{'delete_toc'} && ($self->{'delete_toc'} == 1)){
+	if (defined $self->{'toc_header'}&& $self->{'toc_header'} =~ /\S/){
+	    $body_text =~ s/<p class=(($self->{'toc_header'})[^>]*)>(.+?)<\/p>//isg;
+	}
+    }
+    
+    if (defined $self->{'title_header'} && $self->{'title_header'}=~ /\S/){
+	$self->{'title_header'} =~ s/^(\()(.*)(\))/$2/is;
+	$body_text =~ s/<p class=(($self->{'title_header'})[^>]*)>(.+?)<\/p>/<p class=$1><h1>$3<\/h1><\/p>/isg;
+    }
+
+    if (defined $self->{'level1_header'} && $self->{'level1_header'}=~ /\S/ ){
+     	$self->{'level1_header'} =~ s/^\((.*)\)/$1/i;
+	$body_text =~ s/<p class=(($self->{'level1_header'})[^>]*)>(.+?)<\/p>/<p class=$1><h1>$3<\/h1><\/p>/isg;
+    }
+    
+    if (defined $self->{'level2_header'} && $self->{'level2_header'}=~ /\S/){
+	$self->{'level2_header'} =~ s/^\((.*)\)/$1/i;
+	$body_text =~ s/<p class=(($self->{'level2_header'})[^>]*)>(.+?)<\/p>/<p class=$1><h2>$3<\/h2><\/p>/isg;
+    }
+    
+    if (defined $self->{'level3_header'} && $self->{'level3_header'}=~ /\S/ ){
+	$self->{'level3_header'} =~ s/^\((.*)\)/$1/is;
+	$body_text =~ s/<p class=(($self->{'level3_header'})[^>]*)>(.+?)<\/p>/<p class=$1><h3>$3<\/h3><\/p>/isg;
+    }
+    
+    # Tidy up extra new lines
+    $body_text =~ s/(<p[^>]*><span[^>]*><o:p>&nbsp;<\/o:p><\/span><\/p>)//isg;
+    $body_text =~ s/(<p[^>]*><o:p>&nbsp;<\/o:p><\/p>)//isg;
+    
+    $section_text .= "<!--\n<Section>\n-->\n";
+    #my $top_section_tag = "<!--\n<Section>\n-->\n";
+    #$body_text =~ s/(<div.*)/$top_section_text$doctitle$1/i;
+    #$body_text =~ s/(<div.*)/$top_section_tag$1/i;
+    my $body = "<body".$body_text;
+    
+    my $section_text = $head;
+    
+    # split HTML text on <h1>, <h2> etc tags
+    my @h_split = split(/<h/i,$body);
+    
+    my $hnum = 0;
+
+    my $sectionh1 = 0;
+    $section_text .= shift(@h_split);
+    
+    my $hc;
+    foreach $hc ( @h_split )
+    {
+	if ($hc =~ m/^([1-3])\s*.*?>(.*)$/s)
+	{
+	    my $new_hnum = $1;
+	    my $hc_after = $2;
+	    
+	    if ($hc_after =~ m/^(.*?)<\/h$new_hnum>/is)
+	    {
+		my $h_text = $1;
+		$hc =~ s/^(\&nbsp\;)+/\&nbsp\;/g;
+		# boil HTML down to some interesting text
+		$h_text =~ s/^[1-3]>//;
+		$h_text =~ s/<\/?.*?>//sg;
+		$h_text =~ s/\s+/ /sg;
+		$h_text =~ s/^\s$//s;
+		$h_text =~ s/(&nbsp;)+\W*/&nbsp;/sg;
+		
+		if ($h_text =~ m/\w+/)
+		{
+		    if ($new_hnum > $hnum)
+		    {
+			# increase section nesting
+			$hnum++;
+			while ($hnum < $new_hnum)
+			{
+			    my $spacing = "  " x $hnum;
+			    $section_text .= "<!--\n";
+			    $section_text .= $spacing."<Section>\n";
+			    $section_text .= "-->\n";
+			    $hnum++;
+			}
+		    }
+		    else # ($new_hnum <= $hnum)
+		    {
+			# descrease section nesting
+			while ($hnum >= $new_hnum)
+			{
+			    my $spacing = "  " x $hnum;
+			    $section_text .= "<!--\n";
+			    $section_text .= $spacing."</Section>\n";
+			    $section_text .= "-->\n";
+			    $hnum--;
+			}
+			$hnum++;
+		    }
+
+		    my $spacing = "  " x $hnum;
+		    $section_text .= "<!--\n";
+		    $section_text .= $spacing."<Section>\n";
+		    $section_text .= $spacing."  <Description>\n";
+		    $section_text .= $spacing."    <Metadata name=\"Title\">$h_text</Metadata>";
+		    $section_text .= $spacing."  </Description>\n";
+		    $section_text .= "-->\n";
+		    
+		    #print $outhandle $spacing."$h_text\n"
+		    #	if $self->{'verbosity'} > 2;
+		    
+		    $sectionh1++ if ($hnum==1);
+		}
+	    }
+	    else {
+###		print STDERR "***** hc = <h$hc\n\n";
+	    }
+	    $section_text .= "<h$hc";
+	}
+	else
+	{
+	    $section_text .= "<h$hc";
+	}
+    }
+
+    while ($hnum >= 1)
+    {
+	my $spacing = "  " x $hnum;
+	$section_text .= "<!--\n";
+	$section_text .= $spacing."</Section>\n";
+	$section_text .= "-->\n";
+	$hnum--;
+    }
+
+    $section_text .= "<!--\n</Section>\n-->\n";
+
+    $$textref = $section_text;
+    
+#    if ($sectionh1>0)
+#    {
+#	print $outhandle "  Located section headings ..."
+#	    if $self->{'verbosity'} > 1;
+#    }
+    
+    $$textref =~ s/<!\[if !vml\]>/<![if vml]>/g;
+    
+    $$textref =~ s/(&nbsp;)+/&nbsp;/sg;    
+    
+    ## $$textref =~ s/<o:p>&nbsp;<\/o:p>//g; # used with VML to space figures?
+    
+    $self->SUPER::process(@_);
+    
+}
+
+
+sub resize_if_necessary
+{
+    my ($self,$front,$back,$base_dir,$href) = @_;
+    
+    # dig out width and height of image, if there
+    my $img_attributes = "$front back";
+    my ($img_width)  = ($img_attributes =~ m/\s+width=\"?(\d+)\"?/i);
+    my ($img_height) = ($img_attributes =~ m/\s+height=\"?(\d+)\"?/i);
+    
+    # derive local filename for image based on its URL
+    my $img_filename = $href;
+    $img_filename =~ s/^[^:]*:\/\///;
+    $img_filename = &util::filename_cat($base_dir, $img_filename);
+    
+    # Replace %20's in URL with a space if required. Note that the filename
+    # may include the %20 in some situations
+    if ($img_filename =~ /\%20/) {
+	if (!-e $img_filename) {
+	    $img_filename =~ s/\%20/ /g;
+	}
+    }
+    if ((-e $img_filename) && (defined $img_width) && (defined $img_height)) {
+	# get image info on width and height
+	
+	my $outhandle = $self->{'outhandle'};
+	my $verbosity = $self->{'verbosity'};
+
+	my ($image_type, $actual_width, $actual_height, $image_size) 
+	    = &ImagePlug::identify($img_filename, $outhandle, $verbosity);
+	
+	#print STDERR "**** $actual_width x $actual_height";
+	#print STDERR " (requested: $img_width x $img_height)\n";
+
+	if (($img_width < $actual_width) || ($img_height < $actual_height)) {
+	    #print $outhandle "Resizing $img_filename\n" if ($verbosity > 0);
+	    
+	    # derive new image name based on current image
+	    my ($tailname, $dirname, $suffix)
+		= &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
+	    
+	    my $resized_filename 
+		= &util::filename_cat($dirname, $tailname."_resized".$suffix);
+	    
+	    #print STDERR "**** suffix = $suffix\n";
+	    
+	    # Generate smaller image with convert
+	    my $newsize = "$img_widthx$image_height";
+	    my $command = "convert -interlace plane -verbose "
+		."-geometry $newsize \"img_$filename\" \"$resized_filename\"";
+	    #print $outhandle "ImageResize: $command\n" if ($verbosity > 2);
+	    #my $result = '';
+	    #print $outhandle "ImageResize result: $result\n" if ($verbosity > 2);
+	}
+    }
+    return $href;
+}
+
+sub replace_images {
+    my $self = shift (@_);
+    my ($front, $link, $back, $base_dir, 
+	$file, $doc_obj, $section) = @_;
+    # remove quotes from link at start and end if necessary
+    if ($link=~/^\"/) {
+	$link=~s/^\"//;$link=~s/\"$//;
+	$front.='"';
+	$back="\"$back";
+    }
+    
+    $link =~ s/\n/ /g;
+    
+    my ($href, $hash_part, $rl) = $self->format_link ($link, $base_dir, $file);
+    
+##    $href = $self->resize_if_necessary($front,$back,$base_dir,$href);
+    
+    my $middle = $self->add_file ($href, $rl, $hash_part, $base_dir, $doc_obj, $section);
+    
+    return $front . $middle . $back;
+}
+
+sub extract_metadata 
+{
+    my $self = shift (@_);
+    my ($textref, $metadata, $doc_obj) = @_;
+    my $outhandle = $self->{'outhandle'};
+    
+    return if (!defined $textref);
+
+    # metadata fields to extract/save. 'key' is the (lowercase) name of the
+    # html meta, 'value' is the metadata name for greenstone to use
+    my %find_fields = ();
+    my ($tag,$value);
+
+    my $orig_field = "";
+    foreach my $field (split /,/, $self->{'metadata_fields'}) {
+	# support tag<tagname>
+	if ($field =~ /^(.*?)<(.*?)>$/) {
+	    # "$2" is the user's preferred gs metadata name
+	    $find_fields{lc($1)}=$2; # lc = lowercase
+	    $orig_field = $1;
+	} else { # no <tagname> for mapping
+	    # "$field" is the user's preferred gs metadata name
+	    $find_fields{lc($field)}=$field; # lc = lowercase
+	    $orig_field = $field;
+	}
+
+	if ($textref =~ m/<o:$orig_field>(.*)<\/o:$orig_field>/i){
+	    $tag = $orig_field;
+	    $value = $1;
+	    if (!defined $value || !defined $tag){
+		#print $outhandle "StructuredHTMLPlug: can't find VALUE in \"$tag\"\n";
+		next;
+	    } else {
+		# clean up and add
+		chomp($value); # remove trailing \n, if any
+		$tag = $find_fields{lc($tag)};
+		#print $outhandle " extracted \"$tag\" metadata \"$value\"\n" 
+		#    if ($self->{'verbosity'} > 2);
+		$doc_obj->add_utf8_metadata($doc_obj->get_top_section(), $tag, $value);
+	    }
+	}
+    }
+}
+
+1;
Index: dl/trunk/perllib/plugins/TEXTPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/TEXTPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,228 +1,0 @@
-###########################################################################
-#
-# TEXTPlug.pm -- simple text plugin
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999 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.
-#
-###########################################################################
-
-# creates simple single-level document. Adds Title metadata 
-# of first line of text (up to 100 characters long).
-
-# 12/05/02 Added usage datastructure - John Thompson
-
-package TEXTPlug;
-
-use BasPlug;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @TEXTPlug::ISA = ('BasPlug');
-}
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" } ,
-      { 'name' => "title_sub",
-	'desc' => "{TEXTPlug.title_sub}",
-	'type' => "regexp",
-	'deft' => "",
-	'reqd' => "no" } ];
-
-my $options = { 'name'     => "TEXTPlug",
-		'desc'     => "{TEXTPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'srcreplaceable' => "yes", # Source docs in regular txt format can be replaced with GS-generated html
-		'args'     => $arguments };
-
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)\.te?xt$^;
-}
-
-# do plugin specific processing of doc_obj
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    print STDERR "<Processing n='$file' p='TEXTPlug'>\n" if ($gli);
-    print $outhandle "TEXTPlug: processing $file\n" 
-	if $self->{'verbosity'} > 1;
-    
-    my $cursection = $doc_obj->get_top_section();
-    # get title metadata
-    # (don't need to get title if it has been passed
-    # in from another plugin)
-    if (!defined $metadata->{'Title'}) {
-	my ($title) = $$textref;
-	$title =~ /^\s+/s;
-	if (defined $self->{'title_sub'} &&
-           $self->{'title_sub'}) {$title =~ s/$self->{'title_sub'}//;}
-	$title =~ /^\s*([^\n]*)/s; $title=$1;
-	if (length($title) > 100) {
-	    $title = substr ($title, 0, 100) . "...";
-	}
-        $title =~ s/\[/&#91;/g;
-        $title =~ s/\[/&#93;/g;
-        $title =~ s/\</&#60;/g;
-        $title =~ s/\>/&#62;/g;
-	$doc_obj->add_utf8_metadata ($cursection, "Title", $title);
-    }
-    # Add FileFormat metadata
-    $doc_obj->add_metadata($cursection, "FileFormat", "TEXT");
-
-    # insert preformat tags and add text to document object    
-    $self->text_to_html($textref); # modifies the text
-    $doc_obj->add_utf8_text($cursection, $$textref); #$doc_obj->add_utf8_text($cursection, "<pre>\n$$textref\n</pre>");
-
-    return 1;
-}
-
-sub text_to_html {
-    my $self = shift (@_);
-    my ($textref) = @_;
-    
-    # we need to escape the escape character, or else mg will convert into
-    # eg literal newlines, instead of leaving the text as '\n'
-    $$textref =~ s/\\/\\\\/g; # macro language
-    $$textref =~ s/_/\\_/g; # macro language
-    $$textref =~ s/</&lt;/g;
-    $$textref =~ s/>/&gt;/g;
-    
-    # insert preformat tags and add text to document object
-    $$textref = "<pre>\n$$textref\n</pre>";
-}
-
-
-# replace_srcdoc_with_html.pl requires all subroutines that support src_replaceable
-# to contain a method called tmp_area_convert_file - this is indeed the case with all
-# Perl modules that are subclasses of ConvertToPlug.pm, but as we want TEXTPlug to also
-# be srcreplaceable and because TEXTPlug does not inherit from ConvertToPlug.pm, we have
-# a similar subroutine with the same name here.
-sub tmp_area_convert_file {
-    my $self = shift (@_);
-    my ($output_ext, $input_filename) = @_;
-    
-    my $outhandle = $self->{'outhandle'};
-    #my $failhandle = $self->{'failhandle'};
-    
-    # derive output filename from input filename
-    my ($tailname, $dirname, $suffix)
-	= &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
-
-    # Softlink to collection tmp dir
-    # First find a temporary directory to create the output file in
-    my $tmp_dirname = $dirname;
-    if(defined $ENV{'GSDLCOLLECTDIR'}) {
-	$tmp_dirname = $ENV{'GSDLCOLLECTDIR'};
-    } elsif(defined $ENV{'GSDLHOME'}) {
-	$tmp_dirname = $ENV{'GSDLHOME'};
-    }
-    $tmp_dirname = &util::filename_cat($tmp_dirname, "tmp");
-    &util::mk_dir($tmp_dirname) if (!-e $tmp_dirname);
-
-    # convert to utf-8 otherwise we have problems with the doc.xml file
-    # later on
-    &unicode::ensure_utf8(\$tailname); # TODO: does this change the filename or not?
-             # need to test this out on a windows computer using a Greek filename
-    $suffix = lc($suffix);
-    my $tmp_filename = &util::filename_cat($tmp_dirname, "$tailname$suffix"); 
-    
-    # Make sure we have the absolute path to the input file
-    # (If gsdl is remote, we're given relative path to input file, of the form import/tailname.suffix
-    # But we can't softlink to relative paths. Therefore, we need to ensure that
-    # the input_filename is the absolute path.
-    my $ensure_path_absolute = 1; # true
-
-    # Now make the softlink,  so we don't accidentally damage the input file
-    # softlinking creates a symbolic link to (or, if that's not possible, it makes a copy of) the original
-    &util::soft_link($input_filename, $tmp_filename, $ensure_path_absolute);
-     
-    my $verbosity = $self->{'verbosity'};
-    if ($verbosity > 0) {
-	# need this output statement, as GShell.java's runRemote() sets status to CANCELLED
-	# if there is no output! (Therefore, it only had this adverse affect when running GSDL remotely)
-	print $outhandle "Converting $tailname$suffix to html\n";
-    }
-
-    #my $output_filename = $tailname$output_ext; #output_ext has to be html!
-    my $output_filename = &util::filename_cat($tmp_dirname, $tailname.".html");
-    
-    # Read contents of text file line by line into an array
-    # create an HTML file from the text file
-    # Recreate the original file for writing the updated contents
-    unless(open(TEXT, "<$tmp_filename")) { # open it as a new file for writing
-	print STDERR "TEXTPlug.pm: Unable to open and read from $tmp_filename for converting to html...ERROR: $!\n";
-	return ""; # no file name
-    }
-
-    # Read the entire file at once
-    my $text;
-    { 
-	local $/ = undef; # Now can read the entire file at once. From http://perl.plover.com/local.html
-	$text = <TEXT>;   # File is read in as one single 'line'
-    }
-    close(TEXT); # close the file
-   
-    # convert the text
-    $self->text_to_html(\$text);
-       
-    #print STDERR "****output_filename: $output_filename\n";
-    #print STDERR "****text: $text\n";
-
-    # try creating this new file writing and try opening it for writing, else exit with error value
-    unless(open(HTML, ">$output_filename")) {  # open the new html file for writing
-	print STDERR "TEXTPlug.pm: Unable to create $output_filename for writing $tailname$suffix txt converted to html...ERROR: $!\n";
-	return ""; # no filename
-    }
-    # write the html contents in text out to the file
-    print HTML $text; 
-    close HTML;
-
-    # remove the copy of the original file/remove the symbolic link to original file
-    &util::rm($tmp_filename);
-
-    return $output_filename; # return the output file path
-}
-
-
-1;
Index: /gsdl/trunk/perllib/plugins/TextPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/TextPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/TextPlugin.pm	(revision 15865)
@@ -0,0 +1,228 @@
+###########################################################################
+#
+# TEXTPlug.pm -- simple text plugin
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999 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.
+#
+###########################################################################
+
+# creates simple single-level document. Adds Title metadata 
+# of first line of text (up to 100 characters long).
+
+# 12/05/02 Added usage datastructure - John Thompson
+
+package TEXTPlug;
+
+use BasPlug;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @TEXTPlug::ISA = ('BasPlug');
+}
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" } ,
+      { 'name' => "title_sub",
+	'desc' => "{TEXTPlug.title_sub}",
+	'type' => "regexp",
+	'deft' => "",
+	'reqd' => "no" } ];
+
+my $options = { 'name'     => "TEXTPlug",
+		'desc'     => "{TEXTPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'srcreplaceable' => "yes", # Source docs in regular txt format can be replaced with GS-generated html
+		'args'     => $arguments };
+
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)\.te?xt$^;
+}
+
+# do plugin specific processing of doc_obj
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    print STDERR "<Processing n='$file' p='TEXTPlug'>\n" if ($gli);
+    print $outhandle "TEXTPlug: processing $file\n" 
+	if $self->{'verbosity'} > 1;
+    
+    my $cursection = $doc_obj->get_top_section();
+    # get title metadata
+    # (don't need to get title if it has been passed
+    # in from another plugin)
+    if (!defined $metadata->{'Title'}) {
+	my ($title) = $$textref;
+	$title =~ /^\s+/s;
+	if (defined $self->{'title_sub'} &&
+           $self->{'title_sub'}) {$title =~ s/$self->{'title_sub'}//;}
+	$title =~ /^\s*([^\n]*)/s; $title=$1;
+	if (length($title) > 100) {
+	    $title = substr ($title, 0, 100) . "...";
+	}
+        $title =~ s/\[/&#91;/g;
+        $title =~ s/\[/&#93;/g;
+        $title =~ s/\</&#60;/g;
+        $title =~ s/\>/&#62;/g;
+	$doc_obj->add_utf8_metadata ($cursection, "Title", $title);
+    }
+    # Add FileFormat metadata
+    $doc_obj->add_metadata($cursection, "FileFormat", "TEXT");
+
+    # insert preformat tags and add text to document object    
+    $self->text_to_html($textref); # modifies the text
+    $doc_obj->add_utf8_text($cursection, $$textref); #$doc_obj->add_utf8_text($cursection, "<pre>\n$$textref\n</pre>");
+
+    return 1;
+}
+
+sub text_to_html {
+    my $self = shift (@_);
+    my ($textref) = @_;
+    
+    # we need to escape the escape character, or else mg will convert into
+    # eg literal newlines, instead of leaving the text as '\n'
+    $$textref =~ s/\\/\\\\/g; # macro language
+    $$textref =~ s/_/\\_/g; # macro language
+    $$textref =~ s/</&lt;/g;
+    $$textref =~ s/>/&gt;/g;
+    
+    # insert preformat tags and add text to document object
+    $$textref = "<pre>\n$$textref\n</pre>";
+}
+
+
+# replace_srcdoc_with_html.pl requires all subroutines that support src_replaceable
+# to contain a method called tmp_area_convert_file - this is indeed the case with all
+# Perl modules that are subclasses of ConvertToPlug.pm, but as we want TEXTPlug to also
+# be srcreplaceable and because TEXTPlug does not inherit from ConvertToPlug.pm, we have
+# a similar subroutine with the same name here.
+sub tmp_area_convert_file {
+    my $self = shift (@_);
+    my ($output_ext, $input_filename) = @_;
+    
+    my $outhandle = $self->{'outhandle'};
+    #my $failhandle = $self->{'failhandle'};
+    
+    # derive output filename from input filename
+    my ($tailname, $dirname, $suffix)
+	= &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
+
+    # Softlink to collection tmp dir
+    # First find a temporary directory to create the output file in
+    my $tmp_dirname = $dirname;
+    if(defined $ENV{'GSDLCOLLECTDIR'}) {
+	$tmp_dirname = $ENV{'GSDLCOLLECTDIR'};
+    } elsif(defined $ENV{'GSDLHOME'}) {
+	$tmp_dirname = $ENV{'GSDLHOME'};
+    }
+    $tmp_dirname = &util::filename_cat($tmp_dirname, "tmp");
+    &util::mk_dir($tmp_dirname) if (!-e $tmp_dirname);
+
+    # convert to utf-8 otherwise we have problems with the doc.xml file
+    # later on
+    &unicode::ensure_utf8(\$tailname); # TODO: does this change the filename or not?
+             # need to test this out on a windows computer using a Greek filename
+    $suffix = lc($suffix);
+    my $tmp_filename = &util::filename_cat($tmp_dirname, "$tailname$suffix"); 
+    
+    # Make sure we have the absolute path to the input file
+    # (If gsdl is remote, we're given relative path to input file, of the form import/tailname.suffix
+    # But we can't softlink to relative paths. Therefore, we need to ensure that
+    # the input_filename is the absolute path.
+    my $ensure_path_absolute = 1; # true
+
+    # Now make the softlink,  so we don't accidentally damage the input file
+    # softlinking creates a symbolic link to (or, if that's not possible, it makes a copy of) the original
+    &util::soft_link($input_filename, $tmp_filename, $ensure_path_absolute);
+     
+    my $verbosity = $self->{'verbosity'};
+    if ($verbosity > 0) {
+	# need this output statement, as GShell.java's runRemote() sets status to CANCELLED
+	# if there is no output! (Therefore, it only had this adverse affect when running GSDL remotely)
+	print $outhandle "Converting $tailname$suffix to html\n";
+    }
+
+    #my $output_filename = $tailname$output_ext; #output_ext has to be html!
+    my $output_filename = &util::filename_cat($tmp_dirname, $tailname.".html");
+    
+    # Read contents of text file line by line into an array
+    # create an HTML file from the text file
+    # Recreate the original file for writing the updated contents
+    unless(open(TEXT, "<$tmp_filename")) { # open it as a new file for writing
+	print STDERR "TEXTPlug.pm: Unable to open and read from $tmp_filename for converting to html...ERROR: $!\n";
+	return ""; # no file name
+    }
+
+    # Read the entire file at once
+    my $text;
+    { 
+	local $/ = undef; # Now can read the entire file at once. From http://perl.plover.com/local.html
+	$text = <TEXT>;   # File is read in as one single 'line'
+    }
+    close(TEXT); # close the file
+   
+    # convert the text
+    $self->text_to_html(\$text);
+       
+    #print STDERR "****output_filename: $output_filename\n";
+    #print STDERR "****text: $text\n";
+
+    # try creating this new file writing and try opening it for writing, else exit with error value
+    unless(open(HTML, ">$output_filename")) {  # open the new html file for writing
+	print STDERR "TEXTPlug.pm: Unable to create $output_filename for writing $tailname$suffix txt converted to html...ERROR: $!\n";
+	return ""; # no filename
+    }
+    # write the html contents in text out to the file
+    print HTML $text; 
+    close HTML;
+
+    # remove the copy of the original file/remove the symbolic link to original file
+    &util::rm($tmp_filename);
+
+    return $output_filename; # return the output file path
+}
+
+
+1;
Index: dl/trunk/perllib/plugins/UnknownPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/UnknownPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,273 +1,0 @@
-###########################################################################
-#
-# UnknownPlug.pm -- Plugin for files you know about but Greenstone doesn't
-#
-# 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 Gordon W. Paynter
-# 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.
-#
-###########################################################################
-
-# UnknownPlug - a plugin for unknown files
-
-# This is a simple Plugin for importing files in formats that
-# Greenstone doesn't know anything about.  A fictional document will
-# be created for every such file, and the file itself will be passed
-# to Greenstone as the "associated file" of the document.
-
-# Here's an example where it is useful: I have a collection of
-# pictures that include a couple of quicktime movie files with names
-# like DCP_0163.MOV.  Rather than write a new plugin for quicktime
-# movies, I add this line to the collection configuration file:
-
-# plugin UnknownPlug -process_exp "*.MOV" -assoc_field "movie"
-
-# A document is created for each movie, with the associated movie
-# file's name in the "movie" metadata field.  In the collection's
-# format strings, I use the {If} macro to output different text for
-# each type of file, like this:
-
-# {If}{[movie],<HTML for displaying movie>}{If}{[Image],<HTML for displaying image>}
-
-# You can also add extra metadata, such as the Title, Subject, and
-# Duration, with metadata.xml files and RecPlug.  (If you want to use
-# UnknownPlug with more than one type of file, you will have to add
-# some sort of distinguishing metadata in this way.)
-
-
-
-package UnknownPlug;
-
-use BasPlug;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @UnknownPlug::ISA = ('BasPlug');
-}
-
-my $arguments =
-    [ { 'name' => "assoc_field",
-	'desc' => "{UnknownPlug.assoc_field}",
-	'type' => "string",
-	'deft' => "",
-	'reqd' => "no" },
-      { 'name' => "file_format",
-	'desc' => "{UnknownPlug.file_format}",
-	'type' => "string",
-	'deft' => "",
-	'reqd' => "no" },
-      { 'name' => "mime_type",
-	'desc' => "{UnknownPlug.mime_type}",
-	'type' => "string",
-	'deft' => "",
-	'reqd' => "no" },
-      { 'name' => "srcicon",
-	'desc' => "{UnknownPlug.srcicon}",
-	'type' => "string",
-	'deft' => "iconunknown",
-	'reqd' => "no" },
-      { 'name' => "process_extension",
-	'desc' => "{UnknownPlug.process_extension}",
-	'type' => "string",
-	'deft' => "",
-	'reqd' => "no" } ];
-
-my $options = { 'name'     => "UnknownPlug",
-		'desc'     => "{UnknownPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    # "-process_extension" is a simpler alternative to -process_exp for non-regexp people
-    if (!$self->{'process_exp'} && $self->{'process_extension'}) {
-	$self->{'process_exp'} = "\\." . $self->{'process_extension'} . "\$";
-    }
-
-    return bless $self, $class;
-}
-
-sub get_default_process_exp {
-    return '';
-}
-
-
-# Associate the unknown file with the new document
-
-sub associate_unknown_file {
-    my $self = shift (@_);
-    my $filename = shift (@_);   # filename with full path
-    my $file = shift (@_);       # filename without path
-    my $doc_obj = shift (@_);
-    
-    my $verbosity = $self->{'verbosity'};
-    my $outhandle = $self->{'outhandle'};
-
-    # check the filename is okay
-    return 0 if ($file eq "" || $filename eq "");
-
-    
-    my $url = $file;
-    ##$url =~ s/ /%20/g;
-
-    # Add the file as an associated file ...
-    my $section = $doc_obj->get_top_section();
-    my $file_format = $self->{'file_format'} || "unknown";
-    my $mime_type = $self->{'mime_type'} || "unknown/unknown";
-    my $assoc_field = $self->{'assoc_field'} || "unknown_file";
-
-    $doc_obj->associate_file($filename, $file, $mime_type, $section);
-    $doc_obj->add_metadata ($section, "FileFormat", $file_format);
-    $doc_obj->add_metadata ($section, "MimeType", $mime_type);
-    $doc_obj->add_metadata ($section, $assoc_field, $file);
-    
-    $doc_obj->add_metadata ($section, "srclink", 
-			    "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[$assoc_field]\">");
-    #$doc_obj->add_metadata ($section, "srcicon", "_iconunknown_");
-    $doc_obj->add_metadata ($section, "srcicon", "_".$self->{'srcicon'}."_");
-    $doc_obj->add_metadata ($section, "/srclink", "</a>");
-    
-    # add NoText metadata which can be used to suppress the dummy text
-    $doc_obj->add_metadata ($section, "NoText", "1");
-
-    return 1;
-}
-
-
-
-# The UnknownPlug read() function. This function does all the right
-# things to make general options work for a given plugin.  UnknownPlug
-# overrides read() because there is no need to read the actual text of
-# the file in, because the contents of the file is not text...
-#
-#
-# Return number of files processed, undef if can't process 
-#
-# Note that $base_dir might be "" and that $file might include directories
-
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    my $outhandle = $self->{'outhandle'};
-
-    # Make sure we're processing the correct file
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-
-    print STDERR "<Processing n='$file' p='UnknownPlug'>\n" if ($gli);
-    print $outhandle "UnknownPlug processing \"$filename\"\n"
-	    if $self->{'verbosity'} > 1;
-
-    #if there's a leading directory name, eat it...
-    $file =~ s/^.*[\/\\]//;
-    
-    # create a new document
-    my $doc_obj = new doc ($filename, "indexed_doc");
-    my $top_section = $doc_obj->get_top_section();
-
-    $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});    
-    $doc_obj->add_utf8_metadata($top_section, "Plugin", "$self->{'plugin_type'}");
-    $doc_obj->add_metadata($top_section, "Source", $file); # set the filename as Source metadata to be consistent with other plugins
-    $doc_obj->add_utf8_metadata($top_section, "FileSize", (-s $filename));
-
-    # URL metadata (even invalid ones) are used to support internal
-    # links, so even if 'file_is_url' is off, still need to store info
-
-    my $web_url = "http://$file";
-    $doc_obj->add_metadata($top_section, "URL", $web_url);
-
-
-    # associate the file with the document
-    if (associate_unknown_file($self, $filename, $file, $doc_obj) != 1)
-    {
-	if ($gli) {
-	    print STDERR "<ProcessingError n='$file'>\n";
-	}
-	print $outhandle "UnknownPlug: couldn't process \"$filename\"\n";
-	return -1; # error during processing
-    }
-
-    #create an empty text string so we don't break downstream plugins 
-    my $text = &gsprintf::lookup_string("{BasPlug.dummy_text}",1);
-
-    # include any metadata passed in from previous plugins 
-    my $section = $doc_obj->get_top_section();
-    $self->extra_metadata ($doc_obj, $section, $metadata);
-
-    $self->title_fallback($doc_obj,$section,$file);
-
-    # do plugin specific processing of doc_obj
-    unless (defined ($self->process(\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj))) {
-	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
-	return -1;
-    }
-
-    # do any automatic metadata extraction
-    $self->auto_extract_metadata ($doc_obj);
-
-    # add an OID
-    $doc_obj->set_OID();
-    $doc_obj->add_utf8_text($section, $text);
-
-    # process the document
-    $processor->process($doc_obj);
-
-    $self->{'num_processed'} ++;
-    return 1;
-}
-
-
-# UnknownPlug processing of doc_obj.  In practice we don't need to do
-# anything here because the read function takes care of everything.
-
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
-    my $outhandle = $self->{'outhandle'};
-    
-    return 1;
-}
-
-
-1;
-
-
-
-
-
-
-
-
-
-
-
Index: /gsdl/trunk/perllib/plugins/UnknownPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/UnknownPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/UnknownPlugin.pm	(revision 15865)
@@ -0,0 +1,273 @@
+###########################################################################
+#
+# UnknownPlug.pm -- Plugin for files you know about but Greenstone doesn't
+#
+# 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 Gordon W. Paynter
+# 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.
+#
+###########################################################################
+
+# UnknownPlug - a plugin for unknown files
+
+# This is a simple Plugin for importing files in formats that
+# Greenstone doesn't know anything about.  A fictional document will
+# be created for every such file, and the file itself will be passed
+# to Greenstone as the "associated file" of the document.
+
+# Here's an example where it is useful: I have a collection of
+# pictures that include a couple of quicktime movie files with names
+# like DCP_0163.MOV.  Rather than write a new plugin for quicktime
+# movies, I add this line to the collection configuration file:
+
+# plugin UnknownPlug -process_exp "*.MOV" -assoc_field "movie"
+
+# A document is created for each movie, with the associated movie
+# file's name in the "movie" metadata field.  In the collection's
+# format strings, I use the {If} macro to output different text for
+# each type of file, like this:
+
+# {If}{[movie],<HTML for displaying movie>}{If}{[Image],<HTML for displaying image>}
+
+# You can also add extra metadata, such as the Title, Subject, and
+# Duration, with metadata.xml files and RecPlug.  (If you want to use
+# UnknownPlug with more than one type of file, you will have to add
+# some sort of distinguishing metadata in this way.)
+
+
+
+package UnknownPlug;
+
+use BasPlug;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @UnknownPlug::ISA = ('BasPlug');
+}
+
+my $arguments =
+    [ { 'name' => "assoc_field",
+	'desc' => "{UnknownPlug.assoc_field}",
+	'type' => "string",
+	'deft' => "",
+	'reqd' => "no" },
+      { 'name' => "file_format",
+	'desc' => "{UnknownPlug.file_format}",
+	'type' => "string",
+	'deft' => "",
+	'reqd' => "no" },
+      { 'name' => "mime_type",
+	'desc' => "{UnknownPlug.mime_type}",
+	'type' => "string",
+	'deft' => "",
+	'reqd' => "no" },
+      { 'name' => "srcicon",
+	'desc' => "{UnknownPlug.srcicon}",
+	'type' => "string",
+	'deft' => "iconunknown",
+	'reqd' => "no" },
+      { 'name' => "process_extension",
+	'desc' => "{UnknownPlug.process_extension}",
+	'type' => "string",
+	'deft' => "",
+	'reqd' => "no" } ];
+
+my $options = { 'name'     => "UnknownPlug",
+		'desc'     => "{UnknownPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    # "-process_extension" is a simpler alternative to -process_exp for non-regexp people
+    if (!$self->{'process_exp'} && $self->{'process_extension'}) {
+	$self->{'process_exp'} = "\\." . $self->{'process_extension'} . "\$";
+    }
+
+    return bless $self, $class;
+}
+
+sub get_default_process_exp {
+    return '';
+}
+
+
+# Associate the unknown file with the new document
+
+sub associate_unknown_file {
+    my $self = shift (@_);
+    my $filename = shift (@_);   # filename with full path
+    my $file = shift (@_);       # filename without path
+    my $doc_obj = shift (@_);
+    
+    my $verbosity = $self->{'verbosity'};
+    my $outhandle = $self->{'outhandle'};
+
+    # check the filename is okay
+    return 0 if ($file eq "" || $filename eq "");
+
+    
+    my $url = $file;
+    ##$url =~ s/ /%20/g;
+
+    # Add the file as an associated file ...
+    my $section = $doc_obj->get_top_section();
+    my $file_format = $self->{'file_format'} || "unknown";
+    my $mime_type = $self->{'mime_type'} || "unknown/unknown";
+    my $assoc_field = $self->{'assoc_field'} || "unknown_file";
+
+    $doc_obj->associate_file($filename, $file, $mime_type, $section);
+    $doc_obj->add_metadata ($section, "FileFormat", $file_format);
+    $doc_obj->add_metadata ($section, "MimeType", $mime_type);
+    $doc_obj->add_metadata ($section, $assoc_field, $file);
+    
+    $doc_obj->add_metadata ($section, "srclink", 
+			    "<a href=\"_httpprefix_/collect/[collection]/index/assoc/[assocfilepath]/[$assoc_field]\">");
+    #$doc_obj->add_metadata ($section, "srcicon", "_iconunknown_");
+    $doc_obj->add_metadata ($section, "srcicon", "_".$self->{'srcicon'}."_");
+    $doc_obj->add_metadata ($section, "/srclink", "</a>");
+    
+    # add NoText metadata which can be used to suppress the dummy text
+    $doc_obj->add_metadata ($section, "NoText", "1");
+
+    return 1;
+}
+
+
+
+# The UnknownPlug read() function. This function does all the right
+# things to make general options work for a given plugin.  UnknownPlug
+# overrides read() because there is no need to read the actual text of
+# the file in, because the contents of the file is not text...
+#
+#
+# Return number of files processed, undef if can't process 
+#
+# Note that $base_dir might be "" and that $file might include directories
+
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+
+    my $outhandle = $self->{'outhandle'};
+
+    # Make sure we're processing the correct file
+    my ($block_status,$filename) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+
+    print STDERR "<Processing n='$file' p='UnknownPlug'>\n" if ($gli);
+    print $outhandle "UnknownPlug processing \"$filename\"\n"
+	    if $self->{'verbosity'} > 1;
+
+    #if there's a leading directory name, eat it...
+    $file =~ s/^.*[\/\\]//;
+    
+    # create a new document
+    my $doc_obj = new doc ($filename, "indexed_doc");
+    my $top_section = $doc_obj->get_top_section();
+
+    $doc_obj->set_OIDtype ($processor->{'OIDtype'}, $processor->{'OIDmetadata'});    
+    $doc_obj->add_utf8_metadata($top_section, "Plugin", "$self->{'plugin_type'}");
+    $doc_obj->add_metadata($top_section, "Source", $file); # set the filename as Source metadata to be consistent with other plugins
+    $doc_obj->add_utf8_metadata($top_section, "FileSize", (-s $filename));
+
+    # URL metadata (even invalid ones) are used to support internal
+    # links, so even if 'file_is_url' is off, still need to store info
+
+    my $web_url = "http://$file";
+    $doc_obj->add_metadata($top_section, "URL", $web_url);
+
+
+    # associate the file with the document
+    if (associate_unknown_file($self, $filename, $file, $doc_obj) != 1)
+    {
+	if ($gli) {
+	    print STDERR "<ProcessingError n='$file'>\n";
+	}
+	print $outhandle "UnknownPlug: couldn't process \"$filename\"\n";
+	return -1; # error during processing
+    }
+
+    #create an empty text string so we don't break downstream plugins 
+    my $text = &gsprintf::lookup_string("{BasPlug.dummy_text}",1);
+
+    # include any metadata passed in from previous plugins 
+    my $section = $doc_obj->get_top_section();
+    $self->extra_metadata ($doc_obj, $section, $metadata);
+
+    $self->title_fallback($doc_obj,$section,$file);
+
+    # do plugin specific processing of doc_obj
+    unless (defined ($self->process(\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj))) {
+	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
+	return -1;
+    }
+
+    # do any automatic metadata extraction
+    $self->auto_extract_metadata ($doc_obj);
+
+    # add an OID
+    $doc_obj->set_OID();
+    $doc_obj->add_utf8_text($section, $text);
+
+    # process the document
+    $processor->process($doc_obj);
+
+    $self->{'num_processed'} ++;
+    return 1;
+}
+
+
+# UnknownPlug processing of doc_obj.  In practice we don't need to do
+# anything here because the read function takes care of everything.
+
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
+    my $outhandle = $self->{'outhandle'};
+    
+    return 1;
+}
+
+
+1;
+
+
+
+
+
+
+
+
+
+
+
Index: /gsdl/trunk/perllib/plugins/W3ImagePlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/W3ImagePlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/W3ImagePlugin.pm	(revision 15865)
@@ -0,0 +1,1068 @@
+###########################################################################
+#
+# W3ImgPlug.pm -- Context-based image indexing plugin for HTML documents
+#
+# 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.
+#
+###########################################################################
+
+# DESCRIPTION:
+#
+#  Extracts images and associated text and metadata from
+#  web pages as individual documents for indexing. Thumbnails
+#  are created from each image for browsing purposes.
+#
+#  Options are available for configuring the aggressiveness of the
+#  associated text extraction mechanisms. A higher level of
+#  aggressiveness will extract more text and consequently
+#  may mean lower accuracy (precision); however, it may also 
+#  retrieve more of the relevant images from the collection (recall). 
+#  Lower levels of aggressiveness maybe result in slightly faster
+#  collection builds at the import stage.
+#
+#  W3ImgPlug is a subclass of HTMLPlug (i.e. it will index pages also 
+#  if required). It can be used in place of HTMLPlug to index both
+#  pages and their images.
+#
+# REQUIREMENTS:
+#   
+#  The ImageMagick image manipulation is used to create
+#  thumbnails and extract some image metadata. (Available 
+#  from http://www.imagemagick.org/)
+#
+#  Unix:
+#    Many Linux distributions contain ImageMagick.
+#
+#  Windows:
+#    ImageMagick can be downloaded from the website above.
+#    Make sure the system path includes the ImageMagick binaries
+#    before using W3ImgPlug.
+#
+#    NOTE: NT/2000/XP contain a filesystem utility 'convert.exe' 
+#    with the same name as the image conversion utility. The
+#    ImageMagick FAQ recommends renaming the filesystem
+#    utility (e.g. to 'fsconvert.exe') to avoid this clash.
+#
+# USAGE:  
+#
+#  An image document consists of metadata elements:
+#
+#   OriginalFilename, FilePath, Filename, FileExt, FileSize,
+#   Width, Height, URL, PageURL, ThumbURL, CacheURL, CachePageURL
+#   ImageText, PageTitle
+#
+#  Most of these are only useful in format strings (e.g. ThumbURL, 
+#  Filename, URL, PageURL, CachePageURL). 
+#
+#  ImageText, as the name suggests contains the indexable text.
+#  (unless using the -document_text plugin option)
+#
+#  Since image documents are made up of metadata elements 
+#  alone, format strings are needed to display them properly. 
+#  NOTE: The receptionist will only display results (e.g. thumbnails)
+#  in 4 columns if the format string begins with "<td><table>".
+#
+#  The example below takes the user to the image within the
+#  source HTML document rather than using a format string
+#  on DocumentText to display the image document itself.
+#
+#  Example collect.cfg:
+#
+#   ...
+#
+#   indexes document:ImageText document:text
+#   defaultindex document:ImageText
+#  
+#   collectionmeta .document:ImageText "images"
+#   collectionmeta .document:text "documents"
+#
+#   ...
+#
+#   plugin W3ImgPlug -index_pages -aggressiveness 6
+#
+#   ...
+#  
+#   format SearchVList '<td>{If}{[Title],[link][icon]&nbsp;[Title][[/link],
+#    <table><tr><td align="center"><a href="[CachePageURL]">
+#    <img src="[ThumbURL]"></a></td></tr><tr><td align="center">
+#    <a href="[CachePageURL]"><font size="-1">[OriginalFilename]</font></a>
+#    <br>[Width]x[Height]</td></tr></table>}</td>'
+#
+#   ...
+#
+ 
+package W3ImgPlug;
+
+use HTMLPlug;
+use ghtml;
+use unicode;
+use util;
+use strict; # 'subs';
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @W3ImgPlug::ISA = qw( HTMLPlug );
+}
+
+my $aggressiveness_list = 
+    [ { 'name' => "1",
+	'desc' => "{W3ImgPlug.aggressiveness.1}" },
+      { 'name' => "2",
+	'desc' => "{W3ImgPlug.aggressiveness.2}" },
+      { 'name' => "3",
+	'desc' => "{W3ImgPlug.aggressiveness.3}" },
+      { 'name' => "4",
+	'desc' => "{W3ImgPlug.aggressiveness.4}" },
+      { 'name' => "5",
+	'desc' => "{W3ImgPlug.aggressiveness.5}" },
+      { 'name' => "6",
+	'desc' => "{W3ImgPlug.aggressiveness.6}" },
+      { 'name' => "7",
+	'desc' => "{W3ImgPlug.aggressiveness.7}" },
+      { 'name' => "8",
+	'desc' => "{W3ImgPlug.aggressiveness.8}" },
+      { 'name' => "9",
+	'desc' => "{W3ImgPlug.aggressiveness.9}" } ];
+
+my $arguments =
+    [ { 'name' => "aggressiveness",
+	'desc' => "{W3ImgPlug.aggressiveness}",
+	'type' => "int",
+	'list' => $aggressiveness_list,
+	'deft' => "3",
+	'reqd' => "no" },
+      { 'name' => "index_pages",
+	'desc' => "{W3ImgPlug.index_pages}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "no_cache_images",
+	'desc' => "{W3ImgPlug.no_cache_images}",
+	'type' => "flag",
+	'reqd' => "no" },
+      { 'name' => "min_size",
+	'desc' => "{W3ImgPlug.min_size}",
+	'type' => "int",
+	'deft' => "2000",
+	'reqd' => "no" },
+      { 'name' => "min_width",
+	'desc' => "{W3ImgPlug.min_width}",
+	'type' => "int",
+	'deft' => "50",
+	'reqd' => "no" },
+      { 'name' => "min_height",
+	'desc' => "{W3ImgPlug.min_height}",
+	'type' => "int",
+	'deft' => "50",
+	'reqd' => "no" },
+      { 'name' => "thumb_size",
+	'desc' => "{W3ImgPlug.thumb_size}",
+	'type' => "int",
+	'deft' => "100",
+	'reqd' => "no" },
+      { 'name' => "convert_params",
+	'desc' => "{W3ImgPlug.convert_params}",
+	'type' => "string",
+	'deft' => "",
+	'reqd' => "no" },
+      { 'name' => "min_near_text",
+	'desc' => "{W3ImgPlug.min_near_text}",
+	'type' => "int",
+	'deft' => "10",
+	'reqd' => "no" },
+      { 'name' => "max_near_text",
+	'desc' => "{W3ImgPlug.max_near_text}",
+	'type' => "int",
+	'deft' => "400",
+	'reqd' => "no" },
+      { 'name' => "smallpage_threshold",
+	'desc' => "{W3ImgPlug.smallpage_threshold}",
+	'type' => "int",
+	'deft' => "2048",
+	'reqd' => "no" },
+      { 'name' => "textrefs_threshold",
+	'desc' => "{W3ImgPlug.textrefs_threshold}",
+	'type' => "int",
+	'deft' => "2",
+	'reqd' => "no" },
+      { 'name' => "caption_length",
+	'desc' => "{W3ImgPlug.caption_length}",
+	'type' => "int",
+	'deft' => "80",
+	'reqd' => "no" },
+      { 'name' => "neartext_length",
+	'desc' => "{W3ImgPlug.neartext_length}",
+	'type' => "int",
+	'deft' => "300",
+	'reqd' => "no" },
+      { 'name' => "document_text",
+	'desc' => "{W3ImgPlug.document_text}",
+	'type' => "flag",
+	'reqd' => "no" } ];
+
+my $options = { 'name'     => "W3ImgPlug",
+		'desc'     => "{W3ImgPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new HTMLPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    # init class variables
+    $self->{'textref'} = undef; # init by read_file fn
+    $self->{'htdoc_obj'} = undef; # init by process fn
+    $self->{'htpath'} = undef; # init by process fn
+    $self->{'hturl'} = undef; # init by process fn
+    $self->{'plaintext'} = undef; # HTML stripped version - only init if needed by raw_neartext sub
+    $self->{'smallpage'} = 0; # set by process fn
+    $self->{'images_indexed'} = undef; # num of images indexed - if 1 or 2 then we know page is small
+    $self->{'initialised'} = undef; # flag (see set_extraction_options())
+
+    return bless $self, $class;
+}
+
+# if indexing pages, let HTMLPlug do it's stuff
+# image extraction done through read()
+sub process {
+    my ($self, $textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+    $self->{'imglist'} = ();
+    if ( $self->{'index_pages'} ) {
+	my $ok = $self->SUPER::process($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli);
+	if ( ! $ok ) { return $ok }
+	$self->{'htdoc_obj'} = $doc_obj;
+    }
+    # else use URL for referencing
+    #if ( $file =~ /(.*)[\/\\]/ ) { $self->{'htpath'} = $1; } else { $self->{'htpath'} = $file; }
+
+    $self->{'htpath'} = $base_dir if (-d $base_dir);
+    if ( $file =~ /(.*)[\/\\]/ ) { $self->{'htpath'} .= "/$1"; }
+    $self->{'htpath'} =~ s/\\/\//g;  # replace \ with /
+
+    $self->{'hturl'} = "http://$file";
+    $self->{'hturl'} =~ s/\\/\//g; # for windows
+    ($self->{'filename'}) = $file =~ /.*[\/\\](.*)/;
+    ($self->{'base_path'}) = $file =~ /(.*)[\/\\]/i;
+    if ( ( -s "$base_dir/$file") <= $self->{'smallpage_threshold'} ) {
+	$self->{'smallpage'} = 1;
+    } else { $self->{'smallpage'} = 0; }
+
+    if ( defined($self->{'initialised'}) ) { return 1; }
+    else {
+	$self->{'initialised'} = $self->set_extraction_options($base_dir =~ /^(.*?)\/import/i);
+	return $self->{'initialised'};
+    }
+}
+
+# get complex configuration options from configuration files
+# -- $GSDLCOLLECTION/etc/W3ImgPlug.cfg (tag sets for aggr 2+)
+# -- $GSDLHOME/etc/packages/phind/stopword/en/brown.sw (stopwords for aggr 5+)
+
+# If there's no W3ImgPlug.cfg file we'll use the following default values
+my $defaultcfg = '
+<delimitertagset>
+  <setname>Caption</setname>
+  <taggroup>font</taggroup>
+  <taggroup>tt</taggroup>
+  <taggroup>small</taggroup>
+  <taggroup>b</taggroup>
+  <taggroup>i</taggroup>
+  <taggroup>u</taggroup>
+  <taggroup>em</taggroup>
+  <taggroup>td</taggroup>
+  <taggroup>li</taggroup>
+  <taggroup>a</taggroup>
+  <taggroup>p</taggroup>
+  <taggroup>tr</taggroup>
+  <taggroup>center</taggroup>
+  <taggroup>div</taggroup>
+  <taggroup>caption</taggroup>
+  <taggroup>br</taggroup>
+  <taggroup>ul</taggroup>
+  <taggroup>ol</taggroup>
+  <taggroup>table</taggroup>
+  <taggroup>hr</taggroup>
+</delimitertagset>
+
+<delimitertagset>
+  <setname>Neartext</setname>
+  <taggroup>tr|hr|table|h\d|img|body</taggroup>
+  <taggroup>td|tr|hr|table|h\d|img|body</taggroup>
+  <taggroup>p|br|td|tr|hr|table|h\d|img|body</taggroup>
+  <taggroup>font|p|i|b|em|img</taggroup>
+</delimitertagset>
+';
+
+sub set_extraction_options() {
+    my ($self, $collpath) = @_;
+    my ($filepath);
+
+    print {$self->{'outhandle'}} "W3ImgPlug: Initialising\n"
+	if $self->{'verbosity'} > 1;
+    # etc/W3ImgPlug.cfg (XML)
+    # tag sets for captions and neartext
+    if ( $self->{'aggressiveness'} > 1 && $self->{'aggressiveness'} != 9 ) {
+	$self->{'delims'} = [];
+	$self->{'cdelims'} = [];
+	my ($cfg, @tagsets, $tagset, $type, @delims);
+
+	$filepath = "$collpath/etc/W3ImgPlug.cfg";
+	if ( open CFG, "<$filepath" ) {
+	    while (<CFG>) { $cfg .= $_ }
+	    close CFG;
+	} else {
+	    $cfg = $defaultcfg;
+	}
+
+	(@tagsets) = 
+	    $cfg =~ /<delimitertagset>(.*?)<\/delimitertagset>/igs;
+	foreach $tagset ( @tagsets ) {
+	    ($type) = $tagset =~ /<setname>(.*?)<\/setname>/i;
+	    if ( lc($type) eq "caption" ) {
+		(@{$self->{'cdelims'}}) = $tagset =~ /<taggroup>(.*?)<\/taggroup>/igs;
+	    }
+	    elsif ( lc($type) eq "neartext" ) {
+		(@{$self->{'delims'}}) = $tagset =~ /<taggroup>(.*?)<\/taggroup>/igs;
+	    }
+	}
+
+	# output a warning if there seem to be no delimiters
+	if ( scalar(@{$self->{'cdelims'}} == 0)) {
+	    print {$self->{'outhandle'}} "W3ImgPlug: Warning: no caption delimiters found in $filepath\n";
+	}
+	if ( scalar(@{$self->{'delims'}} == 0)) {
+	    print {$self->{'outhandle'}} "W3ImgPlug: Warning: no neartext delimiters found in $filepath\n";
+	}
+    }
+    
+    # get stop words for textual reference extraction
+    # TODO: warnings scroll off. Would be best to output them again at end of import
+    if ( $self->{'aggressiveness'} >=5 && $self->{'aggressiveness'} != 9 ) {
+	$self->{'stopwords'} = ();
+	$filepath = &util::filename_cat($ENV{'GSDLHOME'}, "etc", "packages", "phind", "stopword", "en", "brown.sw");
+	if ( open STOPWORDS, "<$filepath" ) {
+	    while ( <STOPWORDS> ) {
+		chomp;
+		$self->{'stopwords'}{$_} = 1;
+	    }
+	    close STOPWORDS;
+	} else {
+	    print {$self->{'outhandle'}} "W3ImgPlug: Warning: couldn't open stopwords file at $filepath ($!)\n";
+	}
+	
+    }
+
+    if ( $self->{'neartext_length'} > $self->{'max_near_text'} ) {
+	$self->{'max_near_text'} = $self->{'neartext_length'} * 1.33;
+	print {$self->{'outhandle'}} "W3ImgPlug: Warning: adjusted max_text to $self->{'max_near_text'}\n";
+    } 
+    if ( $self->{'caption_length'} > $self->{'max_near_text'} ) {
+	$self->{'max_near_text'} = $self->{'caption_length'} * 1.33;
+	print {$self->{'outhandle'}} "W3ImgPlug: Warning: adjusted max_text to $self->{'max_near_text'}\n";
+    }
+
+    return 1;
+}
+
+# return number of files processed, undef if can't recognise, -1 if 
+# cant process
+# Note that $base_dir might be "" and that $file might 
+# include directories
+sub read {
+    my ($self, $pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = (@_);
+    my ($doc_obj, $section, $filepath, $imgtag, $pos, $context, $numdocs, $tndir, $imgs);
+    # forward normal read (runs HTMLPlug if index_pages T)
+    my $ok =  $self->SUPER::read($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli); 
+    if ( ! $ok ) { return $ok } # what is this returning??
+
+    my $outhandle = $self->{'outhandle'};
+    my $textref = $self->{'textref'};
+    my $htdoc_obj = $self->{'htdoc_obj'};
+    $numdocs = 0;
+    $base_dir =~ /(.*)\/.*/;
+    $tndir = "$1/archives/thumbnails"; # TODO: this path shouldn't be hardcoded?
+    &util::mk_all_dir($tndir) unless -e "$tndir"; 
+
+    $imgs = \%{$self->{'imglist'}};
+    my $nimgs = $self->get_img_list($textref);
+    $self->{'images_indexed'} = $nimgs;
+    if ( $nimgs > 0 ) {
+	my @fplist = (sort { $imgs->{$a}{'pos'} <=> $imgs->{$b}{'pos'} } keys %{$imgs});
+	my $i = 0;
+	foreach $filepath ( @fplist ) {
+	    $pos = $imgs->{$filepath}{'pos'}; 
+	    $context = substr ($$textref, $pos - 50, $pos + 50); # grab context (quicker)
+	    ($imgtag) = ($context =~ /(<(?:img|a|body)\s[^>]*$filepath[^>]*>)/is );
+	    if (! defined($imgtag)) { $imgtag = $filepath }
+	    print $outhandle "W3ImgPlug: extracting $filepath\n"
+		if ( $self->{'verbosity'} > 1 );
+	    $doc_obj = new doc ("", "indexed_doc");
+	    $section = $doc_obj->get_top_section();
+	    my $prevpos = ( $i == 0 ? 0 : $imgs->{$fplist[$i - 1]}{'pos'});
+	    my $nextpos = ( $i >= ($nimgs -1) ? -1 : $imgs->{$fplist[$i + 1]}{'pos'} );
+
+	    $self->extract_image_info($imgtag, $filepath, $textref, $doc_obj, $section, $tndir, $prevpos, $nextpos);
+            $processor->process($doc_obj);
+	    $numdocs++;
+	    $i++;
+	}
+	return $numdocs;
+    } else {
+	print $outhandle "W3ImgPlug: No images from $file indexed\n"
+	    if ( $self->{'verbosity'} > 2 );
+	return 1;
+    }
+    
+}
+
+# for every valid image tag
+# 1. extract related text and image metadata
+# 2. add this as document meta-data
+# 3. add assoc image(s) as files
+#
+sub extract_image_info {
+    my $self = shift (@_);
+    my ($tag, $id, $textref, $doc_obj, $section, $tndir, $prevpos, $nextpos) = (@_);
+    my ($filename, $orig_fp, $fn, $ext, $reltext, $relreltext, $crcid, $imgs,
+	$thumbfp, $pagetitle, $alttext,	$filepath, $aggr);
+    $aggr = $self->{'aggressiveness'};
+    $imgs = \%{$self->{'imglist'}};
+    $filepath = $imgs->{$id}{'relpath'}; 
+    ($filename) = $filepath =~ /([^\/\\]+)$/s;
+    ($orig_fp) = "$self->{'base_path'}/$filepath"; 
+    $orig_fp =~ tr/+/ /;
+    $orig_fp =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # translate %2E to space, etc
+    $orig_fp =~ s/\\/\//g;
+    $filepath = "$self->{'htpath'}/$filepath";
+    my ($onlyfn) = $filename =~ /([^\\\/]*)$/;
+    ($fn, $ext) = $onlyfn =~ /(.*)\.(.*)/;
+    $fn = lc $fn; $ext = lc $ext;
+    ($reltext) = "<tr><td>GifComment</td><td>" . `identify $filepath -ping -format "%c"` . "</td></tr>\n"
+        if ($ext eq "gif");
+    $reltext .= "<tr><td>FilePath</td><td>$orig_fp</td></tr>\n";
+
+    if ($ENV{'GSDLOS'} =~ /^windows$/i) {
+	$crcid = "$fn.$ext." . $self->{'next_crcid'}++;
+    } else { ($crcid) = `cksum $filepath` =~ /^(\d+)/; }
+    $thumbfp = "$tndir/tn_$crcid.jpg";
+    `convert -flatten -filter Hanning $self->{'convert_params'} -geometry "$self->{'thumb_size'}x$self->{'thumb_size'}>" $filepath $thumbfp` unless -e $thumbfp;
+    if ( ! (-e $thumbfp) ) {
+	print STDERR "W3ImgPlug: 'convert' failed. Check ImageMagicK binaries are installed and working correctly\n"; return 0; 
+    }
+    
+    # shove in full text (tag stripped or unstripped) if settings require it
+    if ( $aggr == 10) {
+	$reltext = "<tr><td>AllPage</td><td>" . $$textref . "</td><tr>\n";   # level 10 (all text, verbatim)
+    } else {
+	$pagetitle = $self->get_meta_value("title", $textref);
+	($alttext) = $tag =~ /\salt\s*=\s*(?:\"|\')(.+?)(?:\"|\')/is;
+	if ( defined($alttext) && length($alttext) > 1) {
+	    $reltext .= "<tr><td>ALTtext</td><td>$alttext</td></tr>\n"; }
+	$reltext .= "<tr><td>SplitCapitalisation</td><td>" . 
+	    $self->split_filepath($orig_fp) . "</td></tr>\n";
+
+	# get caption/tag based near text (if appropriate)
+	if ( $aggr > 1 ) {
+	    if ( $aggr >= 2 ) {
+		$reltext .= 
+		    $self->extract_caption_text($tag, $textref, $prevpos, $imgs->{$id}{'pos'}, $nextpos);
+		$relreltext = $reltext;
+	    } 
+	    # repeat the filepath, alt-text, caption, etc
+	    if ( $aggr == 8 ) {
+		$reltext .= $relreltext; 
+	    }
+	    if ( $aggr >= 3 ) {
+		$reltext .= 
+		    $self->extract_near_text($tag, $textref, $prevpos, $imgs->{$id}{'pos'}, $nextpos);
+	    }
+	
+	    # get page metadata (if appropriate)
+	    if ( $aggr >= 6 || ( $aggr >= 2 && 
+						     ( $self->{'images_indexed'} < 2 || 
+						       ($self->{'smallpage'} == 1 && $self->{'images_indexed'} < 6 )))) {	
+		$reltext .= $self->get_page_metadata($textref);
+	    }
+	    # textual references
+	    if ( $aggr  == 5 || $aggr >= 7) {
+		if ( length($relreltext) > ($self->{'caption_length'} * 2) )  {
+		    $reltext .= $self->get_textrefs($relreltext, $textref, $prevpos, $imgs->{$id}{'pos'}, $nextpos); }
+		else {
+		    $reltext .= $self->get_textrefs($reltext, $textref, $prevpos, $imgs->{$id}{'pos'}, $nextpos); 
+		}
+	    }
+	} # aggr > 1
+    } # aggr != 10
+    
+    $doc_obj->set_OID($crcid); 
+    $doc_obj->associate_file($thumbfp, "$fn.thumb.jpg", undef, $section);
+    $doc_obj->add_metadata($section, "OriginalFilename", $filename);
+    $doc_obj->add_metadata($section, "FilePath", $orig_fp);
+    $doc_obj->add_metadata($section, "Filename", $fn);
+    $doc_obj->add_metadata($section, "FileExt", $ext);
+    $doc_obj->add_metadata($section, "FileSize", $imgs->{$id}{'filesize'});
+    $doc_obj->add_metadata($section, "Width", $imgs->{$id}{'width'});
+    $doc_obj->add_metadata($section, "Height", $imgs->{$id}{'height'});
+    $doc_obj->add_metadata($section, "URL", "http://$orig_fp");
+    $doc_obj->add_metadata($section, "PageURL", $self->{'hturl'});
+    $doc_obj->add_metadata($section, "PageTitle", $pagetitle);
+    $doc_obj->add_metadata($section, "ThumbURL", 
+			   "_httpprefix_/collect/[collection]/index/assoc/[archivedir]/$fn.thumb.jpg");
+    $doc_obj->add_metadata($section, "FileFormat", "W3Img");
+
+    if ( $self->{'document_text'} ) {
+	$doc_obj->add_utf8_text($section, "<table border=1>\n$reltext</table>");
+    } else {
+	$doc_obj->add_metadata($section, "ImageText", "<table border=1>\n$reltext</table>\n");
+    }
+    
+    if ( $self->{'index_pages'} ) {
+	my ($cache_url) = "_httpdoc_&d=" . $self->{'htdoc_obj'}->get_OID();
+	if ( $imgs->{$id}{'anchored'} ) {
+	    my $a_name = $id;
+	    $a_name =~ s/[\/\\\:\&]/_/g;
+	    $cache_url .=  "#gsdl_$a_name" ;
+	}
+	$doc_obj->add_utf8_metadata($section, "CachePageURL", $cache_url);
+    }
+    if ( ! $self->{'no_cache_images'} ) {
+	$onlyfn = lc $onlyfn;
+	$doc_obj->associate_file($filepath, $onlyfn, undef, $section);
+	$doc_obj->add_utf8_metadata($section, "CacheURL", 
+			       "_httpprefix_/collect/[collection]/index/assoc/[archivedir]/$onlyfn");
+    }
+    return 1;
+}
+
+sub get_page_metadata {
+    my ($self, $textref) = (@_);
+    my (@rval);
+    $rval[0] = $self->get_meta_value("title", $textref);
+    $rval[1] = $self->get_meta_value("keywords", $textref);
+    $rval[2] = $self->get_meta_value("description", $textref);
+    $rval[3] = $self->{'filename'};
+
+    return wantarray ? @rval : "<tr><td>PageMeta</td><td>@rval</td></tr>\n" ;
+}
+
+# turns LargeCatFish into Large,Cat,Fish so MG sees the separate words
+sub split_filepath {
+    my ($self, $filepath) = (@_);
+    my (@words) = $filepath =~ /([A-Z][a-z]+)/g; 
+    return join(',', @words);
+}
+
+# finds and extracts sentences
+# that seem to be on the same topic
+# as other related text (correlations)
+# and textual references (e.g. in figure 3 ...)
+sub get_textrefs {
+    my ($self, $reltext, $textref, $prevpos, $pos, $nextpos) = (@_);
+    my ($maxtext, $mintext, $startpos, $context_size, $context);
+
+    my (@relwords, @refwords, %sentences, @pagemeta);
+
+    # extract larger context
+    $maxtext = $self->{'max_near_text'};
+    $startpos = $pos - ($maxtext * 4);
+    $context_size = $maxtext*10;
+    if ($startpos < $prevpos ) { $startpos = $prevpos }
+    if ($nextpos != -1 && $context_size > ( $nextpos - $startpos )) { $context_size = ($nextpos - $startpos) }
+    $context = substr ( $$textref, $startpos, $context_size );
+    $context =~ s/<.*?>//gs;
+    $context =~ s/^.*>(.*)/$1/gs;
+    $context =~ s/(.*)<.*$/$1/gs;
+
+    # get page meta-data (if not already included)
+    if ( $self->{'aggressiveness'} == 5 && ! $self->{'smallpage'} ) {
+	@pagemeta = $self->get_page_metadata($textref);
+	foreach my $value ( @pagemeta ) {
+	    $context .= "$value."; # make each into psuedo-sentence
+	}
+    }
+
+    # TODO: this list is not exhaustive
+    @refwords = ( '(?:is|are)? ?(?:show(?:s|n)|demonstrate(?:d|s)|explains|features) (?:in|by|below|above|here)', 
+		  '(?:see)? (?:figure|table)? (?:below|above)');    
+
+    # extract general references
+    foreach my $rw ( @refwords ) {
+	while ( $context =~ /[\.\?\!\,](.*?$rw\W.*?[\.\?\!\,])/ig ) {
+	    my $sentence = $1;
+	    $sentence =~ s/\s+/ /g;
+	    $sentences{$sentence}+=2;
+	}
+    }
+    # extract specific (figure, table) references by number
+    my ($fignum) = $context =~ /[\.\?\!].*?(?:figure|table)s?[\-\_\ \.](\d+\w*)\W.*?[\.\?\!]/ig;
+    if ( $fignum ) {
+	foreach my $rw ( @refwords ) {
+	    while ( $context =~ /[\.\?\!](.*?(figure|table)[\-\_\ \.]$fignum\W.*?[\.\?\!])/ig ) {
+		my $sentence = $1;
+		$sentence =~ s/\s+/ /g;
+		$sentences{$sentence}+=4;
+	    }
+	}
+    }
+
+    # sentences with occurances of important words
+    @relwords = $reltext =~ /([a-zA-Z]{4,})/g; # take out small words
+    foreach my $word ( @relwords ) {
+	if ( $self->{'stopwords'}{$word} ) { next } # skip stop words
+	while ( $context =~ /([^\.\?\!]*?$word\W.*?[\.\?\!])/ig ) {
+	    my $sentence = $1;
+	    $sentence =~ s/\s+/ /g;
+	    $sentences{$sentence}++;
+	}
+    }
+    foreach my $sentence ( keys %sentences ) {
+	if ($sentences{$sentence} < $self->{'textrefs_threshold'}) {
+	    delete $sentences{$sentence};
+	}
+    }
+    my ($rval) = join "<br>\n", (keys %sentences);
+    if ( $rval && length($rval) > 5 ) {
+	return ( "<tr><td>TextualReferences</td><td>" . $rval . "</td></tr>\n") }
+    else { return "" }
+}
+
+# handles caption extraction
+# calling the extractor with different
+# tags and choosing the best candidate caption
+sub extract_caption_text {
+    my ($self, $tag, $textref, $prevpos, $pos, $nextpos) = (@_);
+    my (@neartext, $len, $hdelim, $mintext, $goodlen,
+	$startpos, $context, $context_size);
+    
+    $mintext = $self->{'min_near_text'};
+    $goodlen = $self->{'caption_length'};
+
+    # extract a context to extract near text from (faster)
+    $context_size = $self->{'max_near_text'}*3;
+    $startpos = $pos - ($context_size / 2);
+    if ($startpos < $prevpos ) { $startpos = $prevpos }
+    if ($nextpos != -1 && $context_size > ( $nextpos - $startpos )) 
+    { $context_size = ($nextpos - $startpos) }
+
+    $context = substr ( $$textref, $startpos, $context_size );
+    $context =~ s/<!--.*?-->//gs;
+    $context =~ s/^.*-->(.*)/$1/gs;
+    $context =~ s/(.*)<!--.*$/$1/gs;
+
+    # try stepping through markup delimiter sets
+    # and selecting the best one
+    foreach $hdelim ( @{ $self->{'cdelims'} } ) {
+	@neartext = $self->extract_caption($tag, $hdelim, \$context);
+	$len = length(join("", @neartext));
+	last if ($len >= $mintext && $len <= $goodlen);
+    }
+    # reject if well over reasonable length
+    if ( $len > $goodlen ) {
+	@neartext = [];
+    }
+    $neartext[0] = " " if (! defined $neartext[0]);
+    $neartext[1] = " " if (! defined $neartext[1]);
+    return "<tr><td>Caption</td><td>" . (join ",",  @neartext) . "</td></tr>\n"; # TODO: the | is for testing purposes
+} # end extract_caption_text
+
+# the previous section header often gives a bit
+# of context to the section that the image is
+# in (invariably the header is before/above the image)
+# so extract the text of the closest header above the image
+#
+# this fn just gets all the headers above the image, within the context window
+sub get_prev_header {
+    my ($self, $pos, $textref) = (@_);
+    my ($rhtext);
+    while ( $$textref =~ /<h\d>(.*?)<\/h\d>/sig ) {
+	# only headers before image
+	if ((pos $$textref) < $pos) {
+	    $rhtext .= "$1, ";
+	}
+    } 
+    if ( $rhtext ) { return "Header($rhtext)" }
+    else { return "" }
+}
+
+# not the most robust tag stripping 
+# regexps (see perl.com FAQ) but good enough
+#
+# used by caption & tag-based near text algorithms
+sub strip_tags {
+    my ( $self, $value ) = @_;
+    if ( ! defined($value) ) { $value = "" } # handle nulls
+    else {
+	$value =~ s/<.*?>//gs; # strip all html tags
+	$value =~ s/\s+/\ /g; # remove extra whitespace
+	$value =~ s/\&\w+\;//g; # remove &nbsp; etc
+    }
+    return $value;
+}
+
+# uses the given tag(s) to identify
+# the caption near to the image
+# (below, above or both below and above)
+sub extract_caption {
+    my ($self, $tag, $bound_tag, $contextref) = (@_);
+    my (@nt, $n, $etag, $gotcap);
+    return ("", "") if ( ! ($$contextref =~ /\Q$tag/) );
+
+    $nt[0] = $`;
+    $nt[1] = $';
+    $gotcap = 0;
+
+    # look before the image for a boundary tag
+    ($etag, $nt[0]) = $nt[0] =~ /<($bound_tag)[\s]?.*?>(.*?)$/is;
+    # if bound_tag too far from the image, then prob not caption
+    # (note: have to allow for tags, so multiply by 3
+    if ( $etag && length($nt[0]) < ($self->{'caption_length'} * 3) ) { 
+	if ( $nt[0] =~ /<\/$etag>/si ) {
+	    # the whole caption is above the image: <tag>text</tag><img>
+	    ($nt[0]) =~ /<(?:$etag)[\s]?.*?>(.*?)<\/$etag>/is;
+	    $nt[0] = $self->strip_tags($nt[0]);
+	    if ( length($nt[0]) > $self->{'min_near_text'} ) { 
+		$gotcap = 1;
+		$nt[1] = ""; 
+	    }
+
+	} elsif ( $nt[1] =~ /<\/$etag>/si) {
+	    # the caption tag covers image: <tag>text?<img>text?</tag>
+	    ($nt[1]) = $nt[1] =~ /(.*?)<\/$etag>/si;
+	    $nt[0] = $self->strip_tags($nt[0] . $nt[1]);
+	    if ( length($nt[0]) > $self->{'min_near_text'} ) { 
+		$gotcap = 2;
+		$nt[1] = "";
+	    }
+	}
+    }
+    # else try below the image
+    if ( ! $gotcap ) { 
+	# the caption is after the image: <img><tag>text</tag>
+	($etag, $nt[1]) = $nt[1] =~ /^.*?<($bound_tag)[\s]?.*?>(.*)/is;
+	if ( $etag && $nt[1] =~ /<\/$etag>/s) {
+	    ($nt[1]) = $nt[1] =~ /(.*?)<\/$etag>/si;
+	    $gotcap = 3;
+	    $nt[0] = "";
+	    $nt[1] = $self->strip_tags($nt[1]);
+	} 
+    }
+    if ( ! $gotcap ) { $nt[0] = $nt[1] = "" }
+    else {
+	# strip part-tags
+	$nt[0] =~ s/^.*>//s;
+	$nt[1] =~ s/<.*$//s;
+    }
+    my ($type);
+    if ( $gotcap == 0 ) { return ("nocaption", "") }
+    elsif ( $gotcap == 1 ) { $type = "captionabove:" }
+    elsif ( $gotcap == 2 ) { $type = "captioncovering:" }
+    elsif ( $gotcap == 3 ) { $type = "captionbelow:" }
+    return ($type, $nt[0], $nt[1]);
+}
+
+# tag-based near text
+# 
+# tries different tag sets
+# and chooses the best one
+sub extract_near_text {
+    my ($self, $tag, $textref, $prevpos, $pos, $nextpos) = (@_);
+    my (@neartext, $len, $hdelim, $maxtext, $mintext, $goodlen,
+	@bestlen, @best, $startpos, $context, $context_size,
+	$dist, $bdist, $best1, $i, $nt);
+    $bestlen[0] = $bestlen[1] = 0; $bestlen[2] = $bdist = 999999;
+    $best[0] = $best[1] = $best[2] = "";
+    $maxtext = $self->{'max_near_text'};
+    $mintext = $self->{'min_near_text'};
+    $goodlen = $self->{'neartext_length'}; 
+
+    # extract a context to extract near text from (faster)
+    $context_size = $maxtext*4;
+    $startpos = $pos - ($context_size / 2);
+    if ($startpos < $prevpos ) { $startpos = $prevpos }
+    if ($nextpos != -1 && $context_size > ( $nextpos - $startpos )) 
+    { $context_size = ($nextpos - $startpos) }
+    $context = substr ( $$textref, $startpos, $context_size );
+    $context =~ s/<!--.*?-->//gs;
+    $context =~ s/^.*-->(.*)/$1/gs;
+    $context =~ s/(.*)<!--.*$/$1/gs;
+
+    # try stepping through markup delimiter sets
+    # and selecting the best one
+    foreach $hdelim ( @{ $self->{'delims'} } ) {
+	@neartext = $self->extract_tagged_neartext($tag, $hdelim, \$context);
+	$nt = join("", @neartext);
+	$len = length($nt);
+	# Priorities:
+	# 1. Greater than mintext 
+	# 2. Less than maxtext 
+	# 3. Closest to goodlen
+	if ( $len <= $goodlen && $len > $bestlen[0] ) {
+	    $bestlen[0] = $len;
+	    $best[0] = $hdelim;
+	} elsif ( $len >= $maxtext && $len < $bestlen[2] ) {
+	    $bestlen[2] = $len;
+	    $best[2] = $hdelim;
+	} elsif ( $len >= $bestlen[0] && $len <= $bestlen[2] ) {
+	    $dist = abs($goodlen - $len);
+	    if ( $dist < $bdist ) {
+		$bestlen[1] = $len;
+		$best[1] = $hdelim;
+		$bdist = $dist;
+	    }
+	}
+    }
+    $best1 = 2;
+    foreach $i ( 0..2 ) {
+	if ( $bestlen[$i] == 999999 ) { $bestlen[$i] = 0 }
+	$dist = abs($goodlen - $bestlen[$i]);
+	if ( $bestlen[$i] > $mintext && $dist <= $bdist ) {
+	    $best1 = $i;
+	    $bdist = $dist;
+	}
+    }
+    @neartext = $self->extract_tagged_neartext($tag, $best[$best1], \$context);
+    if ( $bestlen[$best1] > $maxtext ) {
+	# truncate on word boundary if too much text
+	my $hmax = $maxtext / 2;
+	($neartext[0]) = $neartext[0] =~ /([^\s]*.{1,$hmax})$/s;
+	($neartext[1]) = $neartext[1] =~ /^(.{1,$hmax}[^\s]*)/s;
+    } elsif ( $bestlen[$best1] < $mintext ) {
+	# use plain text extraction if tags failed (e.g. usable tag outside context)
+	print {$self->{'outhandle'}} "W3ImgPlug: Fallback to plain-text extraction for $tag\n" 
+	    if $self->{'verbosity'} > 2;
+	$neartext[0] = "<tr><td>RawNeartext</td><td>" . $self->extract_raw_neartext($tag, $textref) . "</td></tr>";
+	$neartext[1] = "";
+    }
+    # get previous header if available
+    $neartext[0] .= "<br>\n" . 
+	$self->get_prev_header($pos, \$context) if ( $self->{'aggressiveness'} >= 4 );
+    $neartext[0] = " " if (! defined $neartext[0]);
+    $neartext[1] = " " if (! defined $neartext[1]);
+
+    return "<tr><td>NearText</td><td>" . (join "|",  @neartext) . "</td></tr>\n"; # TODO: the | is for testing purposes
+} # end extract_near_text
+
+# actually captures tag-based
+# near-text given a tag set
+sub extract_tagged_neartext {
+    my ($self, $tag, $bound_tag, $textref) = (@_);
+    return "" if ( ! ($$textref =~ /\Q$tag/) );
+    my (@nt, $delim, $pre_tag, $n);
+    $nt[0] = $`;
+    $nt[1] = $';
+
+    # get text after previous image tag
+    $nt[0] =~ s/.*<($bound_tag)[^>]*>(.*)/$2/is; # get rid of preceding text
+    if (defined($1)) { $delim = $1 }    
+    $pre_tag = $bound_tag;
+
+    if (defined($delim)) {
+	# we want to try and use the end tag of the previous delimiter
+	# (put it on the front of the list)
+	$pre_tag =~ s/(^|\|)($delim)($|\|)//i; # take it out
+	$pre_tag =~ s/\|\|/\|/i; # replace || with |
+	$pre_tag = $delim . "|" . $pre_tag; # put it on the front
+    }
+    
+    # get text before next image tag
+    $nt[1] =~ s/<\/?(?:$pre_tag)[^>]*>.*//is; # get rid of stuff after first delimiter
+
+    # process related text
+    for $n (0..1) {
+	if ( defined($nt[$n]) ) {
+	    $nt[$n] =~ s/<.*?>//gs; # strip all html tags
+	    $nt[$n] =~ s/\s+/\ /gs; # remove extra whitespace
+	    $nt[$n] =~ s/\&\w+\;//sg; # remove &nbsp; etc
+	    # strip part-tags
+	    if ( $n == 0 ) { $nt[0] =~ s/^.*>//s }
+	    if ( $n == 1 ) { $nt[1] =~ s/<.*$//s }
+	} else { $nt[$n] = ""; } # handle nulls
+    }
+    return @nt;
+}
+
+# this function is fall-back
+# if tags aren't suitable.
+#
+# extracts a fixed length of characters
+# either side of image tag (on word boundary)
+sub extract_raw_neartext {
+    my ($self, $tag, $textref) = (@_);
+    my ($rawtext, $startpos, $fp);
+    my $imgs = \%{$self->{'imglist'}};
+    ($fp) = $tag =~ /([\w\\\/]+\.(?:gif|jpe?g|png))/is;
+    if (! $fp) { return " " };
+    # if the cached, plain-text version isn't there, then create it
+    $self->init_plaintext($textref) unless defined($self->{'plaintext'});
+
+    # take the closest maxtext/2 characters 
+    # either side of the tag (by word boundary)
+    return "" if ( ! exists $imgs->{$fp}{'rawpos'} );
+    $startpos = $imgs->{$fp}{'rawpos'} - (($self->{'max_near_text'} / 2) + 20);
+    if ( $startpos < 0 ) { $startpos = 0 }
+    $rawtext = substr $self->{'plaintext'}, $startpos, $self->{'max_near_text'} + 20;
+    $rawtext =~ s/\s\s/ /g;
+
+    return $rawtext;
+}
+
+# init plaintext variable for HTML-stripped version 
+# (for full text index/raw assoc text extraction)
+sub init_plaintext {
+    my ($self, $textref) = (@_);
+    my ($page, $fp);
+    my $imgs = \%{$self->{'imglist'}};
+    $page = $$textref; # make a copy of original
+
+    # strip tags around image filenames so they don't get zapped
+    $page =~ s/<\w+\s+.*?([\w\/\\]+\.(?:gif|jpe?g|png))[^>]*>/\"$1\"/gsi;
+    $page =~ s/<.*?>//gs;
+    $page =~ s/&nbsp;/ /gs;
+    $page =~ s/&amp;/&/gs; #TODO: more &zzz; replacements (except &lt;, $gt;)
+
+    # get positions and strip images
+    while ( $page =~ /([^\s\'\"]+\.(jpe?g|gif|png))/ig ) {
+	$fp = $1;
+	if ( $imgs->{$fp}{'exists'} ) {
+	    $imgs->{$fp}{'rawpos'} = pos $page;
+	}
+	$page =~ s/\"$fp\"//gs;
+    }
+    $self->{'plaintext'} = $page;
+}
+
+# finds and filters images based on size 
+# (dimensions, height, filesize) and existence
+#
+# looks for image filenames (.jpg, .gif, etc)
+# and checks for existence on disk 
+# (hence supports most JavaScript images)
+sub get_img_list {
+    my $self = shift (@_);
+    my ($textref) = (@_);
+    my ($filepath, $relpath, $abspath, $pos, $num, $width, $height, $filesize);
+    my $imgs = \%{$self->{'imglist'}};
+    while ( $$textref =~ /([^\s\'\"]+\.(jpe?g|gif|png))/ig ) {
+	$filepath = $1;
+	$pos = pos $$textref;
+	next if ( $imgs->{$filepath}{'relpath'} );
+        $relpath = $filepath;
+	$relpath =~ s/^http\:\/\///; # remove http:// in case we have mirrored it
+	$relpath =~ s/\\/\//g;  # replace \ with /
+	$relpath =~ s/^\.\///s; # make "./filepath" into "filepath"
+	$imgs->{$filepath}{'relpath'} = $relpath;
+	$abspath = "$self->{'htpath'}/$relpath";
+
+	if (! -e $abspath) { next }
+
+	# can't modify real filepath var because it
+	# then can't be located in the page for tag recognition later
+	($width, $height) = 
+	    `identify $abspath -ping -format "%wx%h"` =~ /^(\d*)x(\d*)$/m;
+	if (! ($width && $height)) { 
+	    print STDERR "W3ImgPlug: ($abspath) 'identify' failed. Check ImageMagicK binaries are installed and working correctly\n"; next;
+	}
+	$filesize = (-s $abspath);
+	if ( $filesize >= $self->{'min_size'} 
+	    && ( $width >= $self->{'min_width'} ) 
+	    && ( $height >= $self->{'min_height'} ) ) {
+	    
+	   $imgs->{$filepath}{'exists'} = 1;
+	   $imgs->{$filepath}{'pos'} = $pos;
+	   $imgs->{$filepath}{'width'} = $width;
+	   $imgs->{$filepath}{'height'} = $height;
+	   $imgs->{$filepath}{'filesize'} = $filesize;
+       } else {
+	   print {$self->{'outhandle'}} "W3ImgPlug: skipping $self->{'base_path'}/$relpath: $filesize, $width x $height\n" 
+	       if $self->{'verbosity'} > 2;
+       }
+    }
+    $num = 0;
+    foreach my $i ( keys %{$imgs} ) {
+	if ( $imgs->{$i}{'pos'} ) {
+	    $num++;
+	} else { delete $imgs->{$i} }
+    }
+    return $num;
+}
+
+# make the text available to the read function
+# by making it an object variable
+sub read_file {
+    my ($self, $filename, $encoding, $language, $textref) = @_;
+    $self->SUPER::read_file($filename, $encoding, $language, $textref);
+
+    # if HTMLplug has run through, then it will
+    # have replaced references so we have to 
+    # make a copy of the text before processing
+    if ( $self->{'index_pages'} ) {
+	$self->{'text'} = $$textref;
+	$self->{'textref'} = \($self->{'text'});
+    } else {
+	$self->{'textref'} = $textref;
+    }
+    $self->{'plaintext'} = undef;
+}
+
+# HTMLPlug only extracts meta-data if it is specified in plugin options
+# hence a special function to do it here
+sub get_meta_value {
+    my ($self, $name, $textref) = @_;
+    my ($value);
+    $name = lc $name;
+    if ($name eq "title") {
+	($value) = $$textref =~ /<title>(.*?)<\/title>/is
+    } else {
+	my $qm = "(?:\"|\')";
+	($value) = $$textref =~ /<meta name\s*=\s*$qm?$name$qm?\s+content\s*=\s*$qm?(.*?)$qm?\s*>/is
+    }
+    $value = "" unless $value;
+    return $value;
+}
+
+# make filename an anchor reference
+# so we can go straight to the image
+# within the cached version of the source page
+# (augment's HTMLPlug sub)
+sub replace_images {
+    my $self = shift (@_);
+    my ($front, $link, $back, $base_dir, 
+	$file, $doc_obj, $section) = @_;
+    $link =~ s/\"//g;
+    my ($a_name) = $link;
+    $a_name =~ s/[\/\\\:\&]/_/g;
+    # keep a list so we don't repeat the same anchor
+    if ( ! $self->{'imglist'}{$link}{'anchored'} ) {
+	$front = "<a name=\"gsdl_$a_name\">$front";
+	$back = "$back</a>";
+	$self->{'imglist'}{$link}{'anchored'} = 1;
+    }
+    return $self->SUPER::replace_images($front, $link, $back, $base_dir, 
+				     $file, $doc_obj, $section);
+}
+
+1;
Index: dl/trunk/perllib/plugins/W3ImgPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/W3ImgPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,1068 +1,0 @@
-###########################################################################
-#
-# W3ImgPlug.pm -- Context-based image indexing plugin for HTML documents
-#
-# 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.
-#
-###########################################################################
-
-# DESCRIPTION:
-#
-#  Extracts images and associated text and metadata from
-#  web pages as individual documents for indexing. Thumbnails
-#  are created from each image for browsing purposes.
-#
-#  Options are available for configuring the aggressiveness of the
-#  associated text extraction mechanisms. A higher level of
-#  aggressiveness will extract more text and consequently
-#  may mean lower accuracy (precision); however, it may also 
-#  retrieve more of the relevant images from the collection (recall). 
-#  Lower levels of aggressiveness maybe result in slightly faster
-#  collection builds at the import stage.
-#
-#  W3ImgPlug is a subclass of HTMLPlug (i.e. it will index pages also 
-#  if required). It can be used in place of HTMLPlug to index both
-#  pages and their images.
-#
-# REQUIREMENTS:
-#   
-#  The ImageMagick image manipulation is used to create
-#  thumbnails and extract some image metadata. (Available 
-#  from http://www.imagemagick.org/)
-#
-#  Unix:
-#    Many Linux distributions contain ImageMagick.
-#
-#  Windows:
-#    ImageMagick can be downloaded from the website above.
-#    Make sure the system path includes the ImageMagick binaries
-#    before using W3ImgPlug.
-#
-#    NOTE: NT/2000/XP contain a filesystem utility 'convert.exe' 
-#    with the same name as the image conversion utility. The
-#    ImageMagick FAQ recommends renaming the filesystem
-#    utility (e.g. to 'fsconvert.exe') to avoid this clash.
-#
-# USAGE:  
-#
-#  An image document consists of metadata elements:
-#
-#   OriginalFilename, FilePath, Filename, FileExt, FileSize,
-#   Width, Height, URL, PageURL, ThumbURL, CacheURL, CachePageURL
-#   ImageText, PageTitle
-#
-#  Most of these are only useful in format strings (e.g. ThumbURL, 
-#  Filename, URL, PageURL, CachePageURL). 
-#
-#  ImageText, as the name suggests contains the indexable text.
-#  (unless using the -document_text plugin option)
-#
-#  Since image documents are made up of metadata elements 
-#  alone, format strings are needed to display them properly. 
-#  NOTE: The receptionist will only display results (e.g. thumbnails)
-#  in 4 columns if the format string begins with "<td><table>".
-#
-#  The example below takes the user to the image within the
-#  source HTML document rather than using a format string
-#  on DocumentText to display the image document itself.
-#
-#  Example collect.cfg:
-#
-#   ...
-#
-#   indexes document:ImageText document:text
-#   defaultindex document:ImageText
-#  
-#   collectionmeta .document:ImageText "images"
-#   collectionmeta .document:text "documents"
-#
-#   ...
-#
-#   plugin W3ImgPlug -index_pages -aggressiveness 6
-#
-#   ...
-#  
-#   format SearchVList '<td>{If}{[Title],[link][icon]&nbsp;[Title][[/link],
-#    <table><tr><td align="center"><a href="[CachePageURL]">
-#    <img src="[ThumbURL]"></a></td></tr><tr><td align="center">
-#    <a href="[CachePageURL]"><font size="-1">[OriginalFilename]</font></a>
-#    <br>[Width]x[Height]</td></tr></table>}</td>'
-#
-#   ...
-#
- 
-package W3ImgPlug;
-
-use HTMLPlug;
-use ghtml;
-use unicode;
-use util;
-use strict; # 'subs';
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @W3ImgPlug::ISA = qw( HTMLPlug );
-}
-
-my $aggressiveness_list = 
-    [ { 'name' => "1",
-	'desc' => "{W3ImgPlug.aggressiveness.1}" },
-      { 'name' => "2",
-	'desc' => "{W3ImgPlug.aggressiveness.2}" },
-      { 'name' => "3",
-	'desc' => "{W3ImgPlug.aggressiveness.3}" },
-      { 'name' => "4",
-	'desc' => "{W3ImgPlug.aggressiveness.4}" },
-      { 'name' => "5",
-	'desc' => "{W3ImgPlug.aggressiveness.5}" },
-      { 'name' => "6",
-	'desc' => "{W3ImgPlug.aggressiveness.6}" },
-      { 'name' => "7",
-	'desc' => "{W3ImgPlug.aggressiveness.7}" },
-      { 'name' => "8",
-	'desc' => "{W3ImgPlug.aggressiveness.8}" },
-      { 'name' => "9",
-	'desc' => "{W3ImgPlug.aggressiveness.9}" } ];
-
-my $arguments =
-    [ { 'name' => "aggressiveness",
-	'desc' => "{W3ImgPlug.aggressiveness}",
-	'type' => "int",
-	'list' => $aggressiveness_list,
-	'deft' => "3",
-	'reqd' => "no" },
-      { 'name' => "index_pages",
-	'desc' => "{W3ImgPlug.index_pages}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "no_cache_images",
-	'desc' => "{W3ImgPlug.no_cache_images}",
-	'type' => "flag",
-	'reqd' => "no" },
-      { 'name' => "min_size",
-	'desc' => "{W3ImgPlug.min_size}",
-	'type' => "int",
-	'deft' => "2000",
-	'reqd' => "no" },
-      { 'name' => "min_width",
-	'desc' => "{W3ImgPlug.min_width}",
-	'type' => "int",
-	'deft' => "50",
-	'reqd' => "no" },
-      { 'name' => "min_height",
-	'desc' => "{W3ImgPlug.min_height}",
-	'type' => "int",
-	'deft' => "50",
-	'reqd' => "no" },
-      { 'name' => "thumb_size",
-	'desc' => "{W3ImgPlug.thumb_size}",
-	'type' => "int",
-	'deft' => "100",
-	'reqd' => "no" },
-      { 'name' => "convert_params",
-	'desc' => "{W3ImgPlug.convert_params}",
-	'type' => "string",
-	'deft' => "",
-	'reqd' => "no" },
-      { 'name' => "min_near_text",
-	'desc' => "{W3ImgPlug.min_near_text}",
-	'type' => "int",
-	'deft' => "10",
-	'reqd' => "no" },
-      { 'name' => "max_near_text",
-	'desc' => "{W3ImgPlug.max_near_text}",
-	'type' => "int",
-	'deft' => "400",
-	'reqd' => "no" },
-      { 'name' => "smallpage_threshold",
-	'desc' => "{W3ImgPlug.smallpage_threshold}",
-	'type' => "int",
-	'deft' => "2048",
-	'reqd' => "no" },
-      { 'name' => "textrefs_threshold",
-	'desc' => "{W3ImgPlug.textrefs_threshold}",
-	'type' => "int",
-	'deft' => "2",
-	'reqd' => "no" },
-      { 'name' => "caption_length",
-	'desc' => "{W3ImgPlug.caption_length}",
-	'type' => "int",
-	'deft' => "80",
-	'reqd' => "no" },
-      { 'name' => "neartext_length",
-	'desc' => "{W3ImgPlug.neartext_length}",
-	'type' => "int",
-	'deft' => "300",
-	'reqd' => "no" },
-      { 'name' => "document_text",
-	'desc' => "{W3ImgPlug.document_text}",
-	'type' => "flag",
-	'reqd' => "no" } ];
-
-my $options = { 'name'     => "W3ImgPlug",
-		'desc'     => "{W3ImgPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new HTMLPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    # init class variables
-    $self->{'textref'} = undef; # init by read_file fn
-    $self->{'htdoc_obj'} = undef; # init by process fn
-    $self->{'htpath'} = undef; # init by process fn
-    $self->{'hturl'} = undef; # init by process fn
-    $self->{'plaintext'} = undef; # HTML stripped version - only init if needed by raw_neartext sub
-    $self->{'smallpage'} = 0; # set by process fn
-    $self->{'images_indexed'} = undef; # num of images indexed - if 1 or 2 then we know page is small
-    $self->{'initialised'} = undef; # flag (see set_extraction_options())
-
-    return bless $self, $class;
-}
-
-# if indexing pages, let HTMLPlug do it's stuff
-# image extraction done through read()
-sub process {
-    my ($self, $textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-    $self->{'imglist'} = ();
-    if ( $self->{'index_pages'} ) {
-	my $ok = $self->SUPER::process($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli);
-	if ( ! $ok ) { return $ok }
-	$self->{'htdoc_obj'} = $doc_obj;
-    }
-    # else use URL for referencing
-    #if ( $file =~ /(.*)[\/\\]/ ) { $self->{'htpath'} = $1; } else { $self->{'htpath'} = $file; }
-
-    $self->{'htpath'} = $base_dir if (-d $base_dir);
-    if ( $file =~ /(.*)[\/\\]/ ) { $self->{'htpath'} .= "/$1"; }
-    $self->{'htpath'} =~ s/\\/\//g;  # replace \ with /
-
-    $self->{'hturl'} = "http://$file";
-    $self->{'hturl'} =~ s/\\/\//g; # for windows
-    ($self->{'filename'}) = $file =~ /.*[\/\\](.*)/;
-    ($self->{'base_path'}) = $file =~ /(.*)[\/\\]/i;
-    if ( ( -s "$base_dir/$file") <= $self->{'smallpage_threshold'} ) {
-	$self->{'smallpage'} = 1;
-    } else { $self->{'smallpage'} = 0; }
-
-    if ( defined($self->{'initialised'}) ) { return 1; }
-    else {
-	$self->{'initialised'} = $self->set_extraction_options($base_dir =~ /^(.*?)\/import/i);
-	return $self->{'initialised'};
-    }
-}
-
-# get complex configuration options from configuration files
-# -- $GSDLCOLLECTION/etc/W3ImgPlug.cfg (tag sets for aggr 2+)
-# -- $GSDLHOME/etc/packages/phind/stopword/en/brown.sw (stopwords for aggr 5+)
-
-# If there's no W3ImgPlug.cfg file we'll use the following default values
-my $defaultcfg = '
-<delimitertagset>
-  <setname>Caption</setname>
-  <taggroup>font</taggroup>
-  <taggroup>tt</taggroup>
-  <taggroup>small</taggroup>
-  <taggroup>b</taggroup>
-  <taggroup>i</taggroup>
-  <taggroup>u</taggroup>
-  <taggroup>em</taggroup>
-  <taggroup>td</taggroup>
-  <taggroup>li</taggroup>
-  <taggroup>a</taggroup>
-  <taggroup>p</taggroup>
-  <taggroup>tr</taggroup>
-  <taggroup>center</taggroup>
-  <taggroup>div</taggroup>
-  <taggroup>caption</taggroup>
-  <taggroup>br</taggroup>
-  <taggroup>ul</taggroup>
-  <taggroup>ol</taggroup>
-  <taggroup>table</taggroup>
-  <taggroup>hr</taggroup>
-</delimitertagset>
-
-<delimitertagset>
-  <setname>Neartext</setname>
-  <taggroup>tr|hr|table|h\d|img|body</taggroup>
-  <taggroup>td|tr|hr|table|h\d|img|body</taggroup>
-  <taggroup>p|br|td|tr|hr|table|h\d|img|body</taggroup>
-  <taggroup>font|p|i|b|em|img</taggroup>
-</delimitertagset>
-';
-
-sub set_extraction_options() {
-    my ($self, $collpath) = @_;
-    my ($filepath);
-
-    print {$self->{'outhandle'}} "W3ImgPlug: Initialising\n"
-	if $self->{'verbosity'} > 1;
-    # etc/W3ImgPlug.cfg (XML)
-    # tag sets for captions and neartext
-    if ( $self->{'aggressiveness'} > 1 && $self->{'aggressiveness'} != 9 ) {
-	$self->{'delims'} = [];
-	$self->{'cdelims'} = [];
-	my ($cfg, @tagsets, $tagset, $type, @delims);
-
-	$filepath = "$collpath/etc/W3ImgPlug.cfg";
-	if ( open CFG, "<$filepath" ) {
-	    while (<CFG>) { $cfg .= $_ }
-	    close CFG;
-	} else {
-	    $cfg = $defaultcfg;
-	}
-
-	(@tagsets) = 
-	    $cfg =~ /<delimitertagset>(.*?)<\/delimitertagset>/igs;
-	foreach $tagset ( @tagsets ) {
-	    ($type) = $tagset =~ /<setname>(.*?)<\/setname>/i;
-	    if ( lc($type) eq "caption" ) {
-		(@{$self->{'cdelims'}}) = $tagset =~ /<taggroup>(.*?)<\/taggroup>/igs;
-	    }
-	    elsif ( lc($type) eq "neartext" ) {
-		(@{$self->{'delims'}}) = $tagset =~ /<taggroup>(.*?)<\/taggroup>/igs;
-	    }
-	}
-
-	# output a warning if there seem to be no delimiters
-	if ( scalar(@{$self->{'cdelims'}} == 0)) {
-	    print {$self->{'outhandle'}} "W3ImgPlug: Warning: no caption delimiters found in $filepath\n";
-	}
-	if ( scalar(@{$self->{'delims'}} == 0)) {
-	    print {$self->{'outhandle'}} "W3ImgPlug: Warning: no neartext delimiters found in $filepath\n";
-	}
-    }
-    
-    # get stop words for textual reference extraction
-    # TODO: warnings scroll off. Would be best to output them again at end of import
-    if ( $self->{'aggressiveness'} >=5 && $self->{'aggressiveness'} != 9 ) {
-	$self->{'stopwords'} = ();
-	$filepath = &util::filename_cat($ENV{'GSDLHOME'}, "etc", "packages", "phind", "stopword", "en", "brown.sw");
-	if ( open STOPWORDS, "<$filepath" ) {
-	    while ( <STOPWORDS> ) {
-		chomp;
-		$self->{'stopwords'}{$_} = 1;
-	    }
-	    close STOPWORDS;
-	} else {
-	    print {$self->{'outhandle'}} "W3ImgPlug: Warning: couldn't open stopwords file at $filepath ($!)\n";
-	}
-	
-    }
-
-    if ( $self->{'neartext_length'} > $self->{'max_near_text'} ) {
-	$self->{'max_near_text'} = $self->{'neartext_length'} * 1.33;
-	print {$self->{'outhandle'}} "W3ImgPlug: Warning: adjusted max_text to $self->{'max_near_text'}\n";
-    } 
-    if ( $self->{'caption_length'} > $self->{'max_near_text'} ) {
-	$self->{'max_near_text'} = $self->{'caption_length'} * 1.33;
-	print {$self->{'outhandle'}} "W3ImgPlug: Warning: adjusted max_text to $self->{'max_near_text'}\n";
-    }
-
-    return 1;
-}
-
-# return number of files processed, undef if can't recognise, -1 if 
-# cant process
-# Note that $base_dir might be "" and that $file might 
-# include directories
-sub read {
-    my ($self, $pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = (@_);
-    my ($doc_obj, $section, $filepath, $imgtag, $pos, $context, $numdocs, $tndir, $imgs);
-    # forward normal read (runs HTMLPlug if index_pages T)
-    my $ok =  $self->SUPER::read($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli); 
-    if ( ! $ok ) { return $ok } # what is this returning??
-
-    my $outhandle = $self->{'outhandle'};
-    my $textref = $self->{'textref'};
-    my $htdoc_obj = $self->{'htdoc_obj'};
-    $numdocs = 0;
-    $base_dir =~ /(.*)\/.*/;
-    $tndir = "$1/archives/thumbnails"; # TODO: this path shouldn't be hardcoded?
-    &util::mk_all_dir($tndir) unless -e "$tndir"; 
-
-    $imgs = \%{$self->{'imglist'}};
-    my $nimgs = $self->get_img_list($textref);
-    $self->{'images_indexed'} = $nimgs;
-    if ( $nimgs > 0 ) {
-	my @fplist = (sort { $imgs->{$a}{'pos'} <=> $imgs->{$b}{'pos'} } keys %{$imgs});
-	my $i = 0;
-	foreach $filepath ( @fplist ) {
-	    $pos = $imgs->{$filepath}{'pos'}; 
-	    $context = substr ($$textref, $pos - 50, $pos + 50); # grab context (quicker)
-	    ($imgtag) = ($context =~ /(<(?:img|a|body)\s[^>]*$filepath[^>]*>)/is );
-	    if (! defined($imgtag)) { $imgtag = $filepath }
-	    print $outhandle "W3ImgPlug: extracting $filepath\n"
-		if ( $self->{'verbosity'} > 1 );
-	    $doc_obj = new doc ("", "indexed_doc");
-	    $section = $doc_obj->get_top_section();
-	    my $prevpos = ( $i == 0 ? 0 : $imgs->{$fplist[$i - 1]}{'pos'});
-	    my $nextpos = ( $i >= ($nimgs -1) ? -1 : $imgs->{$fplist[$i + 1]}{'pos'} );
-
-	    $self->extract_image_info($imgtag, $filepath, $textref, $doc_obj, $section, $tndir, $prevpos, $nextpos);
-            $processor->process($doc_obj);
-	    $numdocs++;
-	    $i++;
-	}
-	return $numdocs;
-    } else {
-	print $outhandle "W3ImgPlug: No images from $file indexed\n"
-	    if ( $self->{'verbosity'} > 2 );
-	return 1;
-    }
-    
-}
-
-# for every valid image tag
-# 1. extract related text and image metadata
-# 2. add this as document meta-data
-# 3. add assoc image(s) as files
-#
-sub extract_image_info {
-    my $self = shift (@_);
-    my ($tag, $id, $textref, $doc_obj, $section, $tndir, $prevpos, $nextpos) = (@_);
-    my ($filename, $orig_fp, $fn, $ext, $reltext, $relreltext, $crcid, $imgs,
-	$thumbfp, $pagetitle, $alttext,	$filepath, $aggr);
-    $aggr = $self->{'aggressiveness'};
-    $imgs = \%{$self->{'imglist'}};
-    $filepath = $imgs->{$id}{'relpath'}; 
-    ($filename) = $filepath =~ /([^\/\\]+)$/s;
-    ($orig_fp) = "$self->{'base_path'}/$filepath"; 
-    $orig_fp =~ tr/+/ /;
-    $orig_fp =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # translate %2E to space, etc
-    $orig_fp =~ s/\\/\//g;
-    $filepath = "$self->{'htpath'}/$filepath";
-    my ($onlyfn) = $filename =~ /([^\\\/]*)$/;
-    ($fn, $ext) = $onlyfn =~ /(.*)\.(.*)/;
-    $fn = lc $fn; $ext = lc $ext;
-    ($reltext) = "<tr><td>GifComment</td><td>" . `identify $filepath -ping -format "%c"` . "</td></tr>\n"
-        if ($ext eq "gif");
-    $reltext .= "<tr><td>FilePath</td><td>$orig_fp</td></tr>\n";
-
-    if ($ENV{'GSDLOS'} =~ /^windows$/i) {
-	$crcid = "$fn.$ext." . $self->{'next_crcid'}++;
-    } else { ($crcid) = `cksum $filepath` =~ /^(\d+)/; }
-    $thumbfp = "$tndir/tn_$crcid.jpg";
-    `convert -flatten -filter Hanning $self->{'convert_params'} -geometry "$self->{'thumb_size'}x$self->{'thumb_size'}>" $filepath $thumbfp` unless -e $thumbfp;
-    if ( ! (-e $thumbfp) ) {
-	print STDERR "W3ImgPlug: 'convert' failed. Check ImageMagicK binaries are installed and working correctly\n"; return 0; 
-    }
-    
-    # shove in full text (tag stripped or unstripped) if settings require it
-    if ( $aggr == 10) {
-	$reltext = "<tr><td>AllPage</td><td>" . $$textref . "</td><tr>\n";   # level 10 (all text, verbatim)
-    } else {
-	$pagetitle = $self->get_meta_value("title", $textref);
-	($alttext) = $tag =~ /\salt\s*=\s*(?:\"|\')(.+?)(?:\"|\')/is;
-	if ( defined($alttext) && length($alttext) > 1) {
-	    $reltext .= "<tr><td>ALTtext</td><td>$alttext</td></tr>\n"; }
-	$reltext .= "<tr><td>SplitCapitalisation</td><td>" . 
-	    $self->split_filepath($orig_fp) . "</td></tr>\n";
-
-	# get caption/tag based near text (if appropriate)
-	if ( $aggr > 1 ) {
-	    if ( $aggr >= 2 ) {
-		$reltext .= 
-		    $self->extract_caption_text($tag, $textref, $prevpos, $imgs->{$id}{'pos'}, $nextpos);
-		$relreltext = $reltext;
-	    } 
-	    # repeat the filepath, alt-text, caption, etc
-	    if ( $aggr == 8 ) {
-		$reltext .= $relreltext; 
-	    }
-	    if ( $aggr >= 3 ) {
-		$reltext .= 
-		    $self->extract_near_text($tag, $textref, $prevpos, $imgs->{$id}{'pos'}, $nextpos);
-	    }
-	
-	    # get page metadata (if appropriate)
-	    if ( $aggr >= 6 || ( $aggr >= 2 && 
-						     ( $self->{'images_indexed'} < 2 || 
-						       ($self->{'smallpage'} == 1 && $self->{'images_indexed'} < 6 )))) {	
-		$reltext .= $self->get_page_metadata($textref);
-	    }
-	    # textual references
-	    if ( $aggr  == 5 || $aggr >= 7) {
-		if ( length($relreltext) > ($self->{'caption_length'} * 2) )  {
-		    $reltext .= $self->get_textrefs($relreltext, $textref, $prevpos, $imgs->{$id}{'pos'}, $nextpos); }
-		else {
-		    $reltext .= $self->get_textrefs($reltext, $textref, $prevpos, $imgs->{$id}{'pos'}, $nextpos); 
-		}
-	    }
-	} # aggr > 1
-    } # aggr != 10
-    
-    $doc_obj->set_OID($crcid); 
-    $doc_obj->associate_file($thumbfp, "$fn.thumb.jpg", undef, $section);
-    $doc_obj->add_metadata($section, "OriginalFilename", $filename);
-    $doc_obj->add_metadata($section, "FilePath", $orig_fp);
-    $doc_obj->add_metadata($section, "Filename", $fn);
-    $doc_obj->add_metadata($section, "FileExt", $ext);
-    $doc_obj->add_metadata($section, "FileSize", $imgs->{$id}{'filesize'});
-    $doc_obj->add_metadata($section, "Width", $imgs->{$id}{'width'});
-    $doc_obj->add_metadata($section, "Height", $imgs->{$id}{'height'});
-    $doc_obj->add_metadata($section, "URL", "http://$orig_fp");
-    $doc_obj->add_metadata($section, "PageURL", $self->{'hturl'});
-    $doc_obj->add_metadata($section, "PageTitle", $pagetitle);
-    $doc_obj->add_metadata($section, "ThumbURL", 
-			   "_httpprefix_/collect/[collection]/index/assoc/[archivedir]/$fn.thumb.jpg");
-    $doc_obj->add_metadata($section, "FileFormat", "W3Img");
-
-    if ( $self->{'document_text'} ) {
-	$doc_obj->add_utf8_text($section, "<table border=1>\n$reltext</table>");
-    } else {
-	$doc_obj->add_metadata($section, "ImageText", "<table border=1>\n$reltext</table>\n");
-    }
-    
-    if ( $self->{'index_pages'} ) {
-	my ($cache_url) = "_httpdoc_&d=" . $self->{'htdoc_obj'}->get_OID();
-	if ( $imgs->{$id}{'anchored'} ) {
-	    my $a_name = $id;
-	    $a_name =~ s/[\/\\\:\&]/_/g;
-	    $cache_url .=  "#gsdl_$a_name" ;
-	}
-	$doc_obj->add_utf8_metadata($section, "CachePageURL", $cache_url);
-    }
-    if ( ! $self->{'no_cache_images'} ) {
-	$onlyfn = lc $onlyfn;
-	$doc_obj->associate_file($filepath, $onlyfn, undef, $section);
-	$doc_obj->add_utf8_metadata($section, "CacheURL", 
-			       "_httpprefix_/collect/[collection]/index/assoc/[archivedir]/$onlyfn");
-    }
-    return 1;
-}
-
-sub get_page_metadata {
-    my ($self, $textref) = (@_);
-    my (@rval);
-    $rval[0] = $self->get_meta_value("title", $textref);
-    $rval[1] = $self->get_meta_value("keywords", $textref);
-    $rval[2] = $self->get_meta_value("description", $textref);
-    $rval[3] = $self->{'filename'};
-
-    return wantarray ? @rval : "<tr><td>PageMeta</td><td>@rval</td></tr>\n" ;
-}
-
-# turns LargeCatFish into Large,Cat,Fish so MG sees the separate words
-sub split_filepath {
-    my ($self, $filepath) = (@_);
-    my (@words) = $filepath =~ /([A-Z][a-z]+)/g; 
-    return join(',', @words);
-}
-
-# finds and extracts sentences
-# that seem to be on the same topic
-# as other related text (correlations)
-# and textual references (e.g. in figure 3 ...)
-sub get_textrefs {
-    my ($self, $reltext, $textref, $prevpos, $pos, $nextpos) = (@_);
-    my ($maxtext, $mintext, $startpos, $context_size, $context);
-
-    my (@relwords, @refwords, %sentences, @pagemeta);
-
-    # extract larger context
-    $maxtext = $self->{'max_near_text'};
-    $startpos = $pos - ($maxtext * 4);
-    $context_size = $maxtext*10;
-    if ($startpos < $prevpos ) { $startpos = $prevpos }
-    if ($nextpos != -1 && $context_size > ( $nextpos - $startpos )) { $context_size = ($nextpos - $startpos) }
-    $context = substr ( $$textref, $startpos, $context_size );
-    $context =~ s/<.*?>//gs;
-    $context =~ s/^.*>(.*)/$1/gs;
-    $context =~ s/(.*)<.*$/$1/gs;
-
-    # get page meta-data (if not already included)
-    if ( $self->{'aggressiveness'} == 5 && ! $self->{'smallpage'} ) {
-	@pagemeta = $self->get_page_metadata($textref);
-	foreach my $value ( @pagemeta ) {
-	    $context .= "$value."; # make each into psuedo-sentence
-	}
-    }
-
-    # TODO: this list is not exhaustive
-    @refwords = ( '(?:is|are)? ?(?:show(?:s|n)|demonstrate(?:d|s)|explains|features) (?:in|by|below|above|here)', 
-		  '(?:see)? (?:figure|table)? (?:below|above)');    
-
-    # extract general references
-    foreach my $rw ( @refwords ) {
-	while ( $context =~ /[\.\?\!\,](.*?$rw\W.*?[\.\?\!\,])/ig ) {
-	    my $sentence = $1;
-	    $sentence =~ s/\s+/ /g;
-	    $sentences{$sentence}+=2;
-	}
-    }
-    # extract specific (figure, table) references by number
-    my ($fignum) = $context =~ /[\.\?\!].*?(?:figure|table)s?[\-\_\ \.](\d+\w*)\W.*?[\.\?\!]/ig;
-    if ( $fignum ) {
-	foreach my $rw ( @refwords ) {
-	    while ( $context =~ /[\.\?\!](.*?(figure|table)[\-\_\ \.]$fignum\W.*?[\.\?\!])/ig ) {
-		my $sentence = $1;
-		$sentence =~ s/\s+/ /g;
-		$sentences{$sentence}+=4;
-	    }
-	}
-    }
-
-    # sentences with occurances of important words
-    @relwords = $reltext =~ /([a-zA-Z]{4,})/g; # take out small words
-    foreach my $word ( @relwords ) {
-	if ( $self->{'stopwords'}{$word} ) { next } # skip stop words
-	while ( $context =~ /([^\.\?\!]*?$word\W.*?[\.\?\!])/ig ) {
-	    my $sentence = $1;
-	    $sentence =~ s/\s+/ /g;
-	    $sentences{$sentence}++;
-	}
-    }
-    foreach my $sentence ( keys %sentences ) {
-	if ($sentences{$sentence} < $self->{'textrefs_threshold'}) {
-	    delete $sentences{$sentence};
-	}
-    }
-    my ($rval) = join "<br>\n", (keys %sentences);
-    if ( $rval && length($rval) > 5 ) {
-	return ( "<tr><td>TextualReferences</td><td>" . $rval . "</td></tr>\n") }
-    else { return "" }
-}
-
-# handles caption extraction
-# calling the extractor with different
-# tags and choosing the best candidate caption
-sub extract_caption_text {
-    my ($self, $tag, $textref, $prevpos, $pos, $nextpos) = (@_);
-    my (@neartext, $len, $hdelim, $mintext, $goodlen,
-	$startpos, $context, $context_size);
-    
-    $mintext = $self->{'min_near_text'};
-    $goodlen = $self->{'caption_length'};
-
-    # extract a context to extract near text from (faster)
-    $context_size = $self->{'max_near_text'}*3;
-    $startpos = $pos - ($context_size / 2);
-    if ($startpos < $prevpos ) { $startpos = $prevpos }
-    if ($nextpos != -1 && $context_size > ( $nextpos - $startpos )) 
-    { $context_size = ($nextpos - $startpos) }
-
-    $context = substr ( $$textref, $startpos, $context_size );
-    $context =~ s/<!--.*?-->//gs;
-    $context =~ s/^.*-->(.*)/$1/gs;
-    $context =~ s/(.*)<!--.*$/$1/gs;
-
-    # try stepping through markup delimiter sets
-    # and selecting the best one
-    foreach $hdelim ( @{ $self->{'cdelims'} } ) {
-	@neartext = $self->extract_caption($tag, $hdelim, \$context);
-	$len = length(join("", @neartext));
-	last if ($len >= $mintext && $len <= $goodlen);
-    }
-    # reject if well over reasonable length
-    if ( $len > $goodlen ) {
-	@neartext = [];
-    }
-    $neartext[0] = " " if (! defined $neartext[0]);
-    $neartext[1] = " " if (! defined $neartext[1]);
-    return "<tr><td>Caption</td><td>" . (join ",",  @neartext) . "</td></tr>\n"; # TODO: the | is for testing purposes
-} # end extract_caption_text
-
-# the previous section header often gives a bit
-# of context to the section that the image is
-# in (invariably the header is before/above the image)
-# so extract the text of the closest header above the image
-#
-# this fn just gets all the headers above the image, within the context window
-sub get_prev_header {
-    my ($self, $pos, $textref) = (@_);
-    my ($rhtext);
-    while ( $$textref =~ /<h\d>(.*?)<\/h\d>/sig ) {
-	# only headers before image
-	if ((pos $$textref) < $pos) {
-	    $rhtext .= "$1, ";
-	}
-    } 
-    if ( $rhtext ) { return "Header($rhtext)" }
-    else { return "" }
-}
-
-# not the most robust tag stripping 
-# regexps (see perl.com FAQ) but good enough
-#
-# used by caption & tag-based near text algorithms
-sub strip_tags {
-    my ( $self, $value ) = @_;
-    if ( ! defined($value) ) { $value = "" } # handle nulls
-    else {
-	$value =~ s/<.*?>//gs; # strip all html tags
-	$value =~ s/\s+/\ /g; # remove extra whitespace
-	$value =~ s/\&\w+\;//g; # remove &nbsp; etc
-    }
-    return $value;
-}
-
-# uses the given tag(s) to identify
-# the caption near to the image
-# (below, above or both below and above)
-sub extract_caption {
-    my ($self, $tag, $bound_tag, $contextref) = (@_);
-    my (@nt, $n, $etag, $gotcap);
-    return ("", "") if ( ! ($$contextref =~ /\Q$tag/) );
-
-    $nt[0] = $`;
-    $nt[1] = $';
-    $gotcap = 0;
-
-    # look before the image for a boundary tag
-    ($etag, $nt[0]) = $nt[0] =~ /<($bound_tag)[\s]?.*?>(.*?)$/is;
-    # if bound_tag too far from the image, then prob not caption
-    # (note: have to allow for tags, so multiply by 3
-    if ( $etag && length($nt[0]) < ($self->{'caption_length'} * 3) ) { 
-	if ( $nt[0] =~ /<\/$etag>/si ) {
-	    # the whole caption is above the image: <tag>text</tag><img>
-	    ($nt[0]) =~ /<(?:$etag)[\s]?.*?>(.*?)<\/$etag>/is;
-	    $nt[0] = $self->strip_tags($nt[0]);
-	    if ( length($nt[0]) > $self->{'min_near_text'} ) { 
-		$gotcap = 1;
-		$nt[1] = ""; 
-	    }
-
-	} elsif ( $nt[1] =~ /<\/$etag>/si) {
-	    # the caption tag covers image: <tag>text?<img>text?</tag>
-	    ($nt[1]) = $nt[1] =~ /(.*?)<\/$etag>/si;
-	    $nt[0] = $self->strip_tags($nt[0] . $nt[1]);
-	    if ( length($nt[0]) > $self->{'min_near_text'} ) { 
-		$gotcap = 2;
-		$nt[1] = "";
-	    }
-	}
-    }
-    # else try below the image
-    if ( ! $gotcap ) { 
-	# the caption is after the image: <img><tag>text</tag>
-	($etag, $nt[1]) = $nt[1] =~ /^.*?<($bound_tag)[\s]?.*?>(.*)/is;
-	if ( $etag && $nt[1] =~ /<\/$etag>/s) {
-	    ($nt[1]) = $nt[1] =~ /(.*?)<\/$etag>/si;
-	    $gotcap = 3;
-	    $nt[0] = "";
-	    $nt[1] = $self->strip_tags($nt[1]);
-	} 
-    }
-    if ( ! $gotcap ) { $nt[0] = $nt[1] = "" }
-    else {
-	# strip part-tags
-	$nt[0] =~ s/^.*>//s;
-	$nt[1] =~ s/<.*$//s;
-    }
-    my ($type);
-    if ( $gotcap == 0 ) { return ("nocaption", "") }
-    elsif ( $gotcap == 1 ) { $type = "captionabove:" }
-    elsif ( $gotcap == 2 ) { $type = "captioncovering:" }
-    elsif ( $gotcap == 3 ) { $type = "captionbelow:" }
-    return ($type, $nt[0], $nt[1]);
-}
-
-# tag-based near text
-# 
-# tries different tag sets
-# and chooses the best one
-sub extract_near_text {
-    my ($self, $tag, $textref, $prevpos, $pos, $nextpos) = (@_);
-    my (@neartext, $len, $hdelim, $maxtext, $mintext, $goodlen,
-	@bestlen, @best, $startpos, $context, $context_size,
-	$dist, $bdist, $best1, $i, $nt);
-    $bestlen[0] = $bestlen[1] = 0; $bestlen[2] = $bdist = 999999;
-    $best[0] = $best[1] = $best[2] = "";
-    $maxtext = $self->{'max_near_text'};
-    $mintext = $self->{'min_near_text'};
-    $goodlen = $self->{'neartext_length'}; 
-
-    # extract a context to extract near text from (faster)
-    $context_size = $maxtext*4;
-    $startpos = $pos - ($context_size / 2);
-    if ($startpos < $prevpos ) { $startpos = $prevpos }
-    if ($nextpos != -1 && $context_size > ( $nextpos - $startpos )) 
-    { $context_size = ($nextpos - $startpos) }
-    $context = substr ( $$textref, $startpos, $context_size );
-    $context =~ s/<!--.*?-->//gs;
-    $context =~ s/^.*-->(.*)/$1/gs;
-    $context =~ s/(.*)<!--.*$/$1/gs;
-
-    # try stepping through markup delimiter sets
-    # and selecting the best one
-    foreach $hdelim ( @{ $self->{'delims'} } ) {
-	@neartext = $self->extract_tagged_neartext($tag, $hdelim, \$context);
-	$nt = join("", @neartext);
-	$len = length($nt);
-	# Priorities:
-	# 1. Greater than mintext 
-	# 2. Less than maxtext 
-	# 3. Closest to goodlen
-	if ( $len <= $goodlen && $len > $bestlen[0] ) {
-	    $bestlen[0] = $len;
-	    $best[0] = $hdelim;
-	} elsif ( $len >= $maxtext && $len < $bestlen[2] ) {
-	    $bestlen[2] = $len;
-	    $best[2] = $hdelim;
-	} elsif ( $len >= $bestlen[0] && $len <= $bestlen[2] ) {
-	    $dist = abs($goodlen - $len);
-	    if ( $dist < $bdist ) {
-		$bestlen[1] = $len;
-		$best[1] = $hdelim;
-		$bdist = $dist;
-	    }
-	}
-    }
-    $best1 = 2;
-    foreach $i ( 0..2 ) {
-	if ( $bestlen[$i] == 999999 ) { $bestlen[$i] = 0 }
-	$dist = abs($goodlen - $bestlen[$i]);
-	if ( $bestlen[$i] > $mintext && $dist <= $bdist ) {
-	    $best1 = $i;
-	    $bdist = $dist;
-	}
-    }
-    @neartext = $self->extract_tagged_neartext($tag, $best[$best1], \$context);
-    if ( $bestlen[$best1] > $maxtext ) {
-	# truncate on word boundary if too much text
-	my $hmax = $maxtext / 2;
-	($neartext[0]) = $neartext[0] =~ /([^\s]*.{1,$hmax})$/s;
-	($neartext[1]) = $neartext[1] =~ /^(.{1,$hmax}[^\s]*)/s;
-    } elsif ( $bestlen[$best1] < $mintext ) {
-	# use plain text extraction if tags failed (e.g. usable tag outside context)
-	print {$self->{'outhandle'}} "W3ImgPlug: Fallback to plain-text extraction for $tag\n" 
-	    if $self->{'verbosity'} > 2;
-	$neartext[0] = "<tr><td>RawNeartext</td><td>" . $self->extract_raw_neartext($tag, $textref) . "</td></tr>";
-	$neartext[1] = "";
-    }
-    # get previous header if available
-    $neartext[0] .= "<br>\n" . 
-	$self->get_prev_header($pos, \$context) if ( $self->{'aggressiveness'} >= 4 );
-    $neartext[0] = " " if (! defined $neartext[0]);
-    $neartext[1] = " " if (! defined $neartext[1]);
-
-    return "<tr><td>NearText</td><td>" . (join "|",  @neartext) . "</td></tr>\n"; # TODO: the | is for testing purposes
-} # end extract_near_text
-
-# actually captures tag-based
-# near-text given a tag set
-sub extract_tagged_neartext {
-    my ($self, $tag, $bound_tag, $textref) = (@_);
-    return "" if ( ! ($$textref =~ /\Q$tag/) );
-    my (@nt, $delim, $pre_tag, $n);
-    $nt[0] = $`;
-    $nt[1] = $';
-
-    # get text after previous image tag
-    $nt[0] =~ s/.*<($bound_tag)[^>]*>(.*)/$2/is; # get rid of preceding text
-    if (defined($1)) { $delim = $1 }    
-    $pre_tag = $bound_tag;
-
-    if (defined($delim)) {
-	# we want to try and use the end tag of the previous delimiter
-	# (put it on the front of the list)
-	$pre_tag =~ s/(^|\|)($delim)($|\|)//i; # take it out
-	$pre_tag =~ s/\|\|/\|/i; # replace || with |
-	$pre_tag = $delim . "|" . $pre_tag; # put it on the front
-    }
-    
-    # get text before next image tag
-    $nt[1] =~ s/<\/?(?:$pre_tag)[^>]*>.*//is; # get rid of stuff after first delimiter
-
-    # process related text
-    for $n (0..1) {
-	if ( defined($nt[$n]) ) {
-	    $nt[$n] =~ s/<.*?>//gs; # strip all html tags
-	    $nt[$n] =~ s/\s+/\ /gs; # remove extra whitespace
-	    $nt[$n] =~ s/\&\w+\;//sg; # remove &nbsp; etc
-	    # strip part-tags
-	    if ( $n == 0 ) { $nt[0] =~ s/^.*>//s }
-	    if ( $n == 1 ) { $nt[1] =~ s/<.*$//s }
-	} else { $nt[$n] = ""; } # handle nulls
-    }
-    return @nt;
-}
-
-# this function is fall-back
-# if tags aren't suitable.
-#
-# extracts a fixed length of characters
-# either side of image tag (on word boundary)
-sub extract_raw_neartext {
-    my ($self, $tag, $textref) = (@_);
-    my ($rawtext, $startpos, $fp);
-    my $imgs = \%{$self->{'imglist'}};
-    ($fp) = $tag =~ /([\w\\\/]+\.(?:gif|jpe?g|png))/is;
-    if (! $fp) { return " " };
-    # if the cached, plain-text version isn't there, then create it
-    $self->init_plaintext($textref) unless defined($self->{'plaintext'});
-
-    # take the closest maxtext/2 characters 
-    # either side of the tag (by word boundary)
-    return "" if ( ! exists $imgs->{$fp}{'rawpos'} );
-    $startpos = $imgs->{$fp}{'rawpos'} - (($self->{'max_near_text'} / 2) + 20);
-    if ( $startpos < 0 ) { $startpos = 0 }
-    $rawtext = substr $self->{'plaintext'}, $startpos, $self->{'max_near_text'} + 20;
-    $rawtext =~ s/\s\s/ /g;
-
-    return $rawtext;
-}
-
-# init plaintext variable for HTML-stripped version 
-# (for full text index/raw assoc text extraction)
-sub init_plaintext {
-    my ($self, $textref) = (@_);
-    my ($page, $fp);
-    my $imgs = \%{$self->{'imglist'}};
-    $page = $$textref; # make a copy of original
-
-    # strip tags around image filenames so they don't get zapped
-    $page =~ s/<\w+\s+.*?([\w\/\\]+\.(?:gif|jpe?g|png))[^>]*>/\"$1\"/gsi;
-    $page =~ s/<.*?>//gs;
-    $page =~ s/&nbsp;/ /gs;
-    $page =~ s/&amp;/&/gs; #TODO: more &zzz; replacements (except &lt;, $gt;)
-
-    # get positions and strip images
-    while ( $page =~ /([^\s\'\"]+\.(jpe?g|gif|png))/ig ) {
-	$fp = $1;
-	if ( $imgs->{$fp}{'exists'} ) {
-	    $imgs->{$fp}{'rawpos'} = pos $page;
-	}
-	$page =~ s/\"$fp\"//gs;
-    }
-    $self->{'plaintext'} = $page;
-}
-
-# finds and filters images based on size 
-# (dimensions, height, filesize) and existence
-#
-# looks for image filenames (.jpg, .gif, etc)
-# and checks for existence on disk 
-# (hence supports most JavaScript images)
-sub get_img_list {
-    my $self = shift (@_);
-    my ($textref) = (@_);
-    my ($filepath, $relpath, $abspath, $pos, $num, $width, $height, $filesize);
-    my $imgs = \%{$self->{'imglist'}};
-    while ( $$textref =~ /([^\s\'\"]+\.(jpe?g|gif|png))/ig ) {
-	$filepath = $1;
-	$pos = pos $$textref;
-	next if ( $imgs->{$filepath}{'relpath'} );
-        $relpath = $filepath;
-	$relpath =~ s/^http\:\/\///; # remove http:// in case we have mirrored it
-	$relpath =~ s/\\/\//g;  # replace \ with /
-	$relpath =~ s/^\.\///s; # make "./filepath" into "filepath"
-	$imgs->{$filepath}{'relpath'} = $relpath;
-	$abspath = "$self->{'htpath'}/$relpath";
-
-	if (! -e $abspath) { next }
-
-	# can't modify real filepath var because it
-	# then can't be located in the page for tag recognition later
-	($width, $height) = 
-	    `identify $abspath -ping -format "%wx%h"` =~ /^(\d*)x(\d*)$/m;
-	if (! ($width && $height)) { 
-	    print STDERR "W3ImgPlug: ($abspath) 'identify' failed. Check ImageMagicK binaries are installed and working correctly\n"; next;
-	}
-	$filesize = (-s $abspath);
-	if ( $filesize >= $self->{'min_size'} 
-	    && ( $width >= $self->{'min_width'} ) 
-	    && ( $height >= $self->{'min_height'} ) ) {
-	    
-	   $imgs->{$filepath}{'exists'} = 1;
-	   $imgs->{$filepath}{'pos'} = $pos;
-	   $imgs->{$filepath}{'width'} = $width;
-	   $imgs->{$filepath}{'height'} = $height;
-	   $imgs->{$filepath}{'filesize'} = $filesize;
-       } else {
-	   print {$self->{'outhandle'}} "W3ImgPlug: skipping $self->{'base_path'}/$relpath: $filesize, $width x $height\n" 
-	       if $self->{'verbosity'} > 2;
-       }
-    }
-    $num = 0;
-    foreach my $i ( keys %{$imgs} ) {
-	if ( $imgs->{$i}{'pos'} ) {
-	    $num++;
-	} else { delete $imgs->{$i} }
-    }
-    return $num;
-}
-
-# make the text available to the read function
-# by making it an object variable
-sub read_file {
-    my ($self, $filename, $encoding, $language, $textref) = @_;
-    $self->SUPER::read_file($filename, $encoding, $language, $textref);
-
-    # if HTMLplug has run through, then it will
-    # have replaced references so we have to 
-    # make a copy of the text before processing
-    if ( $self->{'index_pages'} ) {
-	$self->{'text'} = $$textref;
-	$self->{'textref'} = \($self->{'text'});
-    } else {
-	$self->{'textref'} = $textref;
-    }
-    $self->{'plaintext'} = undef;
-}
-
-# HTMLPlug only extracts meta-data if it is specified in plugin options
-# hence a special function to do it here
-sub get_meta_value {
-    my ($self, $name, $textref) = @_;
-    my ($value);
-    $name = lc $name;
-    if ($name eq "title") {
-	($value) = $$textref =~ /<title>(.*?)<\/title>/is
-    } else {
-	my $qm = "(?:\"|\')";
-	($value) = $$textref =~ /<meta name\s*=\s*$qm?$name$qm?\s+content\s*=\s*$qm?(.*?)$qm?\s*>/is
-    }
-    $value = "" unless $value;
-    return $value;
-}
-
-# make filename an anchor reference
-# so we can go straight to the image
-# within the cached version of the source page
-# (augment's HTMLPlug sub)
-sub replace_images {
-    my $self = shift (@_);
-    my ($front, $link, $back, $base_dir, 
-	$file, $doc_obj, $section) = @_;
-    $link =~ s/\"//g;
-    my ($a_name) = $link;
-    $a_name =~ s/[\/\\\:\&]/_/g;
-    # keep a list so we don't repeat the same anchor
-    if ( ! $self->{'imglist'}{$link}{'anchored'} ) {
-	$front = "<a name=\"gsdl_$a_name\">$front";
-	$back = "$back</a>";
-	$self->{'imglist'}{$link}{'anchored'} = 1;
-    }
-    return $self->SUPER::replace_images($front, $link, $back, $base_dir, 
-				     $file, $doc_obj, $section);
-}
-
-1;
Index: dl/trunk/perllib/plugins/WordPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/WordPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,241 +1,0 @@
-###########################################################################
-#
-# WordPlug.pm -- plugin for importing Microsoft Word documents
-# A component of the Greenstone digital library software
-# from the New Zealand Digital Library Project at the 
-# University of Waikato, New Zealand.
-#
-# Copyright (C) 1999 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.
-#
-###########################################################################
-# 12/05/02 Added usage datastructure - John Thompson
-
-package WordPlug;
-
-use ConvertToPlug;
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @WordPlug::ISA = ('ConvertToPlug');
-}
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" },
-      { 'name' => "description_tags",
-	'desc' => "{HTMLPlug.description_tags}",
-	'type' => "flag" }
-      ];
-
-my $options = { 'name'     => "WordPlug",
-		'desc'     => "{WordPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'srcreplaceable' => "yes", # Source docs in Word can be replaced with GS-generated html
-		'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
-	my $ws_arg = [ { 'name' => "windows_scripting",
-			 'desc' => "{WordPlug.windows_scripting}",
-			 'type' => "flag",
-		         'reqd' => "no" },
-		       { 'name' => "metadata_fields",
-			 'type' => "string",
-			 'deft' => "Title" },
-		       { 'name' => "level1_header",
-			 'desc' => "{StructuredHTMLPlug.level1_header}",
-			 'type' => "regexp",
-			 'reqd' => "no",
-			 'deft' => "" },
-		       { 'name' => "level2_header",
-			 'desc' => "{StructuredHTMLPlug.level2_header}",
-			 'type' => "regexp",
-			 'reqd' => "no",
-			 'deft' => "" },
-		       { 'name' => "level3_header",
-			 'desc' => "{StructuredHTMLPlug.level3_header}",
-			 'type' => "regexp",
-			 'reqd' => "no",
-			 'deft' => "" },
-		       { 'name' => "title_header",
-			 'desc' => "{StructuredHTMLPlug.title_header}",
-			 'type' => "regexp",
-			 'reqd' => "no",
-			 'deft' => "" },
-		       { 'name' => "delete_toc",
-			 'desc' => "{StructuredHTMLPlug.delete_toc}",
-			 'type' => "flag",
-			 'reqd' => "no",
-			 # set the mode so this doesn't show up unless 
-			 # all the following ones do
-			 'modegli' => "3"},
-		       { 'name' => "toc_header",
-			 'desc' => "{StructuredHTMLPlug.toc_header}",
-			 'type' => "regexp",
-			 'reqd' => "no",
-			 'deft' => "" }
-		       ];
-	
-	push(@$arguments,@$ws_arg);
-    }
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new ConvertToPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    if ($self->{'info_only'}) {
-	# don't worry about any options etc
-	return bless $self, $class;
-    }
-
-    #this is passed through to gsConvert.pl by ConvertToPlug.pm
-    $self->{'convert_options'} = "-windows_scripting" if $self->{'windows_scripting'};
-
-    # we always save as utf-8
-    if ($self->{'input_encoding'} eq "auto") {
-	$self->{'input_encoding'} = "utf8";
-    }
-
-    my $secondary_plugin_options = $self->{'secondary_plugin_options'};
-    if (defined $self->{'windows_scripting'}) { 
-	if (!defined $secondary_plugin_options->{'StructuredHTMLPlug'}){
-	    $secondary_plugin_options->{'StructuredHTMLPlug'} = [];
-	    my $structhtml_options = $secondary_plugin_options->{'StructuredHTMLPlug'};
-	    
-	    # Instruct HTMLPlug (when eventually accessed through read_into_doc_obj)
-	    # to extract these metadata fields from the HEAD META fields
-	    push (@$structhtml_options,"-metadata_fields","Title,GENERATOR,date,author<Creator>");
-	    push (@$structhtml_options , "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
-	    push (@$structhtml_options, "-description_tags") if $self->{'windows_scripting'};
-	    push(@$structhtml_options,"-extract_language") if $self->{'extract_language'};
-	    push (@$structhtml_options, "-delete_toc") if $self->{'delete_toc'};
-	    push (@$structhtml_options, "-toc_header", $self->{'toc_header'}) if $self->{'toc_header'};
-	    push (@$structhtml_options, "-title_header", $self->{'title_header'}) if $self->{'title_header'};
-	    push (@$structhtml_options, "-level1_header", $self->{'level1_header'}) if $self->{'level1_header'};
-	    push (@$structhtml_options, "-level2_header", $self->{'level2_header'})if $self->{'level2_header'};
-	    push (@$structhtml_options, "-level3_header", $self->{'level3_header'}) if $self->{'level3_header'};
-	    push (@$structhtml_options, "-metadata_fields", $self->{'metadata_fields'}) if $self->{'metadata_fields'};
-	}
-    }
-    if (!defined $secondary_plugin_options->{'HTMLPlug'}) {
-	$secondary_plugin_options->{'HTMLPlug'} = [];
-    }
-    if (!defined $secondary_plugin_options->{'TEXTPlug'}) {
-	$secondary_plugin_options->{'TEXTPlug'} = [];
-    }
-
-    my $html_options = $secondary_plugin_options->{'HTMLPlug'};
-    my $text_options = $secondary_plugin_options->{'TextPlug'};
-    my $structhtml_options = $secondary_plugin_options->{'StructuredHTMLPlug'};    
-    # wvWare will always produce html files encoded as utf-8, so make sure the secondary HTMLPlug knows this
-    push(@$html_options,"-input_encoding", "utf8");
-    push(@$html_options,"-extract_language") if $self->{'extract_language'};
-    push(@$html_options, "-description_tags") if $self->{'description_tags'};
-
-    # Instruct HTMLPlug (when eventually accessed through read_into_doc_obj)
-    # to extract these metadata fields from the HEAD META fields
-    push(@$html_options,"-metadata_fields","Title,GENERATOR,date,author<Creator>");
-    push(@$html_options , "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
-
-    my $associate_tail_re = $self->{'associate_tail_re'};
-    if ((defined $associate_tail_re) && ($associate_tail_re ne "")) {
-	push(@$html_options, "-associate_tail_re", $associate_tail_re);
-	push(@$text_options, "-associate_tail_re", $associate_tail_re);
-	push(@$structhtml_options, "-associate_tail_re", $associate_tail_re);
-    }
-       
-    $self = bless $self, $class;
-    $self->load_secondary_plugins($class,$secondary_plugin_options,$hashArgOptLists);
-
-    return bless $self;
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)\.(doc|dot)$^;
-}
-
-sub convert_post_process
-{
-    my $self = shift (@_);
-    my ($conv_filename) = @_;
-
-    my $outhandle=$self->{'outhandle'};
-     
-    my ($language, $encoding) = $self->textcat_get_language_encoding ($conv_filename);
-
-    # read in file ($text will be in utf8)
-    my $text = "";
-    $self->read_file ($conv_filename, $encoding, $language, \$text);
-
-    # turn any high bytes that aren't valid utf-8 into utf-8.
-    #unicode::ensure_utf8(\$text);
-    
-    # Write it out again!
-    #$self->utf8_write_file (\$text, $conv_filename);
-}
-
-sub get_file_type {
-    my $self = shift (@_);
-    my $file_type = "Word";
-    return $file_type;
-}
-
-# Modified to cache HTML files for efficieny reasons rather
-# than delete all.  HTML is modified not to use IE's VML.
-# VML uses WML files, so these can be deleted.
-sub cleanup_tmp_area {
-    my ($self) = @_;
-    if (defined $self->{'files_dir'}) {
-	my $html_files_dir = $self->{'files_dir'};
-
-	if (opendir(DIN,$html_files_dir)) {
-	    my @wmz_files = grep( /\.wmz$/, readdir(DIN));
-	    foreach my $f (@wmz_files) {
-		my $full_f = &util::filename_cat($html_files_dir,$f);
-		&util::rm($full_f);
-	    }
-	    closedir(DIN);
-	}
-	else {
-	    # if HTML file has no supporting images, then no _files dir made
-	    # => do nothing
-	}
-    }
-}
-
-# do plugin specific processing of doc_obj for HTML type
-sub process {
-    my $self = shift (@_);
-    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
-
-    return $self->process_type("doc", $base_dir, $file, $doc_obj);
-}
-
-1;
-
Index: /gsdl/trunk/perllib/plugins/WordPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/WordPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/WordPlugin.pm	(revision 15865)
@@ -0,0 +1,241 @@
+###########################################################################
+#
+# WordPlug.pm -- plugin for importing Microsoft Word documents
+# A component of the Greenstone digital library software
+# from the New Zealand Digital Library Project at the 
+# University of Waikato, New Zealand.
+#
+# Copyright (C) 1999 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.
+#
+###########################################################################
+# 12/05/02 Added usage datastructure - John Thompson
+
+package WordPlug;
+
+use ConvertToPlug;
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+sub BEGIN {
+    @WordPlug::ISA = ('ConvertToPlug');
+}
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "regexp",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" },
+      { 'name' => "description_tags",
+	'desc' => "{HTMLPlug.description_tags}",
+	'type' => "flag" }
+      ];
+
+my $options = { 'name'     => "WordPlug",
+		'desc'     => "{WordPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'srcreplaceable' => "yes", # Source docs in Word can be replaced with GS-generated html
+		'args'     => $arguments };
+
+sub new {
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
+	my $ws_arg = [ { 'name' => "windows_scripting",
+			 'desc' => "{WordPlug.windows_scripting}",
+			 'type' => "flag",
+		         'reqd' => "no" },
+		       { 'name' => "metadata_fields",
+			 'type' => "string",
+			 'deft' => "Title" },
+		       { 'name' => "level1_header",
+			 'desc' => "{StructuredHTMLPlug.level1_header}",
+			 'type' => "regexp",
+			 'reqd' => "no",
+			 'deft' => "" },
+		       { 'name' => "level2_header",
+			 'desc' => "{StructuredHTMLPlug.level2_header}",
+			 'type' => "regexp",
+			 'reqd' => "no",
+			 'deft' => "" },
+		       { 'name' => "level3_header",
+			 'desc' => "{StructuredHTMLPlug.level3_header}",
+			 'type' => "regexp",
+			 'reqd' => "no",
+			 'deft' => "" },
+		       { 'name' => "title_header",
+			 'desc' => "{StructuredHTMLPlug.title_header}",
+			 'type' => "regexp",
+			 'reqd' => "no",
+			 'deft' => "" },
+		       { 'name' => "delete_toc",
+			 'desc' => "{StructuredHTMLPlug.delete_toc}",
+			 'type' => "flag",
+			 'reqd' => "no",
+			 # set the mode so this doesn't show up unless 
+			 # all the following ones do
+			 'modegli' => "3"},
+		       { 'name' => "toc_header",
+			 'desc' => "{StructuredHTMLPlug.toc_header}",
+			 'type' => "regexp",
+			 'reqd' => "no",
+			 'deft' => "" }
+		       ];
+	
+	push(@$arguments,@$ws_arg);
+    }
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new ConvertToPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    if ($self->{'info_only'}) {
+	# don't worry about any options etc
+	return bless $self, $class;
+    }
+
+    #this is passed through to gsConvert.pl by ConvertToPlug.pm
+    $self->{'convert_options'} = "-windows_scripting" if $self->{'windows_scripting'};
+
+    # we always save as utf-8
+    if ($self->{'input_encoding'} eq "auto") {
+	$self->{'input_encoding'} = "utf8";
+    }
+
+    my $secondary_plugin_options = $self->{'secondary_plugin_options'};
+    if (defined $self->{'windows_scripting'}) { 
+	if (!defined $secondary_plugin_options->{'StructuredHTMLPlug'}){
+	    $secondary_plugin_options->{'StructuredHTMLPlug'} = [];
+	    my $structhtml_options = $secondary_plugin_options->{'StructuredHTMLPlug'};
+	    
+	    # Instruct HTMLPlug (when eventually accessed through read_into_doc_obj)
+	    # to extract these metadata fields from the HEAD META fields
+	    push (@$structhtml_options,"-metadata_fields","Title,GENERATOR,date,author<Creator>");
+	    push (@$structhtml_options , "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
+	    push (@$structhtml_options, "-description_tags") if $self->{'windows_scripting'};
+	    push(@$structhtml_options,"-extract_language") if $self->{'extract_language'};
+	    push (@$structhtml_options, "-delete_toc") if $self->{'delete_toc'};
+	    push (@$structhtml_options, "-toc_header", $self->{'toc_header'}) if $self->{'toc_header'};
+	    push (@$structhtml_options, "-title_header", $self->{'title_header'}) if $self->{'title_header'};
+	    push (@$structhtml_options, "-level1_header", $self->{'level1_header'}) if $self->{'level1_header'};
+	    push (@$structhtml_options, "-level2_header", $self->{'level2_header'})if $self->{'level2_header'};
+	    push (@$structhtml_options, "-level3_header", $self->{'level3_header'}) if $self->{'level3_header'};
+	    push (@$structhtml_options, "-metadata_fields", $self->{'metadata_fields'}) if $self->{'metadata_fields'};
+	}
+    }
+    if (!defined $secondary_plugin_options->{'HTMLPlug'}) {
+	$secondary_plugin_options->{'HTMLPlug'} = [];
+    }
+    if (!defined $secondary_plugin_options->{'TEXTPlug'}) {
+	$secondary_plugin_options->{'TEXTPlug'} = [];
+    }
+
+    my $html_options = $secondary_plugin_options->{'HTMLPlug'};
+    my $text_options = $secondary_plugin_options->{'TextPlug'};
+    my $structhtml_options = $secondary_plugin_options->{'StructuredHTMLPlug'};    
+    # wvWare will always produce html files encoded as utf-8, so make sure the secondary HTMLPlug knows this
+    push(@$html_options,"-input_encoding", "utf8");
+    push(@$html_options,"-extract_language") if $self->{'extract_language'};
+    push(@$html_options, "-description_tags") if $self->{'description_tags'};
+
+    # Instruct HTMLPlug (when eventually accessed through read_into_doc_obj)
+    # to extract these metadata fields from the HEAD META fields
+    push(@$html_options,"-metadata_fields","Title,GENERATOR,date,author<Creator>");
+    push(@$html_options , "-title_sub", '^(Page\s+\d+)?(\s*1\s+)?');
+
+    my $associate_tail_re = $self->{'associate_tail_re'};
+    if ((defined $associate_tail_re) && ($associate_tail_re ne "")) {
+	push(@$html_options, "-associate_tail_re", $associate_tail_re);
+	push(@$text_options, "-associate_tail_re", $associate_tail_re);
+	push(@$structhtml_options, "-associate_tail_re", $associate_tail_re);
+    }
+       
+    $self = bless $self, $class;
+    $self->load_secondary_plugins($class,$secondary_plugin_options,$hashArgOptLists);
+
+    return bless $self;
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return q^(?i)\.(doc|dot)$^;
+}
+
+sub convert_post_process
+{
+    my $self = shift (@_);
+    my ($conv_filename) = @_;
+
+    my $outhandle=$self->{'outhandle'};
+     
+    my ($language, $encoding) = $self->textcat_get_language_encoding ($conv_filename);
+
+    # read in file ($text will be in utf8)
+    my $text = "";
+    $self->read_file ($conv_filename, $encoding, $language, \$text);
+
+    # turn any high bytes that aren't valid utf-8 into utf-8.
+    #unicode::ensure_utf8(\$text);
+    
+    # Write it out again!
+    #$self->utf8_write_file (\$text, $conv_filename);
+}
+
+sub get_file_type {
+    my $self = shift (@_);
+    my $file_type = "Word";
+    return $file_type;
+}
+
+# Modified to cache HTML files for efficieny reasons rather
+# than delete all.  HTML is modified not to use IE's VML.
+# VML uses WML files, so these can be deleted.
+sub cleanup_tmp_area {
+    my ($self) = @_;
+    if (defined $self->{'files_dir'}) {
+	my $html_files_dir = $self->{'files_dir'};
+
+	if (opendir(DIN,$html_files_dir)) {
+	    my @wmz_files = grep( /\.wmz$/, readdir(DIN));
+	    foreach my $f (@wmz_files) {
+		my $full_f = &util::filename_cat($html_files_dir,$f);
+		&util::rm($full_f);
+	    }
+	    closedir(DIN);
+	}
+	else {
+	    # if HTML file has no supporting images, then no _files dir made
+	    # => do nothing
+	}
+    }
+}
+
+# do plugin specific processing of doc_obj for HTML type
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli) = @_;
+
+    return $self->process_type("doc", $base_dir, $file, $doc_obj);
+}
+
+1;
+
Index: dl/trunk/perllib/plugins/XMLPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/XMLPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,427 +1,0 @@
-###########################################################################
-#
-# XMLPlug.pm -- base class for XML plugins
-# 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.
-#
-###########################################################################
-
-package XMLPlug;
-
-use BasPlug;
-use doc;
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-sub BEGIN {
-    @XMLPlug::ISA = ('BasPlug');
-    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
-}
-
-use XMLParser;
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "regexp",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" },
-      { 'name' => "xslt",
-	'desc' => "{XMLPlug.xslt}",
-	'type' => "string",
-	'deft' => "",
-	'reqd' => "no" } ];
-
-my $options = { 'name'     => "XMLPlug",
-		'desc'     => "{XMLPlug.desc}",
-		'abstract' => "yes",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-sub new {
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-    
-    # $self is global for use within subroutines called by XML::Parser
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    if ($self->{'info_only'}) {
-	# don't worry about any options etc
-	return bless $self, $class;
-    }
-
-    my $parser = new XML::Parser('Style' => 'Stream',
-                                 'Pkg' => 'XMLPlug',
-                                 'PluginObj' => $self,
-				 'Handlers' => {'Char' => \&Char,
-						'XMLDecl' => \&XMLDecl,
-						'Entity' => \&Entity,
-						'Doctype' => \&Doctype,
-						'Default' => \&Default,
-                                 });
-
-    $self->{'parser'} = $parser;
-
-    return bless $self, $class;
-}
-
-# the inheriting class must implement this method to tell whether to parse this doc type
-sub get_doctype {
-    my $self = shift(@_);
-    die "$self The inheriting class must implement get_doctype method";
-}
-
-
-sub apply_xslt
-{
-    my $self = shift @_;
-    my ($xslt,$filename) = @_;
-    
-    my $outhandle = $self->{'outhandle'};
-
-    my $xslt_filename = $xslt;
-
-    if (! -e $xslt_filename) {
-	# Look in main site directory
-	my $gsdlhome = $ENV{'GSDLHOME'};
-	$xslt_filename = &util::filename_cat($gsdlhome,$xslt);
-    }
-
-    if (! -e $xslt_filename) {
-	# Look in collection directory
-	my $coldir = $ENV{'GSDLCOLLECTDIR'};
-	$xslt_filename = &util::filename_cat($coldir,$xslt);
-    }
-
-    if (! -e $xslt_filename) {
-	print $outhandle "Warning: Unable to find XSLT $xslt\n";
-	if (open(XMLIN,"<$filename")) {
-
-	    my $untransformed_xml = "";
-	    while (defined (my $line = <XMLIN>)) {
-
-		$untransformed_xml .= $line;
-	    }
-	    close(XMLIN);
-	    
-	    return $untransformed_xml;
-	}
-	else {
-	    print $outhandle "Error: Unable to open file $filename\n";
-	    print $outhandle "       $!\n";
-	    return "";
-	}
-	
-    }
-
-    my $bin_java = &util::filename_cat($ENV{'GSDLHOME'},"bin","java");
-    my $jar_filename = &util::filename_cat($bin_java,"xalan.jar");
-    my $xslt_base_cmd = "java -jar $jar_filename";
-    my $xslt_cmd = "$xslt_base_cmd -IN \"$filename\" -XSL \"$xslt_filename\"";
-
-    my $transformed_xml = "";
-
-    if (open(XSLT_IN,"$xslt_cmd |")) {
-	while (defined (my $line = <XSLT_IN>)) {
-
-	    $transformed_xml .= $line;
-	}
-	close(XSLT_IN);
-    }
-    else {
-	print $outhandle "Error: Unable to run command $xslt_cmd\n";
-	print $outhandle "       $!\n";
-    }
-
-    return $transformed_xml;
-
-}
-
-sub check_doctype {
-    my $self = shift (@_);
-    
-    my ($filename) = @_;
-
-    if (open(XMLIN,"<$filename")) {
-	my $doctype = $self->get_doctype();
-	## check whether the doctype has the same name as the root element tag
-	while (defined (my $line = <XMLIN>)) {
-	    ## find the root element
-	    if ($line =~ /<([\w\d:]+)[\s>]/){
-		my $root = $1;
-		if ($root !~ $doctype){
-		    close(XMLIN);
-		    return 0;
-		}
-		else {
-		    close(XMLIN); 
-		    return 1;
-		}
-	    }
-	}
-	close(XMLIN);
-    }
-    
-    return undef; # haven't found a valid line
-    
-}
-
-# because we are not just using process_exp to determine whether to process or not, we need to implement this too, so that a file can be passed down if we are not actually processing it
-sub metadata_read {
-    my $self = shift (@_);
-    
-    my ($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli) = @_;
- 
-    my $result = $self->SUPER::metadata_read($pluginfo, $base_dir, $file, $metadata, $extrametakeys, $extrametadata, $processor, $maxdocs, $gli);
-
-    if (defined $result) {
-	# we think we are processing this, but check that we actually are
-	my $filename = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
-
-	if ($self->check_doctype($filename)) {
-	    return $result;
-	}
-    }
-    return undef;
-}
-
-sub read {
-    my $self = shift (@_);  
-  
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-
-    # Make sure we're processing the correct file, do blocking etc
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-
-    ## check the doctype to see whether we really want to process the file
-    if (!$self->check_doctype($filename)) {
-	# this file is not for us
-	return undef;
-    }
-
-    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
-    $self->{'base_dir'} = $base_dir;
-    $self->{'file'} = $file;
-    $self->{'filename'} = $filename;
-    $self->{'processor'} = $processor;
-    $self->{'metadata'} = $metadata;
-
-    eval {
-	my $xslt = $self->{'xslt'};
-	if (defined $xslt && ($xslt ne "")) {
-	    # perform xslt
-	    my $transformed_xml = $self->apply_xslt($xslt,$filename);
-
-	    # feed transformed file (now in memory as string) into XML parser
-	    $self->{'parser'}->parse($transformed_xml);
-	}
-	else {
-	    $self->{'parser'}->parsefile($filename);
-	}
-    };
-  
-    if ($@) {
-
-	# parsefile may either croak somewhere in XML::Parser (e.g. because
-	# the document is not well formed) or die somewhere in XMLPlug or a
-	# derived plugin (e.g. because we're attempting to process a
-	# document whose DOCTYPE is not meant for this plugin). For the
-	# first case we'll print a warning and continue, for the second
-	# we'll just continue quietly
-
-	print STDERR "**** Error is: $@\n";
-
-	my ($msg) = $@ =~ /Carp::croak\(\'(.*?)\'\)/;
-	if (defined $msg) {	
-	    my $outhandle = $self->{'outhandle'};
-	    my $plugin_name = ref ($self);
-	    print $outhandle "$plugin_name failed to process $file ($msg)\n";
-	}
-
-	# reset ourself for the next document
-	$self->{'section_level'}=0;
-	print STDERR "<ProcessingError n='$file'>\n" if ($gli);
-	return -1; # error during processing
-    }
-
-    
-    return 1; # processed the file
-}
-
-# the following two methods are for if you want to do the parsing from a
-# plugin that inherits from this. it seems that you can't call the parse 
-# methods directly. WHY???
-#
-# [Stefan 27/5/07] These two methods may not be necessary any more as I've
-# fixed XMLPlug so $self is no longer required to be a global variable
-# (that was why inheritance wasn't working quite right with XMLPlug I
-# think). I don't really know what other plugins rely on these methods
-# though so have left them here for now.
-sub parse_file {
-    my $self = shift (@_); 
-    my ($filename) = @_;
-    $self->{'parser'}->parsefile($filename);
-}
-
-sub parse_string {
-    my $self = shift (@_); 
-    my ($xml_string) = @_;
-    $self->{'parser'}->parse($xml_string);
-}
-
-sub get_default_process_exp {
-    my $self = shift (@_);
-
-    return q^(?i)\.xml$^;
-}
-
-sub StartDocument {$_[0]->{'PluginObj'}->xml_start_document(@_);}
-sub XMLDecl {$_[0]->{'PluginObj'}->xml_xmldecl(@_);}
-sub Entity {$_[0]->{'PluginObj'}->xml_entity(@_);}
-sub Doctype {$_[0]->{'PluginObj'}->xml_doctype(@_);}
-sub StartTag {$_[0]->{'PluginObj'}->xml_start_tag(@_);}
-sub EndTag {$_[0]->{'PluginObj'}->xml_end_tag(@_);}
-sub Text {$_[0]->{'PluginObj'}->xml_text(@_);}
-sub PI {$_[0]->{'PluginObj'}->xml_pi(@_);}
-sub EndDocument {$_[0]->{'PluginObj'}->xml_end_document(@_);}
-sub Default {$_[0]->{'PluginObj'}->xml_default(@_);}
-
-# This Char function overrides the one in XML::Parser::Stream to overcome a
-# problem where $expat->{Text} is treated as the return value, slowing
-# things down significantly in some cases.
-sub Char {
-    use bytes;  # Necessary to prevent encoding issues with XML::Parser 2.31+
-    $_[0]->{'Text'} .= $_[1];
-    return undef;
-}
-
-# Called at the beginning of the XML document.
-sub xml_start_document {
-    my $self = shift(@_);
-    my ($expat) = @_;
-
-    $self->open_document();
-}
-
-# Called for XML declarations
-sub xml_xmldecl {
-    my $self = shift(@_);
-    my ($expat, $version, $encoding, $standalone) = @_;
-}
-
-# Called for XML entities
-sub xml_entity {
-  my $self = shift(@_);
-  my ($expat, $name, $val, $sysid, $pubid, $ndata) = @_;
-}
-
-# Called for DOCTYPE declarations - use die to bail out if this doctype
-# is not meant for this plugin
-sub xml_doctype {
-    my $self = shift(@_);
-
-    my ($expat, $name, $sysid, $pubid, $internal) = @_;
-    die "XMLPlug Cannot process XML document with DOCTYPE of $name";
-}
-
-
-# Called for every start tag. The $_ variable will contain a copy of the
-# tag and the %_ variable will contain the element's attributes.
-sub xml_start_tag {
-    my $self = shift(@_);
-    my ($expat, $element) = @_;
-}
-
-# Called for every end tag. The $_ variable will contain a copy of the tag.
-sub xml_end_tag {
-    my $self = shift(@_);
-    my ($expat, $element) = @_;
-}
-
-# Called just before start or end tags with accumulated non-markup text in
-# the $_ variable.
-sub xml_text {
-    my $self = shift(@_);
-    my ($expat) = @_;
-}
-
-# Called for processing instructions. The $_ variable will contain a copy
-# of the pi.
-sub xml_pi {
-    my $self = shift(@_);
-    my ($expat, $target, $data) = @_;
-}
-
-# Called at the end of the XML document.
-sub xml_end_document {
-    my $self = shift(@_);
-    my ($expat) = @_;
-
-    $self->close_document();
-}
-
-# Called for any characters not handled by the above functions.
-sub xml_default {
-    my $self = shift(@_);
-    my ($expat, $text) = @_;
-}
-
-sub open_document {
-    my $self = shift(@_);
-
-    # create a new document
-    $self->{'doc_obj'} = new doc ($self->{'filename'}, "indexed_doc");
-    $self->{'doc_obj'}->set_OIDtype ($self->{'processor'}->{'OIDtype'}, $self->{'processor'}->{'OIDmetadata'});
-}
-
-sub close_document {
-    my $self = shift(@_);
-    my $doc_obj = $self->{'doc_obj'};
-    # include any metadata passed in from previous plugins 
-    # note that this metadata is associated with the top level section
-    $self->extra_metadata ($doc_obj, 
-			   $doc_obj->get_top_section(), 
-			   $self->{'metadata'});
-   
-    # do any automatic metadata extraction
-    $self->auto_extract_metadata ($doc_obj);
-   
-    # add an OID
-    $doc_obj->set_OID();
-    
-    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
-    $doc_obj->add_metadata($doc_obj->get_top_section(), "FileFormat", "XML");
-
-    # process the document
-    $self->{'processor'}->process($doc_obj);
-    
-    $self->{'num_processed'} ++;
-}
-
-1;
-
-
-
-
Index: dl/trunk/perllib/plugins/ZIPPlug.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ZIPPlug.pm	(revision 15864)
+++ 	(revision )
@@ -1,191 +1,0 @@
-###########################################################################
-#
-# ZIPPlug.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) 1999 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.
-#
-###########################################################################
-
-# plugin which handles compressed and/or archived input formats
-#
-# currently handled formats and file extensions are:
-# 
-# gzip (.gz, .z, .tgz, .taz)
-# bzip (.bz)
-# bzip2 (.bz2)
-# zip (.zip .jar)
-# tar (.tar)
-#
-# this plugin relies on the following utilities being present 
-# (if trying to process the corresponding formats)
-#
-# gunzip (for gzip)
-# bunzip (for bzip)
-# bunzip2 
-# unzip (for zip)
-# tar (for tar) 
-
-
-package ZIPPlug;
-
-use BasPlug;
-use plugin;
-use util;
-use Cwd;
-
-use strict;
-no strict 'refs'; # allow filehandles to be variables and viceversa
-
-BEGIN {
-    @ZIPPlug::ISA = ('BasPlug');
-}
-
-my $arguments =
-    [ { 'name' => "process_exp",
-	'desc' => "{BasPlug.process_exp}",
-	'type' => "string",
-	'deft' => &get_default_process_exp(),
-	'reqd' => "no" } ];
-
-my $options = { 'name'     => "ZIPPlug",
-		'desc'     => "{ZIPPlug.desc}",
-		'abstract' => "no",
-		'inherits' => "yes",
-		'args'     => $arguments };
-
-sub new {
-
-    my ($class) = shift (@_);
-    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
-    push(@$pluginlist, $class);
-
-    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
-    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
-
-    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
-
-    return bless $self, $class;
-}
-
-# this is a recursive plugin
-sub is_recursive {
-    my $self = shift (@_);
-
-    return 1;
-}
-
-sub get_default_process_exp {
-    return q^(?i)\.(gz|tgz|z|taz|bz|bz2|zip|jar|tar)$^;
-}
-
-# return number of files processed, undef if can't process
-# Note that $base_dir might be "" and that $file might 
-# include directories
-sub read {
-    my $self = shift (@_);
-    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
-    my $outhandle = $self->{'outhandle'};
-
-    # check process_exp, block_exp, associate_ext etc
-    my ($block_status,$filename) = $self->read_block(@_);    
-    return $block_status if ((!defined $block_status) || ($block_status==0));
-	
-    my ($file_only) = $file =~ /([^\\\/]*)$/;
-    my $tmpdir = &util::get_tmp_filename ();
-    &util::mk_all_dir ($tmpdir);
-    
-    print $outhandle "ZIPPlug: extracting $file_only to $tmpdir\n"
-	if $self->{'verbosity'} > 1;
-    
-    # save current working directory
-    my $cwd = cwd();
-    chdir ($tmpdir) || die "Unable to change to $tmpdir";
-    &util::cp ($filename, $tmpdir);
-    
-    if ($file =~ /\.bz$/i) {
-	$self->bunzip ($file_only);
-    } elsif ($file =~ /\.bz2$/i) {
-	$self->bunzip2 ($file_only);
-    } elsif ($file =~ /\.(zip|jar)$/i) {
-	$self->unzip ($file_only);
-    } elsif ($file =~ /\.tar$/i) {
-	$self->untar ($file_only);
-    } else {
-	$self->gunzip ($file_only);
-    }
-    
-    chdir ($cwd) || die "Unable to change back to $cwd";
-    
-    my $numdocs = &plugin::read ($pluginfo, "", $tmpdir, $metadata, $processor, $maxdocs, $total_count, $gli);
-    &util::rm_r ($tmpdir);
-    
-    $self->{'num_archives'} ++;
-    
-    return $numdocs;
-    
-}
-
-sub bunzip {
-    my $self = shift (@_);
-    my ($file) = @_;
-
-    if (system ("bunzip $file")!=0)
-    {
-	&util::rm ($file);
-    }
-}
-
-sub bunzip2 {
-    my $self = shift (@_);
-    my ($file) = @_;
-
-    if (system ("bunzip2 $file")!=0)
-    {
-	&util::rm ($file);
-    }
-}
-
-sub unzip {
-    my $self = shift (@_);
-    my ($file) = @_;
-
-    system ("unzip $file");
-    &util::rm ($file) if -e $file;
-}
-
-sub untar {
-    my $self = shift (@_);
-    my ($file) = @_;
-
-    system ("tar xf $file");
-    &util::rm ($file) if -e $file;
-}
-
-sub gunzip {
-    my $self = shift (@_);
-    my ($file) = @_;
-
-    if (system ("gunzip $file")!=0)
-    {
-	&util::rm ($file);
-    };
-}
-
-1;
Index: /gsdl/trunk/perllib/plugins/ZIPPlugin.pm
===================================================================
--- /gsdl/trunk/perllib/plugins/ZIPPlugin.pm	(revision 15865)
+++ /gsdl/trunk/perllib/plugins/ZIPPlugin.pm	(revision 15865)
@@ -0,0 +1,191 @@
+###########################################################################
+#
+# ZIPPlug.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) 1999 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.
+#
+###########################################################################
+
+# plugin which handles compressed and/or archived input formats
+#
+# currently handled formats and file extensions are:
+# 
+# gzip (.gz, .z, .tgz, .taz)
+# bzip (.bz)
+# bzip2 (.bz2)
+# zip (.zip .jar)
+# tar (.tar)
+#
+# this plugin relies on the following utilities being present 
+# (if trying to process the corresponding formats)
+#
+# gunzip (for gzip)
+# bunzip (for bzip)
+# bunzip2 
+# unzip (for zip)
+# tar (for tar) 
+
+
+package ZIPPlug;
+
+use BasPlug;
+use plugin;
+use util;
+use Cwd;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+BEGIN {
+    @ZIPPlug::ISA = ('BasPlug');
+}
+
+my $arguments =
+    [ { 'name' => "process_exp",
+	'desc' => "{BasPlug.process_exp}",
+	'type' => "string",
+	'deft' => &get_default_process_exp(),
+	'reqd' => "no" } ];
+
+my $options = { 'name'     => "ZIPPlug",
+		'desc'     => "{ZIPPlug.desc}",
+		'abstract' => "no",
+		'inherits' => "yes",
+		'args'     => $arguments };
+
+sub new {
+
+    my ($class) = shift (@_);
+    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
+    push(@$pluginlist, $class);
+
+    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
+    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
+
+    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);
+
+    return bless $self, $class;
+}
+
+# this is a recursive plugin
+sub is_recursive {
+    my $self = shift (@_);
+
+    return 1;
+}
+
+sub get_default_process_exp {
+    return q^(?i)\.(gz|tgz|z|taz|bz|bz2|zip|jar|tar)$^;
+}
+
+# return number of files processed, undef if can't process
+# Note that $base_dir might be "" and that $file might 
+# include directories
+sub read {
+    my $self = shift (@_);
+    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs, $total_count, $gli) = @_;
+    my $outhandle = $self->{'outhandle'};
+
+    # check process_exp, block_exp, associate_ext etc
+    my ($block_status,$filename) = $self->read_block(@_);    
+    return $block_status if ((!defined $block_status) || ($block_status==0));
+	
+    my ($file_only) = $file =~ /([^\\\/]*)$/;
+    my $tmpdir = &util::get_tmp_filename ();
+    &util::mk_all_dir ($tmpdir);
+    
+    print $outhandle "ZIPPlug: extracting $file_only to $tmpdir\n"
+	if $self->{'verbosity'} > 1;
+    
+    # save current working directory
+    my $cwd = cwd();
+    chdir ($tmpdir) || die "Unable to change to $tmpdir";
+    &util::cp ($filename, $tmpdir);
+    
+    if ($file =~ /\.bz$/i) {
+	$self->bunzip ($file_only);
+    } elsif ($file =~ /\.bz2$/i) {
+	$self->bunzip2 ($file_only);
+    } elsif ($file =~ /\.(zip|jar)$/i) {
+	$self->unzip ($file_only);
+    } elsif ($file =~ /\.tar$/i) {
+	$self->untar ($file_only);
+    } else {
+	$self->gunzip ($file_only);
+    }
+    
+    chdir ($cwd) || die "Unable to change back to $cwd";
+    
+    my $numdocs = &plugin::read ($pluginfo, "", $tmpdir, $metadata, $processor, $maxdocs, $total_count, $gli);
+    &util::rm_r ($tmpdir);
+    
+    $self->{'num_archives'} ++;
+    
+    return $numdocs;
+    
+}
+
+sub bunzip {
+    my $self = shift (@_);
+    my ($file) = @_;
+
+    if (system ("bunzip $file")!=0)
+    {
+	&util::rm ($file);
+    }
+}
+
+sub bunzip2 {
+    my $self = shift (@_);
+    my ($file) = @_;
+
+    if (system ("bunzip2 $file")!=0)
+    {
+	&util::rm ($file);
+    }
+}
+
+sub unzip {
+    my $self = shift (@_);
+    my ($file) = @_;
+
+    system ("unzip $file");
+    &util::rm ($file) if -e $file;
+}
+
+sub untar {
+    my $self = shift (@_);
+    my ($file) = @_;
+
+    system ("tar xf $file");
+    &util::rm ($file) if -e $file;
+}
+
+sub gunzip {
+    my $self = shift (@_);
+    my ($file) = @_;
+
+    if (system ("gunzip $file")!=0)
+    {
+	&util::rm ($file);
+    };
+}
+
+1;
