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

Last change on this file since 2480 was 2480, checked in by kjm18, 22 years ago

added the store_text option as done in mgbuildproc.pm

  • Property svn:keywords set to Author Date Id Revision
File size: 17.4 KB
Line 
1###########################################################################
2#
3# mgppbuildproc.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 mgpp 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,
45 $verbosity, $outhandle) = @_;
46 my $self = new docproc ();
47
48 # outhandle is where all the debugging info goes
49 # output_handle is where the output of the plugins is piped
50 # to (i.e. mg, gdbm etc.)
51 $outhandle = STDERR unless defined $outhandle;
52
53 $self->{'collection'} = $collection;
54 $self->{'source_dir'} = $source_dir;
55 $self->{'build_dir'} = $build_dir;
56 $self->{'verbosity'} = $verbosity;
57 $self->{'classifiers'} = [];
58 $self->{'mode'} = "text";
59 $self->{'assocdir'} = $build_dir;
60 $self->{'dontgdbm'} = {};
61 $self->{'index'} = "text";
62 $self->{'indexexparr'} = [];
63 $self->{'output_handle'} = "STDOUT";
64 $self->{'num_docs'} = 0;
65 $self->{'num_sections'} = 0;
66 $self->{'num_bytes'} = 0;
67 $self->{'num_processed_bytes'} = 0;
68 $self->{'outhandle'} = $outhandle;
69 $self->{'store_text'} = 1;
70 $self->{'dontindex'} = {};
71 $self->{'indexfieldmap'} = {};
72
73 $self->{'indexing_text'} = 0;
74 $self->{'indexfields'} = {};
75 $self->{'strip_html'}=1;
76
77
78 return bless $self, $class;
79}
80
81sub reset {
82 my $self = shift (@_);
83
84 $self->{'num_docs'} = 0;
85 $self->{'num_sections'} = 0;
86 $self->{'num_processed_bytes'} = 0;
87 $self->{'num_bytes'} = 0;
88}
89
90sub get_num_docs {
91 my $self = shift (@_);
92
93 return $self->{'num_docs'};
94}
95
96sub get_num_sections {
97 my $self = shift (@_);
98
99 return $self->{'num_sections'};
100}
101
102# num_bytes is the actual number of bytes in the collection
103# this is normally the same as what's processed during text compression
104sub get_num_bytes {
105 my $self = shift (@_);
106
107 return $self->{'num_bytes'};
108}
109
110# num_processed_bytes is the number of bytes actually passed
111# to mgpp for the current index
112sub get_num_processed_bytes {
113 my $self = shift (@_);
114
115 return $self->{'num_processed_bytes'};
116}
117
118sub set_output_handle {
119 my $self = shift (@_);
120 my ($handle) = @_;
121
122 $self->{'output_handle'} = $handle;
123}
124
125sub set_mode {
126 my $self = shift (@_);
127 my ($mode) = @_;
128
129 $self->{'mode'} = $mode;
130}
131
132sub set_assocdir {
133 my $self = shift (@_);
134 my ($assocdir) = @_;
135
136 $self->{'assocdir'} = $assocdir;
137}
138
139sub set_dontgdbm {
140 my $self = shift (@_);
141 my ($dontgdbm) = @_;
142
143 $self->{'dontgdbm'} = $dontgdbm;
144}
145
146sub set_index {
147 my $self = shift (@_);
148 my ($index, $indexexparr) = @_;
149
150 $self->{'index'} = $index;
151 $self->{'indexexparr'} = $indexexparr if defined $indexexparr;
152}
153
154sub get_index {
155 my $self = shift (@_);
156
157 return $self->{'index'};
158}
159
160sub set_classifiers {
161 my $self = shift (@_);
162 my ($classifiers) = @_;
163
164 $self->{'classifiers'} = $classifiers;
165}
166
167sub set_indexing_text {
168 my $self = shift (@_);
169 my ($indexing_text) = @_;
170
171 $self->{'indexing_text'} = $indexing_text;
172}
173
174sub get_indexing_text {
175 my $self = shift (@_);
176
177 return $self->{'indexing_text'};
178}
179
180sub set_store_text {
181 my $self = shift (@_);
182 my ($store_text) = @_;
183
184 $self->{'store_text'} = $store_text;
185}
186
187sub set_indexfieldmap {
188 my $self = shift (@_);
189 my ($indexmap) = @_;
190
191 $self->{'indexfieldmap'} = $indexmap;
192}
193
194sub get_indexfieldmap {
195 my $self = shift (@_);
196
197 return $self->{'indexfieldmap'};
198}
199
200sub set_levels {
201 my $self = shift (@_);
202 my ($levels) = @_;
203
204 $self->{'levels'} = $levels;
205}
206
207sub set_strip_html {
208 my $self = shift (@_);
209 my ($strip) = @_;
210 $self->{'strip_html'}=$strip;
211}
212
213sub process {
214 my $self = shift (@_);
215 my $method = $self->{'mode'};
216
217 $self->$method(@_);
218}
219
220# use 'Paged' if document has no more than 2 levels
221# and each section at second level has a number for
222# Title metadata
223sub get_document_type {
224 my $self = shift (@_);
225 my ($doc_obj) = @_;
226
227 my $thistype = "VList";
228 my $childtype = "VList";
229 my $title;
230 my @tmp = ();
231
232 my $section = $doc_obj->get_top_section ();
233 my $first = 1;
234 while (defined $section) {
235 @tmp = split /\./, $section;
236 if (scalar(@tmp) > 1) {
237 return ($thistype, $childtype);
238 }
239 if (!$first) {
240 $title = $doc_obj->get_metadata_element ($section, "Title");
241 if (!defined $title || $title !~ /^\d+$/) {
242 return ($thistype, $childtype);
243 }
244 }
245 $first = 0;
246 $section = $doc_obj->get_next_section($section);
247 }
248 if ($doc_obj->get_text_length ($doc_obj->get_top_section())) {
249 $thistype = "Paged";
250 } else {
251 $thistype = "Invisible";
252 }
253 $childtype = "Paged";
254 return ($thistype, $childtype);
255}
256
257sub assoc_files {
258 my $self = shift (@_);
259 my ($doc_obj, $archivedir) = @_;
260 my ($afile);
261
262 foreach my $assoc_file (@{$doc_obj->get_assoc_files()}) {
263 # if assoc file contains directory structure of
264 # its own use it, otherwise use HASH... directory
265 if ($assoc_file->[1] =~ /[\/\\]/) {
266 $afile = &util::filename_cat($self->{'assocdir'}, $assoc_file->[1]);
267 } else {
268 $afile = &util::filename_cat($self->{'assocdir'}, $archivedir, $assoc_file->[1]);
269 }
270 &util::hard_link ($assoc_file->[0], $afile);
271 }
272}
273
274sub infodb {
275 my $self = shift (@_);
276 my ($doc_obj, $filename) = @_;
277 my $handle = $self->{'output_handle'};
278
279 my $doctype = $doc_obj->get_doc_type();
280
281 # only output this document if it is one to be indexed
282 return if ($doctype ne "indexed_doc");
283
284 #if a Section level index is not built, the gdbm file should be at doc
285 #level not Section
286 my $docs_only = 1;
287 if ($self->{'levels'}->{'Section'}) {
288 $docs_only = 0;
289 }
290
291 my ($archivedir) = $filename =~ /^(.*?)(?:\/|\\)[^\/\\]*$/;
292 $archivedir = "" unless defined $archivedir;
293 $archivedir =~ s/\\/\//g;
294 $archivedir =~ s/^\/+//;
295 $archivedir =~ s/\/+$//;
296
297 $self->assoc_files ($doc_obj, $archivedir);
298
299 # this is another document
300 $self->{'num_docs'} += 1 unless ($doctype eq "classification");
301
302 # is this a paged or a hierarchical document
303 my ($thistype, $childtype) = $self->get_document_type ($doc_obj);
304
305 my $section = $doc_obj->get_top_section ();
306 my $doc_OID = $doc_obj->get_OID();
307 my $first = 1;
308 my $url = "";
309 while (defined $section) {
310 # update a few statistics
311 $self->{'num_bytes'} += $doc_obj->get_text_length ($section);
312 $self->{'num_sections'} += 1 unless ($doctype eq "classification");
313
314 # output the section name
315 if ($section eq "") { print $handle "[$doc_OID]\n"; }
316 else { print $handle "[$doc_OID.$section]\n"; }
317
318 # output the fact that this document is a document (unless doctype
319 # has been set to something else from within a plugin
320 my $dtype = $doc_obj->get_metadata_element ($section, "doctype");
321 if (!defined $dtype || $dtype !~ /\w/) {
322 print $handle "<doctype>doc\n";
323 }
324
325 # output whether this node contains text
326 if ($doc_obj->get_text_length($section) > 0) {
327 print $handle "<hastxt>1\n";
328 } else {
329 print $handle "<hastxt>0\n";
330 }
331
332 # output all the section metadata
333 my $metadata = $doc_obj->get_all_metadata ($section);
334 foreach my $pair (@$metadata) {
335 my ($field, $value) = (@$pair);
336
337 if ($field ne "Identifier" && $field !~ /^gsdl/ &&
338 defined $value && $value ne "") {
339
340 # escape problematic stuff
341 $value =~ s/\\/\\\\/g;
342 $value =~ s/\n/\\n/g;
343 $value =~ s/\r/\\r/g;
344
345 # special case for URL metadata
346 if ($field =~ /^URL$/i) {
347 $url .= "[$value]\n";
348 if ($section eq "") {$url .= "<section>$doc_OID\n";}
349 else {$url .= "<section>$doc_OID.$section\n";}
350 $url .= '-' x 70 . "\n";
351 }
352
353 if (!defined $self->{'dontgdbm'}->{$field}) {
354 print $handle "<$field>$value\n";
355 }
356 }
357 }
358
359 # output archivedir if at top level
360 if ($section eq $doc_obj->get_top_section()) {
361 print $handle "<archivedir>$archivedir\n";
362 }
363
364 # output document display type
365 if ($first) {
366 print $handle "<thistype>$thistype\n";
367 }
368
369 if (!$docs_only) {
370 # output a list of children
371 my $children = $doc_obj->get_children ($section);
372 if (scalar(@$children) > 0) {
373 print $handle "<childtype>$childtype\n";
374 print $handle "<contains>";
375 my $firstchild = 1;
376 foreach $child (@$children) {
377 print $handle ";" unless $firstchild;
378 $firstchild = 0;
379 if ($child =~ /^.*?\.(\d+)$/) {
380 print $handle "\".$1";
381 } else {
382 print $handle "\".$child";
383 }
384# if ($child eq "") { print $handle "$doc_OID"; }
385# elsif ($section eq "") { print $handle "$doc_OID.$child"; }
386# else { print $handle "$doc_OID.$section.$child"; }
387 }
388 print $handle "\n";
389 }
390 #output the matching doc number
391 print $handle "<docnum>$self->{'num_sections'}\n";
392
393 } # if (!$docs_only)
394 else { #docs only, doc num is num_docs not num_sections
395 # output the matching document number
396 print $handle "<docnum>$self->{'num_docs'}\n";
397 }
398
399 print $handle '-' x 70, "\n";
400
401
402 # output a database entry for the document number
403 if ($docs_only) {
404 print $handle "[$self->{'num_docs'}]\n";
405 print $handle "<section>$doc_OID\n";
406 }
407 else {
408 print $handle "[$self->{'num_sections'}]\n";
409 if ($section eq "") { print $handle "<section>$doc_OID\n"; }
410 else { print $handle "<section>$doc_OID.$section\n"; }
411 }
412 print $handle '-' x 70, "\n";
413
414 # output entry for url
415 if ($url ne "") {
416 print $handle $url;
417 }
418
419 $first = 0;
420 $section = $doc_obj->get_next_section($section);
421 last if ($docs_only); # if no sections wanted, only gdbm the docs
422 }
423
424 # classify this document
425 &classify::classify_doc ($self->{'classifiers'}, $doc_obj);
426
427}
428
429sub find_paragraphs {
430 $_[1] =~ s/(<p\b)/<Paragraph>$1/gi;
431}
432
433#this function strips the html tags from the doc if ($strip_html) and
434# if ($para) replaces <p> with <Paragraph> tags.
435# if both are false, the original text is returned
436#assumes that <pre> and </pre> have no spaces, and removes all < and > inside
437#these tags
438sub preprocess_text {
439 my $self = shift (@_);
440 my ($text, $strip_html, $para) = @_;
441
442 my ($outtext) = "";
443 if ($strip_html) {
444 while ($text =~ /<([^>]*)>/ && $text ne "") {
445
446 $tag = $1;
447 $outtext .= $`." "; #add everything before the matched tag
448 $text = $'; #everything after the matched tag
449 if ($para && $tag =~ /^\s*p\s/) {
450 $outtext .= "<Paragraph> ";
451 }
452 elsif ($tag =~ /^pre$/) { # a pre tag
453 $text =~ /<\/pre>/; # find the closing pre tag
454 my $tmp_text = $`; #everything before the closing pre tag
455 $text = $'; #everything after the </pre>
456 $tmp_text =~ s/[<>]//g; # remove all < and >
457 $outtext.= $tmp_text . " ";
458 }
459 }
460
461 $outtext .= $text; # add any remaining text
462 return $outtext;
463 } #if strip_html
464
465 if ($para) {
466 $text =~ s/(<p\b)/<Paragraph>$1/gi;
467 return $text;
468 }
469 return $text;
470}
471
472
473
474sub filter_text {
475 # $self->filter_text ($field, $new_text);
476 # don't want to do anything for this version, however,
477 # in a particular collection you might want to override
478 # this method to post-process certain fields depending on
479 # the field, or whether we are outputting it for indexing
480}
481
482sub text {
483 my $self = shift (@_);
484 my ($doc_obj) = @_;
485 my $handle = $self->{'output_handle'};
486 my $indexed_doc = 1;
487
488 # only output this document if it is one to be indexed
489 return if ($doc_obj->get_doc_type() ne "indexed_doc");
490
491 # see if this document belongs to this subcollection
492 foreach my $indexexp (@{$self->{'indexexparr'}}) {
493 $indexed_doc = 0;
494 my ($field, $exp, $options) = split /\//, $indexexp;
495 if (defined ($field) && defined ($exp)) {
496 my ($bool) = $field =~ /^(.)/;
497 $field =~ s/^.// if $bool eq '!';
498 if ($field =~ /^filename$/i) {
499 $field = $doc_obj->get_source_filename();
500 } else {
501 $field = $doc_obj->get_metadata_element($doc_obj->get_top_section(), $field);
502 }
503 next unless defined $field;
504 if ($bool eq '!') {
505 if ($options =~ /^i$/i) {
506 if ($field !~ /$exp/i) {$indexed_doc = 1; last;}
507 } else {
508 if ($field !~ /$exp/) {$indexed_doc = 1; last;}
509 }
510 } else {
511 if ($options =~ /^i$/i) {
512 if ($field =~ /$exp/i) {$indexed_doc = 1; last;}
513 } else {
514 if ($field =~ /$exp/) {$indexed_doc = 1; last;}
515 }
516 }
517 }
518 }
519
520 # this is another document
521 $self->{'num_docs'} += 1;
522
523 # get the parameters for the output
524 my ($fields) = $self->{'index'};
525
526 my ($sectiontag) = "";
527 if ($self->{'levels'}->{'Section'}) {
528 $sectiontag = "\n<Section>\n";
529 }
530 my ($paratag) = "";
531 if ($self->{'levels'}->{'Paragraph'}) {
532 $paratag = "<Paragraph>";
533 }
534 my $doc_section = 0; # just for this document
535 my $text = "<Document>\n";
536
537 # get the text for this document
538 my $section = $doc_obj->get_top_section();
539 while (defined $section) {
540 # update a few statistics
541 $doc_section++;
542 $self->{'num_sections'} += 1;
543 $text .= $sectiontag;
544
545 if ($indexed_doc) {
546 $self->{'num_bytes'} += $doc_obj->get_text_length ($section);
547 foreach my $field (split (/,/, $fields)) {
548 # only deal with this field if it doesn't start with top or
549 # this is the first section
550 my $real_field = $field;
551 if (!($real_field =~ s/^top//) || ($doc_section == 1)) {
552 my $new_text = "";
553 my $tmp_text = "";
554 if ($real_field eq "text") {
555 if ($self->{'indexing_text'}) { #tag the text with <Text>...</Text>, add the <Paragraph> tags and strip out html if needed
556 $new_text .= "<TX>\n";
557 $tmp_text .= $doc_obj->get_text ($section) if $self->{'store_text'};
558 $tmp_text = $self->preprocess_text($tmp_text, $self->{'strip_html'}, $self->{'levels'}->{'Paragraph'});
559
560 $new_text .= "$tmp_text</TX>\n";
561 if (!defined $self->{'indexfields'}->{'TextOnly'}) {
562 $self->{'indexfields'}->{'TextOnly'} = 1;
563 }
564 }
565 else { # leave html stuff in, and dont add Paragraph tags - never retrieve paras at the moment
566 $new_text .= $doc_obj->get_text ($section) if $self->{'store_text'};
567 #if ($self->{'levels'}->{'Paragraph'}) {
568 #$self->find_paragraphs($new_text);
569 #}
570 }
571 } else { # metadata field
572 if ($real_field eq "metadata") { # insert all metadata
573 #except gsdl stuff
574 my $shortname = "";
575 my $metadata = $doc_obj->get_all_metadata ($section);
576 foreach $pair (@$metadata) {
577 my ($mfield, $mvalue) = (@$pair);
578 # check fields here, maybe others dont want - change to use dontindex!!
579 if ($mfield ne "Identifier" && $mfield ne "classifytype" && $mfield ne "assocfilepath" &&
580 $mfield !~ /^gsdl/ && defined $mvalue && $mvalue ne "") {
581
582 if (defined $self->{'indexfieldmap'}->{$mfield}) {
583 $shortname = $self->{'indexfieldmap'}->{$mfield};
584 }
585 else {
586 $shortname = $self->create_shortname($mfield);
587 $self->{'indexfieldmap'}->{$mfield} = $shortname;
588 $self->{'indexfieldmap'}->{$shortname} = 1;
589 }
590 $new_text .= "$paratag<$shortname>$mvalue</$shortname>\n";
591 if (!defined $self->{'indexfields'}->{$mfield}) {
592 $self->{'indexfields'}->{$mfield} = 1;
593 }
594 }
595 }
596
597 }
598 else { #individual metadata specified
599 my $shortname="";
600 if (!defined $self->{'indexfields'}->{$real_field}) {
601 $self->{'indexfields'}->{$real_field} = 1;
602 }
603 if (defined $self->{'indexfieldmap'}->{$real_field}) {
604 $shortname = $self->{'indexfieldmap'}->{$real_field};
605 }
606 else {
607 $shortname = $self->create_shortname($real_field);
608 $self->{'indexfieldmap'}->{$real_field} = $shortname;
609 $self->{'indexfieldmap'}->{$shortname} = 1;
610 }
611 foreach $item (@{$doc_obj->get_metadata ($section, $real_field)}) {
612 $new_text .= "$paratag<$shortname>$item</$shortname>\n";
613 }
614 }
615
616 }
617
618 # filter the text
619 $self->filter_text ($field, $new_text);
620
621 $self->{'num_processed_bytes'} += length ($new_text);
622 $text .= "$new_text";
623 }
624 }
625 } # if (indexed_doc)
626
627 $section = $doc_obj->get_next_section($section);
628 } #while defined section
629 print $handle "$text\n</Document>\n";
630}
631
632sub create_shortname {
633 $self = shift(@_);
634
635 my ($realname) = @_;
636 #take the first two chars
637 my ($shortname) = $realname =~ /^(\w\w)/;
638 $shortname =~ tr/a-z/A-Z/;
639
640 #if already used, take the first and third letters and so on
641 $count = 1;
642 while (defined $self->{'indexfieldmap'}->{$shortname}) {
643 if ($realname =~ /^(\w).{$count}(\w)/) {
644 $shortname = "$1$2";
645 $count++;
646 $shortname =~ tr/a-z/A-Z/;
647
648 }
649 else {
650 $realname =~ s/^.//;
651 $count = 0;
652 }
653 }
654
655 return $shortname;
656}
657
6581;
659
Note: See TracBrowser for help on using the repository browser.