###########################################################################
#
# 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 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;

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 Kea;
use parsargv;
use multiread;
use encodings;
use cnseg;
use acronym;
use textcat;
use doc;
use diagnostics;
use DateExtract;
use ghtml;
use gsprintf;
use printusage;


my $unicode_list =
    [ { 'name' => "auto",
	'desc' => "{BasPlug.input_encoding.auto}" },
      { 'name' => "ascii",
	'desc' => "{BasPlug.input_encoding.ascii}" },
      { 'name' => "utf8",
	'desc' => "{BasPlug.input_encoding.utf8}" },
      { 'name' => "unicode",
	'desc' => "{BasPlug.input_encoding.unicode}" } ];

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' => "input_encoding",
	'desc' => "{BasPlug.input_encoding}",
	'type' => "enum",
	'list' => $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' => "language",
	'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' => "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,
	'reqd' => "no"},
      { 'name' => "maximum_century",
	'desc' => "{BasPlug.maximum_century}",
	'type' => "string",
	'deft' => "",
	'reqd' => "no" },
      { 'name' => "no_bibliography",
	'desc' => "{BasPlug.no_bibliography}",
	'type' => "flag",
	'reqd' => "no"},
      { 'name' => "cover_image",
	'desc' => "{BasPlug.cover_image}",
	'type' => "flag",
	'reqd' => "no" } ];

my $options = { 'name'     => "BasPlug",
		'desc'     => "{BasPlug.desc}",
		'abstract' => "yes",
		'inherits' => "no",
		'args'     => $arguments };


sub gsprintf
{
    return &gsprintf::gsprintf(@_);
}


sub get_arguments
{
    local $self = shift(@_);
    local $optionlistref = $self->{'option_list'};
    local @optionlist = @$optionlistref;
    local $pluginoptions = pop(@$optionlistref);
    local $pluginarguments = $pluginoptions->{'args'};
    return $pluginarguments;
}


sub print_xml_usage
{
    local $self = shift(@_);

    # XML output is always in UTF-8
    &gsprintf::output_strings_in_UTF8;

    &PrintUsage::print_xml_header();
    $self->print_xml();
}


sub print_xml
{
    local $self = shift(@_);

    local $optionlistref = $self->{'option_list'};
    local @optionlist = @$optionlistref;
    local $pluginoptions = pop(@$optionlistref);
    return if (!defined($pluginoptions));

    &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, "  <Arguments>\n");
    if (defined($pluginoptions->{'args'})) {
	&PrintUsage::print_options_xml($pluginoptions->{'args'});
    }

    # Recurse up the plugin hierarchy
    $self->print_xml();

    &gsprintf(STDERR, "  </Arguments>\n");
    &gsprintf(STDERR, "</PlugInfo>\n");
}


sub print_txt_usage
{
    local $self = shift(@_);

    # Print the usage message for a plugin (recursively)
    local $descoffset = $self->determine_description_offset(0);
    $self->print_plugin_usage($descoffset, 1);
}


