source: trunk/gsdl/perllib/classify/BasClas.pm@ 7405

###########################################################################
#
# BasClas.pm -- base class for all classifiers
#
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 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.
#
###########################################################################

package BasClas;

# How a classifier works.  
#
# For each classifier requested in the collect.cfg file, buildcol.pl creates
# a new classifier object (a subclass of BasClas).  Later, it passes each 
# document object to each classifier in turn for classification.
#
# Four primary functions are used:
#
# 1. "new" is called before the documents are processed to set up the
#    classifier.
#
# 2. "init" is called after buildcol.pl has created the indexes etc but
#    before the documents are classified in order that the classifier might
#    set any variables it requires, etc.
#
# 3. "classify" is called once for each document object.  The classifier
#    "classifies" each document and updates its local data accordingly.
#
# 4. "get_classify_info" is called after every document has been
#    classified.  It collates the information about the documents and
#    stores a reference to the classifier so that Greenstone can later
#    display it.

# 09/05/02 Added usage datastructure - John Thompson
# 28/11/03 Commented out verbosity argument - John Thompson

use parsargv;
use gsprintf;
use printusage;


my $arguments = 
    [ { 'name' => "builddir",
    'desc' => "{BasClas.builddir}",
    'type' => "string",
    'deft' => "" },
      { 'name' => "outhandle",
    'desc' => "{BasClas.outhandle}",
    'type' => "string",
    'deft' => "STDERR" },
#      { 'name' => "verbosity",
#   'desc' => "{BasClas.verbosity}",
#   'type' => "enum",
#   'deft' => "2",
#   'reqd' => "no" } ];
#      { 'name' => "ignore_namespace",
#   'desc' => "{BasClas.ignore_namespace}",
#   'type' => "flag"} 
      ];

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


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


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 $classifieroptions = pop(@$optionlistref);
    return if (!defined($classifieroptions));

    &gsprintf(STDERR, "<ClassInfo>\n");
    &gsprintf(STDERR, "  <Name>$classifieroptions->{'name'}</Name>\n");
    my $desc = &gsprintf::lookup_string($classifieroptions->{'desc'});
    $desc =~ s/</&amp;lt;/g; # doubly escaped
    $desc =~ s/>/&amp;gt;/g;
    &gsprintf(STDERR, "  <Desc>$desc</Desc>\n");
    &gsprintf(STDERR, "  <Abstract>$classifieroptions->{'abstract'}</Abstract>\n");
    &gsprintf(STDERR, "  <Inherits>$classifieroptions->{'inherits'}</Inherits>\n");
    &gsprintf(STDERR, "  <Arguments>\n");
    if (defined($classifieroptions->{'args'})) {
    &PrintUsage::print_options_xml($classifieroptions->{'args'});
    }

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

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


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

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


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

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

    # Find the length of the longest option string of this classifier
    local $classifierargs = $classifieroptions->{'args'};
    if (defined($classifierargs)) {
    local $longest = &PrintUsage::find_longest_option_string($classifierargs);
    if ($longest > $maxoffset) {
        $maxoffset = $longest;
    }
    }

    # Recurse up the classifier hierarchy
    $maxoffset = $self->determine_description_offset($maxoffset);
    $self->{'option_list'} = \@optionlist;
    return $maxoffset;
}


sub print_classifier_usage
{
    local $self = shift(@_);
    local $descoffset = shift(@_);
    local $isleafclass = shift(@_);

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

    local $classifiername = $classifieroptions->{'name'};
    local $classifierargs = $classifieroptions->{'args'};
    local $classifierdesc = $classifieroptions->{'desc'};
    # Produce the usage information using the data structure above
    if ($isleafclass) {
    if (defined($classifierdesc)) {
        &gsprintf(STDERR, "$classifierdesc\n\n");
    }
    &gsprintf(STDERR, " {common.usage}: classify $classifiername [{common.options}]\n\n");
    
    }

    # Display the classifier options, if there are some
    if (defined($classifierargs)) {
    # 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", $classifiername);
    }

    # Display the classifier options
    &PrintUsage::print_options_txt($classifierargs, $optiondescoffset);
    }

    # Recurse up the classifier hierarchy
    $self->print_classifier_usage($descoffset, 0);
    $self->{'option_list'} = \@optionlist;
}


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

    my $self = {};

    $self->{'outhandle'} = STDERR;
    
    $self->{'option_list'} = [ $options ];
    my $gsdlinfo;

    # general options available to all classifiers
    if (!parsargv::parse(\@_,
             q^builddir/.*/^, \$self->{'builddir'},
             q^outhandle/.*/STDERR^, \$self->{'outhandle'},
             q^verbosity/\d/2^, \$self->{'verbosity'},
             q^ignore_namespace^, \$self->{'ignore_namespace'},
             q^gsdlinfo^, \$gsdlinfo,
             "allow_extra_options")) {

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

    if ($gsdlinfo) {
    # created from classinfo.pl - set this so subclasses don't need to 
    # parse the arguments
    $self->{'info_only'} = 1;
    }
    return bless $self, $class;
}

sub init {
    my $self = shift (@_);
}

sub classify {
    my $self = shift (@_);
    my ($doc_obj) = @_;

    my $outhandle = $self->{'outhandle'};
    &gsprintf($outhandle, "BasClass::classify {common.must_be_implemented}\n");
}

sub get_classify_info {
    my $self = shift (@_);

    my $outhandle = $self->{'outhandle'};
    &gsprintf($outhandle, "BasClass::get_classify_info {common.must_be_implemented}\n");
}

# all classifiers do something like this, but all slightly different
# so put it here so they can all share it.
sub format_metadata_for_sorting {

    my $self = shift (@_);

    my ($metaname, $metavalue, $doc_obj) = @_;
    
    if ($metaname eq "Language") {
    $metavalue = $iso639::fromiso639{$metavalue};
    return $metavalue;
    } 
    
    my $lang;
    if (defined $doc_obj) {
    $lang = $doc_obj->get_metadata_element ($doc_obj->get_top_section(), 'Language');
    }
    $lang = 'en' unless defined $lang;
    if ($lang eq 'en') {
    if ($metaname =~ /^(\w+\.)?Creator(:.*)?/) {
        &sorttools::format_string_name_english (\$metavalue);
    } else {
        &sorttools::format_string_english (\$metavalue);
    }
    }
    return $metavalue;
}


1;