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

Last change on this file since 831 was 831, checked in by davidb, 24 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
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 foreach $classifyoption (@$classify_list) {
40
41 # get the classifier name
42 my $classname = shift @$classifyoption;
43 next unless defined $classname;
44
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");
50
51 if (-e $colclassname) { require $colclassname; }
52 elsif (-e $mainclassname) { require $mainclassname; }
53 else { die "ERROR - couldn't find classifier \"$classname\"\n"; }
54
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;
67}
68
69# init_classifiers resets all the classifiers and readys them to process
70# the documents.
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 {
91 my ($classifiers, $handle, $allclassifications) = @_;
92# $handle = "main::STDOUT";
93
94 # create a classification containing all the info
95 my $classifyinfo = {'classifyOID'=>'browse',
96 'contains'=>[]};
97
98 # get each of the classifications
99 foreach $classobj (@$classifiers) {
100 my $tempinfo = $classobj->get_classify_info();
101 $tempinfo->{'classifyOID'} = "CL$next_classify_num";
102 $next_classify_num++;
103 push (@{$classifyinfo->{'contains'}}, $tempinfo);
104 }
105
106 &print_classify_info ($handle, $classifyinfo, "", $allclassifications);
107}
108
109sub print_classify_info {
110 my ($handle, $classifyinfo, $OID, $allclassifications) = @_;
111
112 $OID =~ s/^\.+//; # just for good luck
113
114 # book information is printed elsewhere
115 return if (defined ($classifyinfo->{'OID'}));
116
117 # don't want empty classifications
118 if ($allclassifications || &check_contents ($classifyinfo) > 0) {
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";
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
134
135 my $contains_text = "<contains>";
136 my $mdoffset_text = "<mdoffset>";
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
144 $contains_text .= ";" unless $first;
145 $mdoffset_text .= ";" unless $first;
146 $first = 0;
147
148 if (defined ($tempinfo->{'classifyOID'})) {
149 $contains_text .= $tempinfo->{'classifyOID'};
150 &print_classify_info ($handle, $tempinfo, $tempinfo->{'classifyOID'},
151 $allclassifications);
152 } elsif (defined ($tempinfo->{'OID'})) {
153 $contains_text .= $tempinfo->{'OID'};
154 $mdoffset_text .= $tempinfo->{'offset'}
155 if (defined ($tempinfo->{'offset'}))
156 # note: we don't want to print the contents of the books
157 } else {
158 $contains_text .= "\".$next_subOID";
159 &print_classify_info ($handle, $tempinfo, "$OID.$next_subOID",
160 $allclassifications);
161 $next_subOID++;
162 }
163 }
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
171 $outputtext .= '-' x 70 . "\n";
172
173 print $handle $outputtext;
174 }
175}
176
177sub check_contents {
178 my ($classifyinfo) = @_;
179 my $num_leaf_docs = 0;
180 my $sub_num_leaf_docs = 0;
181
182 return $classifyinfo->{'numleafdocs'} if (defined $classifyinfo->{'numleafdocs'});
183
184 foreach $content (@{$classifyinfo->{'contains'}}) {
185 if (defined $content->{'OID'}) {
186 # found a book
187 $num_leaf_docs ++;
188 } elsif (($sub_num_leaf_docs = &check_contents ($content)) > 0) {
189 # there's a book somewhere below
190 $num_leaf_docs += $sub_num_leaf_docs;
191 } else {
192 # section contains no books so we want to remove
193 # it from its parents contents
194 $content = undef;
195 }
196 }
197
198 $classifyinfo->{'numleafdocs'} = $num_leaf_docs;
199 return $num_leaf_docs;
200}
201
2021;
Note: See TracBrowser for help on using the repository browser.