source: trunk/gsdl/perllib/mgppbuildproc.pm@ 965

Last change on this file since 965 was 932, checked in by kjm18, 24 years ago

new building programs for mgpp added
  • Property svn:keywords set to Author Date Id Revision
File size: 12.3 KB
Line 
1###########################################################################
2#
3# mgbuildproc.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# This document processor outputs a document
27# for mg to process
28
29
30package mgppbuildproc;
31
32use classify;
33use doc;
34use docproc;
35use util;
36
37
38BEGIN {
39 @ISA = ('docproc');
40}
41
42
43sub new {
44 my ($class, $collection, $source_dir, $build_dir, $verbosity) = @_;
45 my $self = new docproc ();
46
47 $self->{'collection'} = $collection;
48 $self->{'source_dir'} = $source_dir;
49 $self->{'build_dir'} = $build_dir;
50 $self->{'verbosity'} = $verbosity;
51 $self->{'classifiers'} = [];
52 $self->{'mode'} = "text";
53 $self->{'assocdir'} = $build_dir;
54 $self->{'dontgdbm'} = {};
55 $self->{'index'} = "text";
56 $self->{'indexexparr'} = [];
57 $self->{'output_handle'} = "STDOUT";
58 $self->{'num_docs'} = 0;
59 $self->{'num_sections'} = 0;
60 $self->{'num_bytes'} = 0;
61
62 $self->{'indexing_text'} = 0;
63
64 return bless $self, $class;
65}
66
67sub reset {
68 my $self = shift (@_);
69
70 $self->{'num_docs'} = 0;
71 $self->{'num_sections'} = 0;
72 $self->{'num_bytes'} = 0;
73}
74
75sub get_num_docs {
76 my $self = shift (@_);
77
78 return $self->{'num_docs'};
79}
80
81sub get_num_sections {
82 my $self = shift (@_);
83
84 return $self->{'num_sections'};
85}
86
87sub get_num_bytes {
88 my $self = shift (@_);
89
90 return $self->{'num_bytes'};
91}
92
93sub set_output_handle {
94 my $self = shift (@_);
95 my ($handle) = @_;
96
97 $self->{'output_handle'} = $handle;
98}
99
100sub set_mode {
101 my $self = shift (@_);
102 my ($mode) = @_;
103
104 $self->{'mode'} = $mode;
105}
106
107sub set_assocdir {
108 my $self = shift (@_);
109 my ($assocdir) = @_;
110
111 $self->{'assocdir'} = $assocdir;
112}
113
114sub set_dontgdbm {
115 my $self = shift (@_);
116 my ($dontgdbm) = @_;
117
118 $self->{'dontgdbm'} = $dontgdbm;
119}
120
121sub set_index {
122 my $self = shift (@_);
123 my ($index, $indexexparr) = @_;
124
125 $self->{'index'} = $index;
126 $self->{'indexexparr'} = $indexexparr if defined $indexexparr;
127}
128
129sub set_classifiers {
130 my $self = shift (@_);
131 my ($classifiers) = @_;
132
133 $self->{'classifiers'} = $classifiers;
134}
135
136sub set_indexing_text {
137 my $self = shift (@_);
138 my ($indexing_text) = @_;
139
140 $self->{'indexing_text'} = $indexing_text;
141}
142
143sub process {
144 my $self = shift (@_);
145 my $method = $self->{'mode'};
146
147 $self->$method(@_);
148}
149
150# use 'Paged' if document has no more than 2 levels
151# and each section at second level has a number for
152# Title metadata
153sub get_document_type {
154 my $self = shift (@_);
155 my ($doc_obj) = @_;
156
157 my $thistype = "VList";
158 my $childtype = "VList";
159 my $title;
160 my @tmp = ();
161
162 my $section = $doc_obj->get_top_section ();
163 my $first = 1;
164 while (defined $section) {
165 @tmp = split /\./, $section;
166 if (scalar(@tmp) > 1) {
167 return ($thistype, $childtype);
168 }
169 if (!$first) {
170 $title = $doc_obj->get_metadata_element ($section, "Title");
171 if (!defined $title || $title !~ /^\d+$/) {
172 return ($thistype, $childtype);
173 }
174 }
175 $first = 0;
176 $section = $doc_obj->get_next_section($section);
177 }
178 if ($doc_obj->get_text_length ($doc_obj->get_top_section())) {
179 $thistype = "Paged";
180 } else {
181 $thistype = "Invisible";
182 }
183 $childtype = "Paged";
184 return ($thistype, $childtype);
185}
186
187sub assoc_files {
188 my $self = shift (@_);
189 my ($doc_obj, $archivedir) = @_;
190 my ($afile);
191
192 foreach my $assoc_file (@{$doc_obj->get_assoc_files()}) {
193 # if assoc file contains directory structure of
194 # its own use it, otherwise use HASH... directory
195 if ($assoc_file->[1] =~ /[\/\\]/) {
196 $afile = &util::filename_cat($self->{'assocdir'}, $assoc_file->[1]);
197 } else {
198 $afile = &util::filename_cat($self->{'assocdir'}, $archivedir, $assoc_file->[1]);
199 }
200 &util::hard_link ($assoc_file->[0], $afile);
201 }
202}
203
204sub infodb {
205 my $self = shift (@_);
206 my ($doc_obj, $filename) = @_;
207 my $handle = $self->{'output_handle'};
208# $handle = "main::STDOUT";
209
210 my $doctype = $doc_obj->get_doc_type();
211
212 # only output this document if it is one to be indexed
213 return if ($doctype ne "indexed_doc");
214
215 my ($archivedir) = $filename =~ /^(.*?)(?:\/|\\)[^\/\\]*$/;
216 $archivedir = "" unless defined $archivedir;
217 $archivedir =~ s/\\/\//g;
218 $archivedir =~ s/^\/+//;
219 $archivedir =~ s/\/+$//;
220
221 $self->assoc_files ($doc_obj, $archivedir);
222
223 # this is another document
224 $self->{'num_docs'} += 1 unless ($doctype eq "classification");
225
226 # is this a paged or a hierarchical document
227 my ($thistype, $childtype) = $self->get_document_type ($doc_obj);
228
229 my $section = $doc_obj->get_top_section ();
230 my $doc_OID = $doc_obj->get_OID();
231 my $first = 1;
232 my $url = "";
233 while (defined $section) {
234 # update a few statistics
235 $self->{'num_bytes'} += $doc_obj->get_text_length ($section);
236 $self->{'num_sections'} += 1 unless ($doctype eq "classification");
237
238 # output the section name
239 if ($section eq "") { print $handle "[$doc_OID]\n"; }
240 else { print $handle "[$doc_OID.$section]\n"; }
241
242 # output the fact that this document is a document
243 #print $handle "<doctype>doc\n";
244
245 # output whether this node contains text
246 if ($doc_obj->get_text_length($section) > 0) {
247 print $handle "<hastxt>1\n";
248 } else {
249 print $handle "<hastxt>0\n";
250 }
251
252 # output all the section metadata
253 my $found_doctype = 0;
254 my $metadata = $doc_obj->get_all_metadata ($section);
255 foreach $pair (@$metadata) {
256 my ($field, $value) = (@$pair);
257
258 $found_doctype = 1 if $field eq "doctype";
259 if ($field ne "Identifier" && $field !~ /^gsdl/ &&
260 defined $value && $value ne "") {
261
262 # escape problematic stuff
263 $value =~ s/\\/\\\\/g;
264 $value =~ s/\n/\\n/g;
265 $value =~ s/\r/\\r/g;
266
267 # special case for URL metadata
268 if ($field =~ /^URL$/i) {
269 $url .= "[$value]\n";
270 if ($section eq "") {$url .= "<section>$doc_OID\n";}
271 else {$url .= "<section>$doc_OID.$section\n";}
272 $url .= '-' x 70 . "\n";
273 }
274
275 if (!defined $self->{'dontgdbm'}->{$field}) {
276 print $handle "<$field>$value\n";
277 }
278 }
279 }
280
281 # output the fact that this document is a document
282 # (unless doctype was already output as part of
283 # metadata)
284 if (!$found_doctype && !defined $self->{'dontgdbm'}->{'doctype'}) {
285 print $handle "<doctype>doc\n";
286 }
287
288
289
290 # output archivedir if at top level
291 if ($section eq $doc_obj->get_top_section()) {
292 print $handle "<archivedir>$archivedir\n";
293 }
294
295 # output document display type
296 if ($first) {
297 print $handle "<thistype>$thistype\n";
298 }
299
300 # output a list of children
301 my $children = $doc_obj->get_children ($section);
302 if (scalar(@$children) > 0) {
303 print $handle "<childtype>$childtype\n";
304 print $handle "<contains>";
305 my $firstchild = 1;
306 foreach $child (@$children) {
307 print $handle ";" unless $firstchild;
308 $firstchild = 0;
309 if ($child =~ /^.*?\.(\d+)$/) {
310 print $handle "\".$1";
311 } else {
312 print $handle "\".$child";
313 }
314# if ($child eq "") { print $handle "$doc_OID"; }
315# elsif ($section eq "") { print $handle "$doc_OID.$child"; }
316# else { print $handle "$doc_OID.$section.$child"; }
317 }
318 print $handle "\n";
319 }
320
321 # output the matching document number
322 print $handle "<docnum>$self->{'num_sections'}\n";
323
324 print $handle '-' x 70, "\n";
325
326
327 # output a database entry for the document number
328 print $handle "[$self->{'num_sections'}]\n";
329 if ($section eq "") { print $handle "<section>$doc_OID\n"; }
330 else { print $handle "<section>$doc_OID.$section\n"; }
331 print $handle '-' x 70, "\n";
332
333 # output entry for url
334 if ($url ne "") {
335 print $handle $url;
336 }
337
338 $first = 0;
339 $section = $doc_obj->get_next_section($section);
340 }
341
342 # classify this document
343 &classify::classify_doc ($self->{'classifiers'}, $doc_obj);
344
345}
346
347sub find_paragraphs {
348 $_[1] =~ s/(<p\b)/<Paragraph>$1/gi;
349}
350
351sub filter_text {
352 # $self->filter_text ($field, $new_text);
353 # don't want to do anything for this version, however,
354 # in a particular collection you might want to override
355 # this method to post-process certain fields depending on
356 # the field, or whether we are outputting it for indexing
357}
358
359sub text {
360 my $self = shift (@_);
361 my ($doc_obj) = @_;
362 my $handle = $self->{'output_handle'};
363 my $indexed_doc = 1;
364
365 # only output this document if it is one to be indexed
366 return if ($doc_obj->get_doc_type() ne "indexed_doc");
367
368 # see if this document belongs to this subcollection
369 foreach $indexexp (@{$self->{'indexexparr'}}) {
370 $indexed_doc = 0;
371 my ($field, $exp, $options) = split /\//, $indexexp;
372 if (defined ($field) && defined ($exp)) {
373 my ($bool) = $field =~ /^(.)/;
374 $field =~ s/^.// if $bool eq '!';
375 if ($field =~ /^filename$/i) {
376 $field = $doc_obj->get_source_filename();
377 } else {
378 $field = $doc_obj->get_metadata_element($doc_obj->get_top_section(), $field);
379 }
380 next unless defined $field;
381 if ($bool eq '!') {
382 if ($options =~ /^i$/i) {
383 if ($field !~ /$exp/i) {$indexed_doc = 1; last;}
384 } else {
385 if ($field !~ /$exp/) {$indexed_doc = 1; last;}
386 }
387 } else {
388 if ($options =~ /^i$/i) {
389 if ($field =~ /$exp/i) {$indexed_doc = 1; last;}
390 } else {
391 if ($field =~ /$exp/) {$indexed_doc = 1; last;}
392 }
393 }
394 }
395 }
396
397 # this is another document
398 $self->{'num_docs'} += 1;
399
400 # get the parameters for the output
401 my ($fields) = $self->{'index'};
402 #print STDERR "fields are $fields\n";
403 $fields =~ s/\ball\b/Title,Creator,text/; # add in others here
404
405 my $doc_section = 0; # just for this document
406 my $text = "<Document>\n";
407 my $text_extra = "";
408
409 # get the text for this document
410 my $section = $doc_obj->get_top_section();
411 while (defined $section) {
412 # update a few statistics
413 $doc_section++;
414 $self->{'num_sections'} += 1;
415 $text .= "<Section>\n";
416 if ($indexed_doc) {
417 $self->{'num_bytes'} += $doc_obj->get_text_length ($section);
418 foreach $field (split (/,/, $fields)) {
419 # only deal with this field if it doesn't start with top or
420 # this is the first section
421 my $real_field = $field;
422 if (!($real_field =~ s/^top//) || ($doc_section == 1)) {
423 my $new_text = "";
424 if ($real_field eq "text") {
425 #print STDERR "in text bit";
426 $new_text = "<Paragraph>";
427 $new_text .= $doc_obj->get_text ($section);
428 $self->find_paragraphs($new_text);
429 } else { # metadata field
430 if ($real_field eq "metadata") { # insert all metadata
431 #except gsdl stuff
432 #print STDERR "in metadata bit\n";
433 my $metadata = $doc_obj->get_all_metadata ($section);
434 foreach $pair (@$metadata) {
435 my ($mfield, $mvalue) = (@$pair);
436 #print STDERR "$mfield, $mvalue\n";
437 # check fields here, maybe others dont want
438 if ($mfield ne "Identifier" && $mfield ne "classifytype" &&
439 $mfield !~ /^gsdl/ && defined $mvalue && $mvalue ne "") {
440
441 $new_text .= "<Paragraph><$mfield>$mvalue</$mfield>\n";
442 #print STDERR "metadata=$mfield:$mvalue";
443
444 }
445 }
446
447 }
448 else { #individual metadata specified
449 foreach $item (@{$doc_obj->get_metadata ($section, $real_field)}) {
450 $new_text .= "<Paragraph><$real_field>$item</$real_field>\n";
451 }
452 }
453
454 }
455
456 # filter the text
457 $self->filter_text ($field, $new_text);
458
459 #????????????????????
460 if ($self->{'indexing_text'} &&
461 $new_text =~ /[\(\)\{\}]/) {
462 }
463
464 $text .= "$new_text";
465 }
466 }
467 } # if (indexed_doc)
468
469 $section = $doc_obj->get_next_section($section);
470 } #while defined section
471 print $handle "$text";
472}
473
4741;
475
Note: See TracBrowser for help on using the repository browser.