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

Last change on this file since 9790 was 9790, checked in by kjdon, 19 years ago

fixed a bug in check_contents to do with remove_empty_classifications
  • Property svn:keywords set to Author Date Id Revision
File size: 8.7 KB
Line 
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
26# functions to handle classifiers
27
28package classify;
29
30require util;
31require AllList;
32use gsprintf;
33
34
35sub gsprintf
36{
37 return &gsprintf::gsprintf(@_);
38}
39
40
41$next_classify_num = 1;
42sub load_classifier_for_info {
43 my ($classifier) = shift @_;
44
45 # find the classifier
46 my $colclassname = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},
47 "perllib/classify",
48 "${classifier}.pm");
49 my $mainclassname = &util::filename_cat($ENV{'GSDLHOME'},
50 "perllib/classify",
51 "${classifier}.pm");
52
53 if (-e $colclassname) { require $colclassname; }
54 elsif (-e $mainclassname) { require $mainclassname; }
55 else {
56 &gsprintf(STDERR, "{classify.could_not_find_classifier}\n", $classifier) && die "\n";
57 }
58 my ($classobj);
59 my $options = "-gsdlinfo";
60
61 eval ("\$classobj = new \$classifier($options)");
62 die "$@" if $@;
63
64 return $classobj;
65}
66
67sub load_classifiers {
68 my ($classify_list, $build_dir, $outhandle) = @_;
69 my @classify_objects = ();
70 my $classify_number = 1;
71
72 foreach $classifyoption (@$classify_list) {
73
74 # get the classifier name
75 my $classname = shift @$classifyoption;
76 next unless defined $classname;
77
78 # find the classifier
79 my $colclassname = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},"perllib/classify",
80 "${classname}.pm");
81 my $mainclassname = &util::filename_cat($ENV{'GSDLHOME'},"perllib/classify",
82 "${classname}.pm");
83
84 if (-e $colclassname) { require $colclassname; }
85 elsif (-e $mainclassname) { require $mainclassname; }
86 else { &gsprintf(STDERR, "{classify.could_not_find_classifier}\n", $classname) && die "\n";
87 # die "ERROR - couldn't find classifier \"$classname\"\n";
88 }
89
90 # create the classify object
91 my ($classobj);
92
93 my @newoptions;
94
95 # do these first so they can be overriden by user supplied options
96 push @newoptions, "-builddir", "$build_dir" if ($build_dir);
97 push @newoptions, "-outhandle", "$outhandle" if ($outhandle);
98 push @newoptions, "-verbosity", "2";
99
100 # backwards compatability hack: if the classifier options are
101 # in "x=y" format, convert them to parsearg ("-x y") format.
102 my ($opt, $key, $value);
103 foreach $opt (@$classifyoption) {
104 if ($opt =~ /^(\w+)=(.*)$/) {
105 push @newoptions, "-$1", $2;
106 } else {
107 push @newoptions, $opt;
108 }
109 }
110
111 map { $_ = "\"$_\""; } @newoptions;
112 my $options .= join (",", @newoptions);
113
114 eval ("\$classobj = new \$classname($options)");
115 die "$@" if $@;
116
117 $classobj->set_number($classify_number);
118 $classify_number ++;
119
120 # add this object to the list
121 push (@classify_objects, $classobj);
122 }
123
124 my ($classobj);
125 eval ("\$classobj = new AllList()");
126 die "$@" if $@;
127 push (@classify_objects, $classobj);
128
129 return \@classify_objects;
130}
131
132# init_classifiers resets all the classifiers and readys them to process
133# the documents.
134sub init_classifiers {
135 my ($classifiers) = @_;
136
137 foreach $classobj (@$classifiers) {
138 $classobj->init();
139 }
140}
141
142# classify_doc lets each of the classifiers classify a document
143sub classify_doc {
144 my ($classifiers, $doc_obj) = @_;
145
146 foreach $classobj (@$classifiers) {
147 my $title = $classobj->{'title'};
148 $classobj->classify($doc_obj);
149 }
150}
151
152# output_classify_info outputs all the info needed for the classification
153# to the gdbm
154sub output_classify_info {
155 my ($classifiers, $handle, $remove_empty_classifications, $gli) = @_;
156# $handle = "main::STDOUT";
157
158 $gli = 0 unless defined $gli;
159
160 # create a classification containing all the info
161 my $classifyinfo = {'classifyOID'=>'browse',
162 'contains'=>[]};
163
164 # get each of the classifications
165 foreach $classobj (@$classifiers) {
166 my $tempinfo = $classobj->get_classify_info($gli);
167 my $classID = $tempinfo->{'classifyOID'};
168
169 $tempinfo->{'classifyOID'} = "CL$next_classify_num" unless defined($tempinfo->{'classifyOID'});
170 $next_classify_num++;
171 push (@{$classifyinfo->{'contains'}}, $tempinfo);
172 }
173
174 &print_classify_info ($handle, $classifyinfo, "", $remove_empty_classifications);
175}
176
177sub print_classify_info {
178 my ($handle, $classifyinfo, $OID, $remove_empty_classifications) = @_;
179
180 $OID =~ s/^\.+//; # just for good luck
181
182 # book information is printed elsewhere
183 return if (defined ($classifyinfo->{'OID'}));
184
185 # don't want empty classifications
186 return if (&check_contents ($classifyinfo, $remove_empty_classifications) == 0 && $remove_empty_classifications);
187
188 $OID = $classifyinfo->{'classifyOID'} if defined ($classifyinfo->{'classifyOID'});
189
190 my $outputtext = "[$OID]\n";
191 $outputtext .= "<doctype>classify\n";
192 $outputtext .= "<hastxt>0\n";
193 $outputtext .= "<childtype>$classifyinfo->{'childtype'}\n"
194 if defined $classifyinfo->{'childtype'};
195 $outputtext .= "<Title>$classifyinfo->{'Title'}\n"
196 if defined $classifyinfo->{'Title'};
197 $outputtext .= "<numleafdocs>$classifyinfo->{'numleafdocs'}\n"
198 if defined $classifyinfo->{'numleafdocs'};
199 $outputtext .= "<thistype>$classifyinfo->{'thistype'}\n"
200 if defined $classifyinfo->{'thistype'};
201 $outputtext .= "<parameters>$classifyinfo->{'parameters'}\n"
202 if defined $classifyinfo->{'parameters'};
203 $outputtext .= "<supportsmemberof>$classifyinfo->{'supportsmemberof'}\n"
204 if defined $classifyinfo->{'supportsmemberof'};
205
206 my $contains_text = "<contains>";
207 my $mdoffset_text = "<mdoffset>";
208
209 my $next_subOID = 1;
210 my $first = 1;
211 foreach $tempinfo (@{$classifyinfo->{'contains'}}) {
212 # empty contents were made undefined by clean_contents()
213 next unless defined $tempinfo;
214
215 if (!defined ($tempinfo->{'classifyOID'}) ||
216 $tempinfo->{'classifyOID'} ne "oai") {
217 $contains_text .= ";" unless $first;
218 }
219 $mdoffset_text .= ";" unless $first;
220 $first = 0;
221
222 if (defined ($tempinfo->{'classifyOID'})) {
223 if ($tempinfo->{'classifyOID'} ne "oai") {
224 $contains_text .= $tempinfo->{'classifyOID'};
225 }
226 &print_classify_info ($handle, $tempinfo, $tempinfo->{'classifyOID'},
227 $remove_empty_classifications);
228 } elsif (defined ($tempinfo->{'OID'})) {
229 $contains_text .= $tempinfo->{'OID'};
230 $mdoffset_text .= $tempinfo->{'offset'}
231 if (defined ($tempinfo->{'offset'}))
232 # note: we don't want to print the contents of the books
233 } else {
234
235 # Supress having top-level node in Collage classifier
236 # so no bookshelf icon appears, top-level, along with the
237 # applet
238
239 if (!defined ($tempinfo->{'Title'}) || $tempinfo->{'Title'} ne "Collage") {
240 $contains_text .= "\".$next_subOID";
241 }
242
243 &print_classify_info ($handle, $tempinfo, "$OID.$next_subOID",
244 $remove_empty_classifications);
245 $next_subOID++;
246 }
247 }
248
249 $outputtext .= "$contains_text\n";
250 $outputtext .= "<mdtype>$classifyinfo->{'mdtype'}\n"
251 if defined $classifyinfo->{'mdtype'};
252 $outputtext .= "$mdoffset_text\n"
253 if ($mdoffset_text !~ m/^<mdoffset>;+$/);
254
255 $outputtext .= '-' x 70 . "\n";
256
257 print $handle $outputtext;
258
259}
260
261sub check_contents {
262 my ($classifyinfo,$remove_empty_classifications) = @_;
263 $remove_empty_classifications = 0 unless ($remove_empty_classifications);
264 my $num_leaf_docs = 0;
265 my $sub_num_leaf_docs = 0;
266
267 return $classifyinfo->{'numleafdocs'} if (defined $classifyinfo->{'numleafdocs'});
268
269 foreach $content (@{$classifyinfo->{'contains'}}) {
270 if (defined $content->{'OID'}) {
271 # found a book
272 $num_leaf_docs ++;
273 } elsif (($sub_num_leaf_docs = &check_contents ($content,$remove_empty_classifications)) > 0) {
274 # there's a book somewhere below
275 $num_leaf_docs += $sub_num_leaf_docs;
276 } else {
277 if ($remove_empty_classifications){
278 # section contains no books so we want to remove
279 # it from its parents contents
280 $content = undef;
281 }
282 }
283 }
284
285 $classifyinfo->{'numleafdocs'} = $num_leaf_docs;
286 return $num_leaf_docs;
287}
288
2891;
Note: See TracBrowser for help on using the repository browser.