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

Last change on this file since 1483 was 1483, checked in by sjboddie, 24 years ago

added -out option to classifiers

  • Property svn:keywords set to Author Date Id Revision
File size: 6.1 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;
31
32
33$next_classify_num = 1;
34
35sub load_classifiers {
36 my ($classify_list) = @_;
37 my @classify_objects = ();
38
39 my $outhandle = pop (@_);
40
41 foreach $classifyoption (@$classify_list) {
42
43 # get the classifier name
44 my $classname = shift @$classifyoption;
45 next unless defined $classname;
46
47 # find the classifier
48 my $colclassname = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},"perllib/classify",
49 "${classname}.pm");
50 my $mainclassname = &util::filename_cat($ENV{'GSDLHOME'},"perllib/classify",
51 "${classname}.pm");
52
53 if (-e $colclassname) { require $colclassname; }
54 elsif (-e $mainclassname) { require $mainclassname; }
55 else { die "ERROR - couldn't find classifier \"$classname\"\n"; }
56
57 # create the classify object
58 my ($classobj);
59 map { $_ = "\"$_\""; } @$classifyoption;
60 my $options = join (",", @$classifyoption);
61 eval ("\$classobj = new \$classname($options, $outhandle)");
62 die "$@" if $@;
63
64 # add this object to the list
65 push (@classify_objects, $classobj);
66 }
67
68 return \@classify_objects;
69}
70
71# init_classifiers resets all the classifiers and readys them to process
72# the documents.
73sub init_classifiers {
74 my ($classifiers) = @_;
75
76 foreach $classobj (@$classifiers) {
77 $classobj->init();
78 }
79}
80
81# classify_doc lets each of the classifiers classify a document
82sub classify_doc {
83 my ($classifiers, $doc_obj) = @_;
84
85 foreach $classobj (@$classifiers) {
86 $classobj->classify($doc_obj);
87 }
88}
89
90# output_classify_info outputs all the info needed for the classification
91# to the gdbm
92sub output_classify_info {
93 my ($classifiers, $handle, $allclassifications) = @_;
94# $handle = "main::STDOUT";
95
96 # create a classification containing all the info
97 my $classifyinfo = {'classifyOID'=>'browse',
98 'contains'=>[]};
99
100 # get each of the classifications
101 foreach $classobj (@$classifiers) {
102 my $tempinfo = $classobj->get_classify_info();
103 $tempinfo->{'classifyOID'} = "CL$next_classify_num";
104 $next_classify_num++;
105 push (@{$classifyinfo->{'contains'}}, $tempinfo);
106 }
107
108 &print_classify_info ($handle, $classifyinfo, "", $allclassifications);
109}
110
111sub print_classify_info {
112 my ($handle, $classifyinfo, $OID, $allclassifications) = @_;
113
114 $OID =~ s/^\.+//; # just for good luck
115
116 # book information is printed elsewhere
117 return if (defined ($classifyinfo->{'OID'}));
118
119 # don't want empty classifications
120 if ($allclassifications || &check_contents ($classifyinfo) > 0) {
121
122 $OID = $classifyinfo->{'classifyOID'} if defined ($classifyinfo->{'classifyOID'});
123
124 my $outputtext = "[$OID]\n";
125 $outputtext .= "<doctype>classify\n";
126 $outputtext .= "<hastxt>0\n";
127 $outputtext .= "<childtype>$classifyinfo->{'childtype'}\n"
128 if defined $classifyinfo->{'childtype'};
129 $outputtext .= "<Title>$classifyinfo->{'Title'}\n"
130 if defined $classifyinfo->{'Title'};
131 $outputtext .= "<numleafdocs>$classifyinfo->{'numleafdocs'}\n"
132 if defined $classifyinfo->{'numleafdocs'};
133 $outputtext .= "<thistype>$classifyinfo->{'thistype'}\n"
134 if defined $classifyinfo->{'thistype'};
135
136
137 my $contains_text = "<contains>";
138 my $mdoffset_text = "<mdoffset>";
139
140 my $next_subOID = 1;
141 my $first = 1;
142 foreach $tempinfo (@{$classifyinfo->{'contains'}}) {
143 # empty contents were made undefined by clean_contents()
144 next unless defined $tempinfo;
145
146 $contains_text .= ";" unless $first;
147 $mdoffset_text .= ";" unless $first;
148 $first = 0;
149
150 if (defined ($tempinfo->{'classifyOID'})) {
151 $contains_text .= $tempinfo->{'classifyOID'};
152 &print_classify_info ($handle, $tempinfo, $tempinfo->{'classifyOID'},
153 $allclassifications);
154 } elsif (defined ($tempinfo->{'OID'})) {
155 $contains_text .= $tempinfo->{'OID'};
156 $mdoffset_text .= $tempinfo->{'offset'}
157 if (defined ($tempinfo->{'offset'}))
158 # note: we don't want to print the contents of the books
159 } else {
160 $contains_text .= "\".$next_subOID";
161 &print_classify_info ($handle, $tempinfo, "$OID.$next_subOID",
162 $allclassifications);
163 $next_subOID++;
164 }
165 }
166
167 $outputtext .= "$contains_text\n";
168 $outputtext .= "<mdtype>$classifyinfo->{'mdtype'}\n"
169 if defined $classifyinfo->{'mdtype'};
170 $outputtext .= "$mdoffset_text\n"
171 if ($mdoffset_text !~ m/^<mdoffset>;+$/);
172
173 $outputtext .= '-' x 70 . "\n";
174
175 print $handle $outputtext;
176 }
177}
178
179sub check_contents {
180 my ($classifyinfo) = @_;
181 my $num_leaf_docs = 0;
182 my $sub_num_leaf_docs = 0;
183
184 return $classifyinfo->{'numleafdocs'} if (defined $classifyinfo->{'numleafdocs'});
185
186 foreach $content (@{$classifyinfo->{'contains'}}) {
187 if (defined $content->{'OID'}) {
188 # found a book
189 $num_leaf_docs ++;
190 } elsif (($sub_num_leaf_docs = &check_contents ($content)) > 0) {
191 # there's a book somewhere below
192 $num_leaf_docs += $sub_num_leaf_docs;
193 } else {
194 # section contains no books so we want to remove
195 # it from its parents contents
196 $content = undef;
197 }
198 }
199
200 $classifyinfo->{'numleafdocs'} = $num_leaf_docs;
201 return $num_leaf_docs;
202}
203
2041;
Note: See TracBrowser for help on using the repository browser.