sub determine_description_offset
{
    local $self = shift(@_);
    local $maxoffset = shift(@_);

    local $optionlistref = $self->{'option_list'};
    local @optionlist = @$optionlistref;
    local $pluginoptions = pop(@$optionlistref);
    return $maxoffset if (!defined($pluginoptions));

    # Find the length of the longest option string of this plugin
    local $pluginargs = $pluginoptions->{'args'};
    if (defined($pluginargs)) {
	local $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
{
    local $self = shift(@_);
    local $descoffset = shift(@_);
    local $isleafclass = shift(@_);

    local $optionlistref = $self->{'option_list'};
    local @optionlist = @$optionlistref;
    local $pluginoptions = pop(@$optionlistref);
    return if (!defined($pluginoptions));

    local $pluginname = $pluginoptions->{'name'};
    local $pluginargs = $pluginoptions->{'args'};
    local $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
	local $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 {
    my $class = shift (@_);
    my $plugin_name = shift (@_);
    my $self = {};
    $self->{'plugin_type'} = "BasPlug";
    my $enc = "^(";
    map {$enc .= "$_|";} keys %$encodings::encodings;
    my $denc = $enc . "ascii|utf8|unicode)\$";
    $enc .= "ascii|utf8|unicode|auto)\$";
    
    $self->{'outhandle'} = STDERR;
    my $year = (localtime)[5]+1900;

    $self->{'textcat'} = new textcat();

    $self->{'num_processed'} = 0;
    $self->{'num_not_processed'} = 0;
    $self->{'num_blocked'} = 0;
    $self->{'num_archives'} = 0;
    
    # 14-05-02 To allow for proper inheritance of arguments - John Thompson
    $self->{'option_list'} = [ $options ];
    
    # general options available to all plugins
    if (!parsargv::parse(\@_,
			 q^process_exp/.*/^, \$self->{'process_exp'},
			 q^block_exp/.*/^, \$self->{'block_exp'},
			 q^extract_language^, \$self->{'extract_language'},
			 q^extract_acronyms^, \$self->{'extract_acronyms'}, 
			 q^extract_keyphrases^, \$self->{'kea'}, #with extra options (UNDOCUMENTED)
			 q^extract_keyphrase_options/.*/^, \$self->{'kea_options'}, #no extra options (UNDOCUMENTED)
			 qq^input_encoding/$enc/auto^, \$self->{'input_encoding'},
			 qq^default_encoding/$denc/utf8^, \$self->{'default_encoding'},
			 q^extract_email^, \$self->{'extract_email'},
			 q^markup_acronyms^, \$self->{'markup_acronyms'},
			 q^default_language/.{2}/en^, \$self->{'default_language'},
			 q^first/.*/^, \$self->{'first'},
			 q^extract_historical_years^, \$self->{'date_extract'},
			 qq^maximum_year/\\d{4}/$year^, \$self->{'max_year'},
			 q^no_bibliography^, \$self->{'no_biblio'},
			 qq^maximum_century/-?\\d{1,2}( ?B\\.C\\.E\\.)?/-1^, \$self->{'max_century'},
			 q^cover_image^, \$self->{'cover_image'},
			 q^separate_cjk^, \$self->{'separate_cjk'},
			 "allow_extra_options")) {

	&gsprintf(STDERR, "\n{BasPlug.bad_general_option}\n", $plugin_name);
	$self->print_txt_usage("");  # Use default resource bundle
	die "\n";
    }

    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) = @_;
    $self->initialise_extractors();
}

sub end {
    my ($self) = @_;
    $self->finalise_extractors();
}

# 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 "";
}

# The BasPlug 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.
#
# recursive plugins (e.g. RecPlug) and specialized plugins like those
# capable of processing many documents within a single file (e.g.
# GMLPlug) should normally implement their own version of read()
#
# Return number of files processed, undef if can't recognise, -1 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, $gli) = @_;

    if ($self->is_recursive()) {
	&gsprintf(STDERR, "{BasPlug.read_must_be_implemented}") && die "\n";
    }

    my $outhandle = $self->{'outhandle'};

    my $filename = $file;
    $filename = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;

    if ($self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/) {
	$self->{'num_blocked'} ++;
	return 0; # blocked
    }
    if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
	return undef; # can't recognise
    }
    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up

    # Do encoding stuff
    my ($language, $encoding) = $self->textcat_get_language_encoding ($filename);

    # create a new document
    my $doc_obj = new doc ($filename, "indexed_doc");
    $doc_obj->set_OIDtype ($processor->{'OIDtype'});
    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Language", $language);
    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Encoding", $encoding);
    $doc_obj->add_utf8_metadata($doc_obj->get_top_section(), "Plugin", "$self->{'plugin_type'}");
    my ($filemeta) = $file =~ /([^\\\/]+)$/;
    # how do we know what encoding the filename is in?
    $doc_obj->add_metadata($doc_obj->get_top_section(), "Source", &ghtml::dmsafe($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);
	&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; # 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
    $self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);

    # do plugin specific processing of doc_obj
    return -1  unless defined ($self->process (\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj, $gli));
   
    # do any automatic metadata extraction
    $self->auto_extract_metadata ($doc_obj);
   
    # 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; # processed the file
}

