source: trunk/gsdl/perllib/classify.pm@ 1260

Last change on this file since 1260 was 831, checked in by davidb, 25 years ago

added support for multiple metavales for a metadata type

  • Property svn:keywords set to Author Date Id Revision
File size: 6.0 KB
RevLine 
[537]1###########################################################################
2#
3# classify.pm --
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 1999 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
[214]26# functions to handle classifiers
27
28package classify;
29
30require util;
31
32
[315]33$next_classify_num = 1;
[214]34
[811]35sub load_classifiers {
36 my ($classify_list) = @_;
37 my @classify_objects = ();
38
39 foreach $classifyoption (@$classify_list) {
[214]40
[811]41 # get the classifier name
42 my $classname = shift @$classifyoption;
43 next unless defined $classname;
[214]44
[811]45 # find the classifier
46 my $colclassname = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},"perllib/classify",
47 "${classname}.pm");
48 my $mainclassname = &util::filename_cat($ENV{'GSDLHOME'},"perllib/classify",
49 "${classname}.pm");
[214]50
[811]51 if (-e $colclassname) { require $colclassname; }
52 elsif (-e $mainclassname) { require $mainclassname; }
53 else { die "ERROR - couldn't find classifier \"$classname\"\n"; }
[214]54
[811]55 # create the classify object
56 my ($classobj);
57 map { $_ = "\"$_\""; } @$classifyoption;
58 my $options = join (",", @$classifyoption);
59 eval ("\$classobj = new \$classname($options)");
60 die "$@" if $@;
61
62 # add this object to the list
63 push (@classify_objects, $classobj);
64 }
65
66 return \@classify_objects;
[214]67}
68
69# init_classifiers resets all the classifiers and readys them to process
[315]70# the documents.
[214]71sub init_classifiers {
72 my ($classifiers) = @_;
73
74 foreach $classobj (@$classifiers) {
75 $classobj->init();
76 }
77}
78
79# classify_doc lets each of the classifiers classify a document
80sub classify_doc {
81 my ($classifiers, $doc_obj) = @_;
82
83 foreach $classobj (@$classifiers) {
84 $classobj->classify($doc_obj);
85 }
86}
87
88# output_classify_info outputs all the info needed for the classification
89# to the gdbm
90sub output_classify_info {
[315]91 my ($classifiers, $handle, $allclassifications) = @_;
[214]92# $handle = "main::STDOUT";
93
[315]94 # create a classification containing all the info
95 my $classifyinfo = {'classifyOID'=>'browse',
96 'contains'=>[]};
97
98 # get each of the classifications
[214]99 foreach $classobj (@$classifiers) {
[315]100 my $tempinfo = $classobj->get_classify_info();
101 $tempinfo->{'classifyOID'} = "CL$next_classify_num";
102 $next_classify_num++;
103 push (@{$classifyinfo->{'contains'}}, $tempinfo);
[214]104 }
105
[315]106 &print_classify_info ($handle, $classifyinfo, "", $allclassifications);
[214]107}
108
[315]109sub print_classify_info {
110 my ($handle, $classifyinfo, $OID, $allclassifications) = @_;
[831]111
[315]112 $OID =~ s/^\.+//; # just for good luck
[214]113
[315]114 # book information is printed elsewhere
115 return if (defined ($classifyinfo->{'OID'}));
116
117 # don't want empty classifications
[637]118 if ($allclassifications || &check_contents ($classifyinfo) > 0) {
[315]119
120 $OID = $classifyinfo->{'classifyOID'} if defined ($classifyinfo->{'classifyOID'});
121
122 my $outputtext = "[$OID]\n";
123 $outputtext .= "<doctype>classify\n";
124 $outputtext .= "<hastxt>0\n";
[652]125 $outputtext .= "<childtype>$classifyinfo->{'childtype'}\n"
126 if defined $classifyinfo->{'childtype'};
127 $outputtext .= "<Title>$classifyinfo->{'Title'}\n"
128 if defined $classifyinfo->{'Title'};
129 $outputtext .= "<numleafdocs>$classifyinfo->{'numleafdocs'}\n"
130 if defined $classifyinfo->{'numleafdocs'};
131 $outputtext .= "<thistype>$classifyinfo->{'thistype'}\n"
132 if defined $classifyinfo->{'thistype'};
133
[315]134
[831]135 my $contains_text = "<contains>";
136 my $mdoffset_text = "<mdoffset>";
[315]137
138 my $next_subOID = 1;
139 my $first = 1;
140 foreach $tempinfo (@{$classifyinfo->{'contains'}}) {
141 # empty contents were made undefined by clean_contents()
142 next unless defined $tempinfo;
143
[831]144 $contains_text .= ";" unless $first;
145 $mdoffset_text .= ";" unless $first;
[315]146 $first = 0;
147
148 if (defined ($tempinfo->{'classifyOID'})) {
[831]149 $contains_text .= $tempinfo->{'classifyOID'};
[315]150 &print_classify_info ($handle, $tempinfo, $tempinfo->{'classifyOID'},
151 $allclassifications);
152 } elsif (defined ($tempinfo->{'OID'})) {
[831]153 $contains_text .= $tempinfo->{'OID'};
154 $mdoffset_text .= $tempinfo->{'offset'}
155 if (defined ($tempinfo->{'offset'}))
[315]156 # note: we don't want to print the contents of the books
157 } else {
[831]158 $contains_text .= "\".$next_subOID";
[315]159 &print_classify_info ($handle, $tempinfo, "$OID.$next_subOID",
160 $allclassifications);
161 $next_subOID++;
162 }
163 }
[831]164
165 $outputtext .= "$contains_text\n";
166 $outputtext .= "<mdtype>$classifyinfo->{'mdtype'}\n"
167 if defined $classifyinfo->{'mdtype'};
168 $outputtext .= "$mdoffset_text\n"
169 if ($mdoffset_text !~ m/^<mdoffset>;+$/);
170
[315]171 $outputtext .= '-' x 70 . "\n";
172
173 print $handle $outputtext;
174 }
175}
176
[637]177sub check_contents {
[315]178 my ($classifyinfo) = @_;
[637]179 my $num_leaf_docs = 0;
180 my $sub_num_leaf_docs = 0;
[315]181
[637]182 return $classifyinfo->{'numleafdocs'} if (defined $classifyinfo->{'numleafdocs'});
183
[315]184 foreach $content (@{$classifyinfo->{'contains'}}) {
185 if (defined $content->{'OID'}) {
186 # found a book
[637]187 $num_leaf_docs ++;
188 } elsif (($sub_num_leaf_docs = &check_contents ($content)) > 0) {
[315]189 # there's a book somewhere below
[637]190 $num_leaf_docs += $sub_num_leaf_docs;
[315]191 } else {
192 # section contains no books so we want to remove
193 # it from its parents contents
194 $content = undef;
195 }
196 }
[637]197
198 $classifyinfo->{'numleafdocs'} = $num_leaf_docs;
199 return $num_leaf_docs;
[315]200}
201
[214]2021;
Note: See TracBrowser for help on using the repository browser.