source: trunk/gsdl/perllib/plugins/BasPlug.pm@ 1360

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

use parsargv;
use multiread;
use cnseg;
use acronym;
use textcat;
use strict;
use doc;
use diagnostics;

sub print_general_usage {
    my ($plugin_name) = @_;

    print STDERR "\n  usage: plugin $plugin_name [options]\n\n";
    print STDERR "   -input_encoding   The encoding of the source documents. Documents will be\n";
    print STDERR "                     converted from these encodings and stored internally as\n";
    print STDERR "                     utf8. The default input_encoding is ascii. Accepted values\n";
    print STDERR "                     are:\n";
    print STDERR "                        iso_8859_1 (extended ascii)\n";
    print STDERR "                        Latin1 (the same as iso-8859-1)\n";
    print STDERR "                        ascii (7 bit ascii -- may be faster than Latin1 as no\n";
    print STDERR "                               conversion is neccessary)\n";
    print STDERR "                        gb (GB or GBK simplified Chinese)\n";
    print STDERR "                        iso_8859_6 (8 bit Arabic)\n";
    print STDERR "                        windows_1256 (Windows codepage 1256 (Arabic))\n";
    print STDERR "                        Arabic (the same as windows_1256)\n";
    print STDERR "                        utf8 (either utf8 or unicode -- automatically detected)\n";
    print STDERR "                        unicode (just unicode -- doesn't currently do endian\n";
    print STDERR "                                 detection)\n";
    print STDERR "   -process_exp      A perl regular expression to match against filenames.\n";
    print STDERR "                     Matching filenames will be processed by this plugin.\n";
    print STDERR "                     Each plugin has its own default process_exp. e.g HTMLPlug\n";
    print STDERR "                     defaults to '(?i)\.html?\$' i.e. all documents ending in\n";
    print STDERR "                     .htm or .html (case-insensitive).\n";
    print STDERR "   -block_exp        Files matching this regular expression will be blocked from\n";
    print STDERR "                     being passed to any further plugins in the list. This has no\n";
    print STDERR "                     real effect other than to prevent lots of warning messages\n";
    print STDERR "                     about input files you don't care about. Each plugin may or may\n";
    print STDERR "                     not have a default block_exp. e.g. by default HTMLPlug blocks\n";
    print STDERR "                     any files with .gif, .jpg, .jpeg, .png, .pdf, .rtf or .css\n";
    print STDERR "                     file extensions.\n";
    print STDERR "   -extract_acronyms Extract acronyms from within text and set as metadata\n\n";
    print STDERR "   -extract_langauge Identify the language of the text and set as metadata\n\n";
}

# print_usage should be overridden for any sub-classes having 
# their own plugin specific options
sub print_usage {
    print STDERR "\nThis plugin has no plugin specific options\n\n";

}

sub new {
    my $class = shift (@_);
    my $plugin_name = shift (@_);

    my $self = {};
    my $encodings = "^(iso_8859_1|Latin1|ascii|gb|iso_8859_6|windows_1256|Arabic|utf8|unicode)\$";

    # general options available to all plugins
    if (!parsargv::parse(\@_,
             qq^input_encoding/$encodings/ascii^, \$self->{'input_encoding'},
             q^process_exp/.*/^, \$self->{'process_exp'},
             q^block_exp/.*/^, \$self->{'block_exp'},
             q^extract_acronyms^, \$self->{'extract_acronyms'},
             q^extract_language^, \$self->{'extract_language'},
             "allow_extra_options")) {

    print STDERR "\nThe $plugin_name plugin uses an incorrect general option (general options are those\n";
    print STDERR "available to all plugins). Check your collect.cfg configuration file.\n";
        &print_general_usage($plugin_name);
    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) = @_;

    # verbosity is passed through from the processor
    $self->{'verbosity'} = $verbosity;

    # 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 ();
    }
    
    # handle input_encoding aliases
    $self->{'input_encoding'} = "iso_8859_1" if $self->{'input_encoding'} eq "Latin1";
    $self->{'input_encoding'} = "windows_1256" if $self->{'input_encoding'} eq "Arabic";
}