# returns undef if file is rejected by the plugin
sub process {
    my $self = shift (@_);
    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;

    &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 = "";

    open (FILE, $filename) || (&gsprintf(STDERR, "BasPlug::read_file {BasPlug.could_not_open_for_reading} ($!)\n", $filename) && die "\n");
    # open (FILE, $filename) || die "BasPlug::read_file could not open $filename for reading ($!)\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;
}

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_metadata ($section, "Title", $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);
            # print $outhandle "$plugin_name: WARNING: $filename was read using $encoding encoding but ";
            # print $outhandle "appears to be encoded as $extracted_encoding.\n";
        }
    } 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'};

    # read in file
    open (FILE, $filename) || (&gsprintf(STDERR, "BasPlug::get_language_encoding {BasPlug.could_not_open_for_reading} ($!)\n", $filename) && die "\n"); # die "BasPlug::get_language_encoding could not open $filename for reading ($!)\n";
    undef $/;
    my $text = <FILE>;
    $/ = "\n";
    close FILE;

    # remove <title>stuff</title> -- as titles tend often to be in English
    # for foreign language documents
    $text =~ s/<title>.*?<\/title>//i;

    # remove all HTML tags
    $text =~ s/<[^>]*>//sg;

    # get the language/encoding
    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) {
	# changed 12 Feb 2003 by jrm21
	# use the most popular encoding at least... otherwise we might
	# generate invalid archive files!
	my %guessed_encodings = ();
	foreach my $result (@$results) {
	    $result =~ /([^\-]+)$/;
	    my $enc=$1;
	    if (!defined($guessed_encodings{$enc})) {
		$guessed_encodings{$enc}=0;
	    }
	    $guessed_encodings{$enc}++;
	}
	my $best_encoding="";
	$guessed_encodings{""}=-1;
	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'}) {
		&gsprintf($outhandle, "BasPlug: {BasPlug.could_not_extract_language}\n", $filename, $self->{'default_language'});
		# print $outhandle "BasPlug: WARNING: language could not be extracted from $filename - ";
		# print $outhandle "defaulting to $self->{'default_language'}\n";
	    }		
	    return ($self->{'default_language'}, $self->{'input_encoding'});

	} else {
	    if ($self->{'verbosity'}) {
		&gsprintf($outhandle, "BasPlug: {BasPlug.could_not_extract_language}\n", $filename, $self->{'default_language'});
		# print $outhandle "BASPlug: WARNING: language could not be extracted from $filename - ";
		# print $outhandle "defaulting to $self->{'default_language'}.\n";
	    }
	    return ($self->{'default_language'}, $best_encoding);
	}
    }

    # format language/encoding
    my ($language, $encoding) = $results->[0] =~ /^([^-]*)(?:-(.*))?$/;
    if (!defined $language) {
	if ($self->{'verbosity'}) {
	    &gsprintf($outhandle, "BasPlug: {BasPlug.could_not_extract_language}\n", $filename, $self->{'default_language'});
	    # print $outhandle "BasPlug: WARNING: language could not be extracted from $filename - ";
	    # print $outhandle "defaulting to $self->{'default_language'}\n";
	}
	$language = $self->{'default_language'};
    }
    if (!defined $encoding) {
	if ($self->{'verbosity'}) {
	    &gsprintf($outhandle, "BasPlug: {BasPlug.could_not_extract_encoding}\n", $filename, $self->{'default_encoding'});
	    # print $outhandle "BasPlug: WARNING: encoding could not be extracted from $filename - ";
	    # print $outhandle "defaulting to $self->{'default_encoding'}\n";
	}
	$encoding = $self->{'default_encoding'};
    }

    if ($encoding !~ /^(ascii|utf8|unicode)$/ &&
	!defined $encodings::encodings->{$encoding}) {
	if ($self->{'verbosity'}) {
	    &gsprintf($outhandle, "BasPlug: {BasPlug.unsupported_encoding}\n", $filename, $encoding, $self->{'default_encoding'});
	    # print $outhandle "BasPlug: WARNING: $filename appears to be encoded in an unsupported encoding ($encoding) - ";
	    # print $outhandle "using $self->{'default_encoding'}\n";
	}
	$encoding = $self->{'default_encoding'};
    }

    return ($language, $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) = @_;

    foreach my $field (keys(%$metadata)) {
	# $metadata->{$field} may be an array reference
	if (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'};

    # print $outhandle " extracting email addresses ...\n" 
    &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;
    
    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);
	}
    }
    # print $outhandle " done extracting email addresses.\n" 
    &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);
	}
    } 


