########################################################################### # # 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; require AllList; use gsprintf; sub gsprintf { return &gsprintf::gsprintf(@_); } $next_classify_num = 1; sub load_classifier_for_info { my ($classifier) = shift @_; # find the classifier my $colclassname = &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, "perllib/classify", "${classifier}.pm"); my $mainclassname = &util::filename_cat($ENV{'GSDLHOME'}, "perllib/classify", "${classifier}.pm"); if (-e $colclassname) { require $colclassname; } elsif (-e $mainclassname) { require $mainclassname; } else { &gsprintf(STDERR, "{classify.could_not_find_classifier}\n", $classifier) && die "\n"; } my ($classobj); my $options = "-gsdlinfo"; eval ("\$classobj = new \$classifier([],[$options])"); die "$@" if $@; return $classobj; } sub load_classifiers { my ($classify_list, $build_dir, $outhandle) = @_; my @classify_objects = (); my $classify_number = 1; 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 { &gsprintf(STDERR, "{classify.could_not_find_classifier}\n", $classname) && die "\n"; # die "ERROR - couldn't find classifier \"$classname\"\n"; } # create the classify object my ($classobj); my @newoptions; # do these first so they can be overriden by user supplied options push @newoptions, "-builddir", "$build_dir" if ($build_dir); push @newoptions, "-outhandle", "$outhandle" if ($outhandle); push @newoptions, "-verbosity", "2"; # backwards compatability hack: if the classifier options are # in "x=y" format, convert them to parsearg ("-x y") format. my ($opt, $key, $value); foreach $opt (@$classifyoption) { if ($opt =~ /^(\w+)=(.*)$/) { push @newoptions, "-$1", $2; } else { push @newoptions, $opt; } } map { $_ = "\"$_\""; } @newoptions; my $options .= join (",", @newoptions); eval ("\$classobj = new \$classname([],[$options])"); die "$@" if $@; $classobj->set_number($classify_number); $classify_number ++; # add this object to the list push (@classify_objects, $classobj); } my ($classobj); eval ("\$classobj = new AllList()"); die "$@" if $@; 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) { my $title = $classobj->{'title'}; $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, $remove_empty_classifications, $gli) = @_; # $handle = "main::STDOUT"; $gli = 0 unless defined $gli; # 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($gli); my $classID = $tempinfo->{'classifyOID'}; $tempinfo->{'classifyOID'} = "CL$next_classify_num" unless defined($tempinfo->{'classifyOID'}); $next_classify_num++; push (@{$classifyinfo->{'contains'}}, $tempinfo); } &print_classify_info ($handle, $classifyinfo, "", $remove_empty_classifications); } sub print_classify_info { my ($handle, $classifyinfo, $OID, $remove_empty_classifications) = @_; $OID =~ s/^\.+//; # just for good luck # book information is printed elsewhere return if (defined ($classifyinfo->{'OID'})); # don't want empty classifications return if (&check_contents ($classifyinfo, $remove_empty_classifications) == 0 && $remove_empty_classifications); $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'}; $outputtext .= "<parameters>$classifyinfo->{'parameters'}\n" if defined $classifyinfo->{'parameters'}; $outputtext .= "<supportsmemberof>$classifyinfo->{'supportsmemberof'}\n" if defined $classifyinfo->{'supportsmemberof'}; 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; if (!defined ($tempinfo->{'classifyOID'}) || $tempinfo->{'classifyOID'} ne "oai") { $contains_text .= ";" unless $first; } $mdoffset_text .= ";" unless $first; $first = 0; if (defined ($tempinfo->{'classifyOID'})) { if ($tempinfo->{'classifyOID'} ne "oai") { $contains_text .= $tempinfo->{'classifyOID'}; } &print_classify_info ($handle, $tempinfo, $tempinfo->{'classifyOID'}, $remove_empty_classifications); } 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 { # Supress having top-level node in Collage classifier # so no bookshelf icon appears, top-level, along with the # applet if (!defined ($tempinfo->{'Title'}) || $tempinfo->{'Title'} ne "Collage") { $contains_text .= "\".$next_subOID"; } &print_classify_info ($handle, $tempinfo, "$OID.$next_subOID", $remove_empty_classifications); $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,$remove_empty_classifications) = @_; $remove_empty_classifications = 0 unless ($remove_empty_classifications); 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,$remove_empty_classifications)) > 0) { # there's a book somewhere below $num_leaf_docs += $sub_num_leaf_docs; } else { if ($remove_empty_classifications){ # 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;