########################################################################### # # classify.pm -- # 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. # ########################################################################### # functions to handle classifiers package classify; require util; $next_classify_num = 1; sub load_classifiers { my ($classify_list) = @_; my @classify_objects = (); foreach $classifyoption (@$classify_list) { # get the classifier name my $classname = shift @$classifyoption; next unless defined $classname; # find the classifier my $colclassname = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},"perllib/classify", "${classname}.pm"); my $mainclassname = &util::filename_cat($ENV{'GSDLHOME'},"perllib/classify", "${classname}.pm"); if (-e $colclassname) { require $colclassname; } elsif (-e $mainclassname) { require $mainclassname; } else { die "ERROR - couldn't find classifier \"$classname\"\n"; } # create the classify object my ($classobj); map { $_ = "\"$_\""; } @$classifyoption; my $options = join (",", @$classifyoption); eval ("\$classobj = new \$classname($options)"); die "$@" if $@; # add this object to the list push (@classify_objects, $classobj); } return \@classify_objects; } # init_classifiers resets all the classifiers and readys them to process # the documents. sub init_classifiers { my ($classifiers) = @_; foreach $classobj (@$classifiers) { $classobj->init(); } } # classify_doc lets each of the classifiers classify a document sub classify_doc { my ($classifiers, $doc_obj) = @_; foreach $classobj (@$classifiers) { $classobj->classify($doc_obj); } } # output_classify_info outputs all the info needed for the classification # to the gdbm sub output_classify_info { my ($classifiers, $handle, $allclassifications) = @_; # $handle = "main::STDOUT"; # create a classification containing all the info my $classifyinfo = {'classifyOID'=>'browse', 'contains'=>[]}; # get each of the classifications foreach $classobj (@$classifiers) { my $tempinfo = $classobj->get_classify_info(); $tempinfo->{'classifyOID'} = "CL$next_classify_num"; $next_classify_num++; push (@{$classifyinfo->{'contains'}}, $tempinfo); } &print_classify_info ($handle, $classifyinfo, "", $allclassifications); } sub print_classify_info { my ($handle, $classifyinfo, $OID, $allclassifications) = @_; $OID =~ s/^\.+//; # just for good luck # book information is printed elsewhere return if (defined ($classifyinfo->{'OID'})); # don't want empty classifications if ($allclassifications || &check_contents ($classifyinfo) > 0) { $OID = $classifyinfo->{'classifyOID'} if defined ($classifyinfo->{'classifyOID'}); my $outputtext = "[$OID]\n"; $outputtext .= "classify\n"; $outputtext .= "0\n"; $outputtext .= "$classifyinfo->{'childtype'}\n" if defined $classifyinfo->{'childtype'}; $outputtext .= "$classifyinfo->{'Title'}\n" if defined $classifyinfo->{'Title'}; $outputtext .= "<numleafdocs>$classifyinfo->{'numleafdocs'}\n" if defined $classifyinfo->{'numleafdocs'}; $outputtext .= "<thistype>$classifyinfo->{'thistype'}\n" if defined $classifyinfo->{'thistype'}; my $contains_text = "<contains>"; my $mdoffset_text = "<mdoffset>"; my $next_subOID = 1; my $first = 1; foreach $tempinfo (@{$classifyinfo->{'contains'}}) { # empty contents were made undefined by clean_contents() next unless defined $tempinfo; $contains_text .= ";" unless $first; $mdoffset_text .= ";" unless $first; $first = 0; if (defined ($tempinfo->{'classifyOID'})) { $contains_text .= $tempinfo->{'classifyOID'}; &print_classify_info ($handle, $tempinfo, $tempinfo->{'classifyOID'}, $allclassifications); } elsif (defined ($tempinfo->{'OID'})) { $contains_text .= $tempinfo->{'OID'}; $mdoffset_text .= $tempinfo->{'offset'} if (defined ($tempinfo->{'offset'})) # note: we don't want to print the contents of the books } else { $contains_text .= "\".$next_subOID"; &print_classify_info ($handle, $tempinfo, "$OID.$next_subOID", $allclassifications); $next_subOID++; } } $outputtext .= "$contains_text\n"; $outputtext .= "<mdtype>$classifyinfo->{'mdtype'}\n" if defined $classifyinfo->{'mdtype'}; $outputtext .= "$mdoffset_text\n" if ($mdoffset_text !~ m/^<mdoffset>;+$/); $outputtext .= '-' x 70 . "\n"; print $handle $outputtext; } } sub check_contents { my ($classifyinfo) = @_; my $num_leaf_docs = 0; my $sub_num_leaf_docs = 0; return $classifyinfo->{'numleafdocs'} if (defined $classifyinfo->{'numleafdocs'}); foreach $content (@{$classifyinfo->{'contains'}}) { if (defined $content->{'OID'}) { # found a book $num_leaf_docs ++; } elsif (($sub_num_leaf_docs = &check_contents ($content)) > 0) { # there's a book somewhere below $num_leaf_docs += $sub_num_leaf_docs; } else { # section contains no books so we want to remove # it from its parents contents $content = undef; } } $classifyinfo->{'numleafdocs'} = $num_leaf_docs; return $num_leaf_docs; } 1;