#adding kea keyphrases
    if ($self->{'kea'}) {  
	
	my $thissection = $doc_obj->get_top_section();
	my $text = "";
	my @list;

	while (defined $thissection) { #loop through sections to gather whole doc
	    my $sectiontext = $doc_obj->get_text($thissection);   
	    $text = $text.$sectiontext;
	    $thissection = $doc_obj->get_next_section ($thissection);
	} 
       
	if($self->{'kea_options'}) { #if kea options flag is set, call Kea with specified options 
	    @list = &Kea::extract_KeyPhrases ($text, $self->{'kea_options'}); 
	} else { #otherwise call Kea with no options
	    @list = &Kea::extract_KeyPhrases ($text); 
	}
	 
	if(@list){ #if a list of kea keyphrases was returned (ie not empty)
	    my $keyphrases = $list[0]; #first arg is keyphrase list
	    my $stems = $list[1]; #second  arg is stemmed keyphrase list
	    &gsprintf(STDERR, "{BasPlug.keyphrases}: $keyphrases\n");
	    # print STDERR "keyphrases: $keyphrases\n"; 
	    &gsprintf(STDERR, "{BasPlug.stems}: $stems\n");
	    # print STDERR "stems: $stems\n";
	    $thissection = $doc_obj->get_top_section(); #add metadata to top section
	    $doc_obj->add_metadata($thissection, "kea", $keyphrases);
	    $doc_obj->add_metadata($thissection, "stems", $stems); 
	}
    } #end of kea 

    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->{'date_extract'}) {
	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_biblio'}, 
					    $self->{'max_year'}, 
					    $self->{'max_century'});
	    $thissection = $doc_obj->get_next_section ($thissection);
	}
    }
}

# 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";
		# print $outhandle "  already seen ". $acro->to_string() . "\n" 
		&gsprintf($outhandle, " {BasPlug.already_seen} " . $acro->to_string() . "\n")
		    if ($self->{'verbosity'} >= 4);
	    }
	}

	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());
	    # print $outhandle "  adding ". $acro->to_string() . "\n" 
	    &gsprintf($outhandle, " {BasPlug.adding} " . $acro->to_string() . "\n")
		if ($self->{'verbosity'} > 3);
	}
    }

    # print $outhandle " done extracting acronyms. \n" 
    &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'};

    # print $outhandle " marking up acronyms ...\n" 
    &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);

    # print $outhandle " done marking up acronyms. \n" 
    &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 (-e $filename) {
	$doc_obj->associate_file($filename, "cover.jpg", "image/jpeg");
    } else {
	$filename =~ s/jpg$/JPG/;
	if (-e $filename) {
	    $doc_obj->associate_file($filename, "cover.jpg", "image/jpeg");
	}
    }
}

1;