source: trunk/niupepa/perllib/classify/NPepaList.pm@ 13312

###########################################################################
#
# NpepaList.pm -- website 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.
#
###########################################################################

# There should probably be a general classifier to do this kind of stuff

package NPepaList;

use BasClas;

use strict;
no strict 'refs'; # allow filehandles to be variables and viceversa

sub BEGIN {
    @NPepaList::ISA = ('BasClas');
}

my $arguments;

my $options = { 'name'     => "NPepaList",
        'desc'     => "Classifies Niupepa documents by series",
        'abstract' => "no",
        'inherits' => "yes" };

sub new {
    my ($class) = shift (@_);
    
    my ($classifierslist,$inputargs,$hashArgOptLists) = @_;
    push(@$classifierslist, $class);

    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};

    my $self = new BasClas($classifierslist, $inputargs, $hashArgOptLists);

    if ($self->{'info_only'}) {
    # don't worry about any options etc
    return bless $self, $class;
    }

    $self->{'list'} = {};
    $self->{'metaname'} = "Series";
    $self->{'sortname'} = "Date";
    
    return bless $self, $class;

}

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

    $self->{'list'} = {};
}


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

    my $doc_OID = $doc_obj->get_OID();

    # want to ignore abstracts
    my $doctype = $doc_obj->get_metadata_element($doc_obj->get_top_section(), 'doctype');
    return if (defined $doctype && $doctype eq 'Description');

    my $date = $doc_obj->get_metadata_element($doc_obj->get_top_section(),
                          $self->{'sortname'});
    # commentaries have no date but we want them to sort to the top
    $date = '00000000' unless defined $date;

    my $series = $doc_obj->get_metadata_element ($doc_obj->get_top_section(),
                         $self->{'metaname'});

    if (defined $series) {
    if (!defined $self->{'list'}->{$series}) {
        $self->{'list'}->{$series} = {};
    }
    if (defined $self->{'list'}->{$series}->{$doc_OID}) {
        print STDERR "WARNING: NPepaList::classify called multiple times for $doc_OID\n";
    } 
    $self->{'list'}->{$series}->{$doc_OID} = $date;
    } else {
    print STDERR "WARNING: NpepaList::classify $doc_OID has no Series metadata\n";
    }
}


sub bydate {
    # series names are expected to end with their date
    my ($adate) = $a =~ /([\d-]+)$/;
    my ($bdate) = $b =~ /([\d-]+)$/;
    $adate =~ s/-\d+$//;
    $bdate =~ s/-\d+$//;
    return $adate <=> $bdate;
}

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

    my $classifyinfo = $self->get_entry ('Series', 'VList', 'Invisible');

    foreach my $series (sort bydate keys %{$self->{'list'}}) {
    my $cinfo = $self->get_entry ($series, 'VList');
    foreach my $OID (sort {$self->{'list'}->{$series}->{$a} 
                cmp $self->{'list'}->{$series}->{$b};} keys %{$self->{'list'}->{$series}}) {
        push (@{$cinfo->{'contains'}}, {'OID'=>$OID});
    }
    push (@{$classifyinfo->{'contains'}}, $cinfo);
    }

    return $classifyinfo;
}

sub get_entry {
    my $self = shift (@_);
    my ($title, $childtype, $thistype) = @_;
    
    # organise into classification structure
    my %classifyinfo = ('childtype'=>$childtype,
            'Title'=>$title,
            'contains'=>[]);
    $classifyinfo{'thistype'} = $thistype 
    if defined $thistype && $thistype =~ /\w/;

    return \%classifyinfo;
}

sub set_number{
    return;
}

1;