sub begin {
    my $self = shift (@_);
    my ($pluginfo, $base_dir, $processor, $maxdocs) = @_;
}

sub end {
    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 "";
}

# 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 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) = @_;

    if ($self->is_recursive()) {
    die "BasPlug::read function must be implemented in sub-class for recursive plugins\n";
    }

    my $filename = &util::filename_cat($base_dir, $file);
    return 0 if $self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/;
    if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
    return undef;
    }
    my $plugin_name = ref ($self);
    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
    
    # create a new document
    my $doc_obj = new doc ($file, "indexed_doc");
    
    # read in file ($text will be in utf8)
    my $text = "";
    $self->read_file ($filename, \$text);

    if ($text !~ /\w/) {
    print STDERR "$plugin_name: ERROR: $file contains no text\n" if $self->{'verbosity'};
    return 0;
    }

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

    # process the document
    $processor->process($doc_obj);

    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) = @_;

    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, $textref) = @_;

    $$textref = "";

    open (FILE, $filename) || die "BasPlug::read_file could not open $filename for reading ($!)\n";

    if ($self->{'input_encoding'} eq "ascii") {
    undef $/;
    $$textref = <FILE>;
    $/ = "\n";
    } else {
    my $reader = new multiread();
    $reader->set_handle ('BasPlug::FILE');
    $reader->set_encoding ($self->{'input_encoding'});
    $reader->read_file ($textref);

    if ($self->{'input_encoding'} eq "gb") {
        # segment the Chinese words
        $$textref = &cnseg::segment($$textref);
    }
    }

    close FILE;
}

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

# extract acronyms (and hopefully other stuff soon too).
sub auto_extract_metadata {
    my $self = shift (@_);
    my ($doc_obj) = @_;

    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->{'extract_language'}) {
    my $thissection = $doc_obj->get_top_section();
    while (defined $thissection) {
        my $text = $doc_obj->get_text($thissection);
        $self->extract_language (\$text, $doc_obj, $thissection) if $text =~ /./;
        $thissection = $doc_obj->get_next_section ($thissection);
    }
    }

}


# Identify the language of a section and add it to the metadata
sub extract_language {
    my $self = shift (@_);
    my ($textref, $doc_obj, $thissection) = @_;

    # remove all HTML tags
    my $text = $$textref;
    $text =~ s/<P[^>]*>/\n/sgi;
    $text =~ s/<H[^>]*>/\n/sgi;
    $text =~ s/<[^>]*>//sgi;
    $text =~ tr/\n/\n/s;

    # get the language
    my @results = textcat::classify($text);
    @results = ("unknown") if ($#results > 2);

    my $language = join(" or ", @results);
    $doc_obj->add_utf8_metadata($thissection, "Language",  $language);
    print "Language: $language\n";

}

# extract acronyms from a section in a document. progress is 
# reported to STDERR 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) = @_;

    print STDERR " checking for 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 STDERR "  already seen ". $acro->to_string() . "\n" 
            if ($self->{'verbosity'} >= 2);
        }       
    }

    if ($seen_before eq "false")
    {
        #do the normal acronym
        $doc_obj->add_utf8_metadata($thissection, "Acronym",  $acro->to_string());
        print STDERR "  adding ". $acro->to_string() . "\n" 
            if ($self->{'verbosity'} >= 1);
        
        # do the KWIC (Key Word In Context) acronym
        my @kwic = $acro->to_string_kwic();
        foreach my $kwic (@kwic) {
        $doc_obj->add_utf8_metadata($thissection, "AcronymKWIC",  $kwic);
        print STDERR "   adding ".  $kwic . "\n" 
            if ($self->{'verbosity'} >= 2);
        }
    }
    }
    print STDERR " done with acronyms. \n" 
    if ($self->{'verbosity'} >= 2);
}

1;