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

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

    &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));

    print STDERR "<ClassInfo>\n";
    print STDERR "  <Name>$classifieroptions->{'name'}</Name>\n";
    print STDERR "  <Desc>$classifieroptions->{'desc'}</Desc>\n";
    print STDERR "  <Abstract>$classifieroptions->{'abstract'}</Abstract>\n";
    print STDERR "  <Inherits>$classifieroptions->{'inherits'}</Inherits>\n";
    print STDERR "  <Arguments>\n";
    if (defined($classifieroptions->{'args'})) {
    &PrintUsage::print_options_xml($classifieroptions->{'args'});
    }

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

    print STDERR "  </Arguments>\n";
    print 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 print_general_usage {
#      my ($plugin_name) = @_;
#      print STDERR "
#     -verbosity N    Controls the quantity of output.  
#                     Defaults to verbosity of buildcol.pl, which is usually 2.

#     (Most general classifier options are set internally by buildcol.)

#  ";
#  }

# sub print_usage {
#     print STDERR "
# This classifier has no classifier-specific options
# 
# ";
# }

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

    my $self = {};

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

    # 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'},
             "allow_extra_options")) {

    &gsprintf(STDERR, "\n{BasClas.bad_general_option}\n", $name);
    # print STDERR "\nThe $name classifier uses an incorrect general option\n";
    # print STDERR "(general options are those available to all classifiers).\n";
    # print STDERR "Check your collect.cfg configuration file.\n";
    $self->print_txt_usage("");  # Use default resource bundle
    die "\n";
    }

    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");
    # print $outhandle "BasClas::classify function must be implemented in sub-class\n";
}

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

    my $outhandle = $self->{'outhandle'};
    &gsprintf($outhandle, "BasClass::get_classify_info {common.must_be_implemented}\n");
    # print $outhandle "BasClas::get_classify_info function must be implemented in sub-class\n";
}

1;