source: trunk/gsdl/perllib/plugins/BasPlug.pm@ 1719

Last change on this file since 1719 was 1719, checked in by dmm9, 23 years ago

Added information to the usage text about date extraction option
  • Property svn:keywords set to Author Date Id Revision
File size: 17.4 KB
Line 
1###########################################################################
2#
3# BasPlug.pm -- base class for all the import plugins
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
26package BasPlug;
27
28use parsargv;
29use multiread;
30use cnseg;
31use acronym;
32use textcat;
33use doc;
34use diagnostics;
35use DateExtract;
36
37sub print_general_usage {
38 my ($plugin_name) = @_;
39
40 print STDERR "\n usage: plugin $plugin_name [options]\n\n";
41 print STDERR " -input_encoding The encoding of the source documents. Documents will be\n";
42 print STDERR " converted from these encodings and stored internally as\n";
43 print STDERR " utf8. The default input_encoding is ascii. Accepted values\n";
44 print STDERR " are:\n";
45 print STDERR " iso_8859_1 (extended ascii)\n";
46 print STDERR " Latin1 (the same as iso-8859-1)\n";
47 print STDERR " ascii (7 bit ascii -- may be faster than Latin1 as no\n";
48 print STDERR " conversion is neccessary)\n";
49 print STDERR " gb (GB or GBK simplified Chinese)\n";
50 print STDERR " iso_8859_6 (8 bit Arabic)\n";
51 print STDERR " windows_1256 (Windows codepage 1256 (Arabic))\n";
52 print STDERR " Arabic (the same as windows_1256)\n";
53 print STDERR " utf8 (either utf8 or unicode -- automatically detected)\n";
54 print STDERR " unicode (just unicode -- doesn't currently do endian\n";
55 print STDERR " detection)\n";
56 print STDERR " -process_exp A perl regular expression to match against filenames.\n";
57 print STDERR " Matching filenames will be processed by this plugin.\n";
58 print STDERR " Each plugin has its own default process_exp. e.g HTMLPlug\n";
59 print STDERR " defaults to '(?i)\.html?\$' i.e. all documents ending in\n";
60 print STDERR " .htm or .html (case-insensitive).\n";
61 print STDERR " -block_exp Files matching this regular expression will be blocked from\n";
62 print STDERR " being passed to any further plugins in the list. This has no\n";
63 print STDERR " real effect other than to prevent lots of warning messages\n";
64 print STDERR " about input files you don't care about. Each plugin may or may\n";
65 print STDERR " not have a default block_exp. e.g. by default HTMLPlug blocks\n";
66 print STDERR " any files with .gif, .jpg, .jpeg, .png, .rtf or .css\n";
67 print STDERR " file extensions.\n";
68 print STDERR " -extract_acronyms Extract acronyms from within text and set as metadata\n\n";
69 print STDERR " -markup_acronyms Added acronym metadata into document text\n\n";
70 print STDERR " -extract_langauge Identify the language of the text and set as metadata\n\n";
71 print STDERR " -first Comma seperated list of first sizes to extract from the text \n";
72 print STDERR " into a metadata field. The fields are called 'FirstNNN'.\n";
73 print STDERR " -extract_email Extract email addresses as metadata\n\n";
74 print STDERR " -extract_date Extract dates pertaining to the content of documents about history.";
75}
76
77# print_usage should be overridden for any sub-classes having
78# their own plugin specific options
79sub print_usage {
80 print STDERR "\nThis plugin has no plugin specific options\n\n";
81
82}
83
84sub new {
85 my $class = shift (@_);
86 my $plugin_name = shift (@_);
87
88 my $self = {};
89 my $encodings = "^(iso_8859_1|Latin1|ascii|gb|iso_8859_6|windows_1256|Arabic|utf8|unicode)\$";
90 $self->{'outhandle'} = STDERR;
91 my $year = (localtime)[5]+1900;
92
93 # general options available to all plugins
94 if (!parsargv::parse(\@_,
95 qq^input_encoding/$encodings/ascii^, \$self->{'input_encoding'},
96 q^process_exp/.*/^, \$self->{'process_exp'},
97 q^block_exp/.*/^, \$self->{'block_exp'},
98 q^extract_acronyms^, \$self->{'extract_acronyms'},
99 q^extract_email^, \$self->{'extract_email'},
100 q^markup_acronyms^, \$self->{'markup_acronyms'},
101 q^extract_language^, \$self->{'extract_language'},
102 q^first/.*/^, \$self->{'first'},
103 q^extract_date^, \$self->{'date_extract'},
104 "maximum_date/\\d{4}/$year", \$self->{'max_year'},
105 q^no_bibliography^, \$self->{'no_biblio'},
106 "maximum_century/-?\\d{1,2}( ?B\\.C\\.E\\.)?/-1",
107 \$self->{'max_century'},
108 "allow_extra_options")) {
109
110 print STDERR "\nThe $plugin_name plugin uses an incorrect general option (general options are those\n";
111 print STDERR "available to all plugins). Check your collect.cfg configuration file.\n";
112 &print_general_usage($plugin_name);
113 die "\n";
114 }
115
116 return bless $self, $class;
117}
118
119# initialize BasPlug options
120# if init() is overridden in a sub-class, remember to call BasPlug::init()
121sub init {
122 my $self = shift (@_);
123 my ($verbosity, $outhandle) = @_;
124
125 # verbosity is passed through from the processor
126 $self->{'verbosity'} = $verbosity;
127
128 # as is the outhandle ...
129 $self->{'outhandle'} = $outhandle if defined $outhandle;
130
131 # set process_exp and block_exp to defaults unless they were
132 # explicitly set
133
134 if ((!$self->is_recursive()) and
135 (!defined $self->{'process_exp'}) || ($self->{'process_exp'} eq "")) {
136
137 $self->{'process_exp'} = $self->get_default_process_exp ();
138 if ($self->{'process_exp'} eq "") {
139 warn ref($self) . " Warning: Non-recursive plugin has no process_exp\n";
140 }
141 }
142
143 if ((!defined $self->{'block_exp'}) || ($self->{'block_exp'} eq "")) {
144 $self->{'block_exp'} = $self->get_default_block_exp ();
145 }
146
147 # handle input_encoding aliases
148 $self->{'input_encoding'} = "iso_8859_1" if $self->{'input_encoding'} eq "Latin1";
149 $self->{'input_encoding'} = "windows_1256" if $self->{'input_encoding'} eq "Arabic";
150}
151
152sub begin {
153 my $self = shift (@_);
154 my ($pluginfo, $base_dir, $processor, $maxdocs) = @_;
155 $self->initialise_extractors();
156}
157
158sub end {
159 my ($self) = @_;
160 $self->finalise_extractors();
161}
162
163# this function should be overridden to return 1
164# in recursive plugins
165sub is_recursive {
166 my $self = shift (@_);
167
168 return 0;
169}
170
171sub get_default_block_exp {
172 my $self = shift (@_);
173
174 return "";
175}
176
177sub get_default_process_exp {
178 my $self = shift (@_);
179
180 return "";
181}
182
183# The BasPlug read() function. This function does all the right things
184# to make general options work for a given plugin. It calls the process()
185# function which does all the work specific to a plugin (like the old
186# read functions used to do). Most plugins should define their own
187# process() function and let this read() function keep control.
188#
189# recursive plugins (e.g. RecPlug) and specialized plugins like those
190# capable of processing many documents within a single file (e.g.
191# GMLPlug) should normally implement their own version of read()
192#
193# Return number of files processed, undef if can't process
194# Note that $base_dir might be "" and that $file might
195# include directories
196
197sub read {
198 my $self = shift (@_);
199 my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs) = @_;
200
201 if ($self->is_recursive()) {
202 die "BasPlug::read function must be implemented in sub-class for recursive plugins\n";
203 }
204
205 my $filename = &util::filename_cat($base_dir, $file);
206 return 0 if $self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/;
207 if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
208 return undef;
209 }
210 my $plugin_name = ref ($self);
211 $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
212
213 # create a new document
214 my $doc_obj = new doc ($filename, "indexed_doc");
215
216 # read in file ($text will be in utf8)
217 my $text = "";
218 $self->read_file ($filename, \$text);
219
220 if ($text !~ /\w/) {
221 my $outhandle = $self->{'outhandle'};
222 print $outhandle "$plugin_name: ERROR: $file contains no text\n" if $self->{'verbosity'};
223 return 0;
224 }
225
226 # include any metadata passed in from previous plugins
227 # note that this metadata is associated with the top level section
228 $self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
229
230 # do plugin specific processing of doc_obj
231 return undef unless defined ($self->process (\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj));
232
233 # do any automatic metadata extraction
234 $self->auto_extract_metadata ($doc_obj);
235
236 # add an OID
237 $doc_obj->set_OID();
238
239 # process the document
240 $processor->process($doc_obj);
241
242 return 1; # processed the file
243}
244
245# returns undef if file is rejected by the plugin
246sub process {
247 my $self = shift (@_);
248 my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
249
250 die "Basplug::process function must be implemented in sub-class\n";
251
252 return undef; # never gets here
253}
254
255# uses the multiread package to read in the entire file pointed to
256# by filename and loads the resulting text into $$textref. Input text
257# may be in any of the encodings handled by multiread, output text
258# will be in utf8
259sub read_file {
260 my $self = shift (@_);
261 my ($filename, $textref) = @_;
262
263 $$textref = "";
264
265 open (FILE, $filename) || die "BasPlug::read_file could not open $filename for reading ($!)\n";
266
267 if ($self->{'input_encoding'} eq "ascii") {
268 undef $/;
269 $$textref = <FILE>;
270 $/ = "\n";
271 } else {
272 my $reader = new multiread();
273 $reader->set_handle ('BasPlug::FILE');
274 $reader->set_encoding ($self->{'input_encoding'});
275 $reader->read_file ($textref);
276
277 if ($self->{'input_encoding'} eq "gb") {
278 # segment the Chinese words
279 $$textref = &cnseg::segment($$textref);
280 }
281 }
282
283 close FILE;
284}
285
286# add any extra metadata that's been passed around from one
287# plugin to another.
288# extra_metadata uses add_utf8_metadata so it expects metadata values
289# to already be in utf8
290sub extra_metadata {
291 my $self = shift (@_);
292 my ($doc_obj, $cursection, $metadata) = @_;
293
294 foreach my $field (keys(%$metadata)) {
295 # $metadata->{$field} may be an array reference
296 if (ref ($metadata->{$field}) eq "ARRAY") {
297 map {
298 $doc_obj->add_utf8_metadata ($cursection, $field, $_);
299 } @{$metadata->{$field}};
300 } else {
301 $doc_obj->add_utf8_metadata ($cursection, $field, $metadata->{$field});
302 }
303 }
304}
305
306# initialise metadata extractors
307sub initialise_extractors {
308 my $self = shift (@_);
309
310 if ($self->{'extract_acronyms'} || $self->{'markup_acronyms'}) {
311 &acronym::initialise_acronyms();
312 }
313}
314
315# finalise metadata extractors
316sub finalise_extractors {
317 my $self = shift (@_);
318
319 if ($self->{'extract_acronyms'} || $self->{'markup_acronyms'}) {
320 &acronym::finalise_acronyms();
321 }
322}
323
324# FIRSTNNN: extract the first NNN characters as metadata
325sub extract_first_NNNN_characters {
326 my $self = shift (@_);
327 my ($textref, $doc_obj, $thissection) = @_;
328
329 foreach my $size (split /,/, $self->{'first'}) {
330 my $tmptext = $$textref;
331 $tmptext =~ s/^\s+//;
332 $tmptext =~ s/\s+$//;
333 $tmptext =~ s/\s+/ /gs;
334 $tmptext = substr ($tmptext, 0, $size);
335 $tmptext =~ s/\s\S*$/&#8230;/;
336 $doc_obj->add_utf8_metadata ($thissection, "First$size", $tmptext);
337 }
338}
339
340sub extract_email {
341 my $self = shift (@_);
342 my ($textref, $doc_obj, $thissection) = @_;
343 my $outhandle = $self->{'outhandle'};
344
345 print $outhandle " extracting email addresses ...\n"
346 if ($self->{'verbosity'} >= 2);
347
348 my @email = ($$textref =~ m/([-a-z0-9\.@+_=]+@(?:[-a-z0-9]+\.)+(?:com|org|edu|mil|int|[a-z][a-z]))/g);
349 @email = sort @email;
350
351 my @email2 = ();
352 foreach my $address (@email) {
353 if (!(join(" ",@email2) =~ m/$address/ )) {
354 push @email2, $address;
355 $doc_obj->add_utf8_metadata ($thissection, "emailAddress", $address);
356 print $outhandle " extracting $address\n"
357 if ($self->{'verbosity'} >= 3);
358 }
359 }
360 print $outhandle " done extracting email addresses.\n"
361 if ($self->{'verbosity'} >= 2);
362
363}
364
365# extract metadata
366sub auto_extract_metadata {
367 my $self = shift (@_);
368 my ($doc_obj) = @_;
369
370 if ($self->{'extract_email'}) {
371 my $thissection = $doc_obj->get_top_section();
372 while (defined $thissection) {
373 my $text = $doc_obj->get_text($thissection);
374 $self->extract_email (\$text, $doc_obj, $thissection) if $text =~ /./;
375 $thissection = $doc_obj->get_next_section ($thissection);
376 }
377 }
378 if ($self->{'first'}) {
379 my $thissection = $doc_obj->get_top_section();
380 while (defined $thissection) {
381 my $text = $doc_obj->get_text($thissection);
382 $self->extract_first_NNNN_characters (\$text, $doc_obj, $thissection) if $text =~ /./;
383 $thissection = $doc_obj->get_next_section ($thissection);
384 }
385 }
386
387 if ($self->{'extract_acronyms'}) {
388 my $thissection = $doc_obj->get_top_section();
389 while (defined $thissection) {
390 my $text = $doc_obj->get_text($thissection);
391 $self->extract_acronyms (\$text, $doc_obj, $thissection) if $text =~ /./;
392 $thissection = $doc_obj->get_next_section ($thissection);
393 }
394 }
395
396 if ($self->{'markup_acronyms'}) {
397 my $thissection = $doc_obj->get_top_section();
398 while (defined $thissection) {
399 my $text = $doc_obj->get_text($thissection);
400 $text = $self->markup_acronyms ($text, $doc_obj, $thissection);
401 $doc_obj->delete_text($thissection);
402 $doc_obj->add_text($thissection, $text);
403 $thissection = $doc_obj->get_next_section ($thissection);
404 }
405 }
406
407 if($self->{'date_extract'}) {
408 my $thissection = $doc_obj->get_top_section();
409 while (defined $thissection) {
410
411 my $text = $doc_obj->get_text($thissection);
412 &DateExtract::get_date_metadata($text, $doc_obj,
413 $thissection,
414 $self->{'no_biblio'},
415 $self->{'max_year'},
416 $self->{'max_century'});
417 $thissection = $doc_obj->get_next_section ($thissection);
418 }
419 }
420
421 if ($self->{'extract_language'}) {
422 my $thissection = $doc_obj->get_top_section();
423 while (defined $thissection) {
424 my $text = $doc_obj->get_text($thissection);
425 $self->extract_language (\$text, $doc_obj, $thissection) if $text =~ /./;
426 $thissection = $doc_obj->get_next_section ($thissection);
427 }
428 }
429
430}
431
432
433# Identify the language of a section and add it to the metadata
434sub extract_language {
435 my $self = shift (@_);
436 my ($textref, $doc_obj, $thissection) = @_;
437
438 # remove all HTML tags
439 my $text = $$textref;
440 $text =~ s/<P[^>]*>/\n/sgi;
441 $text =~ s/<H[^>]*>/\n/sgi;
442 $text =~ s/<[^>]*>//sgi;
443 $text =~ tr/\n/\n/s;
444
445 # get the language
446 my @results = textcat::classify($text);
447 @results = ("unknown") if ($#results > 2);
448
449 # create language string and remove encoding information
450 my $language = join(" or ", @results);
451 $language =~ s/\-\w+//g;
452 $doc_obj->add_utf8_metadata($thissection, "Language", $language);
453 # print "Language: ", time, "-> $language\n";
454
455}
456
457# extract acronyms from a section in a document. progress is
458# reported to outhandle based on the verbosity. both the Acronym
459# and the AcronymKWIC metadata items are created.
460
461sub extract_acronyms {
462 my $self = shift (@_);
463 my ($textref, $doc_obj, $thissection) = @_;
464 my $outhandle = $self->{'outhandle'};
465
466 print $outhandle " extracting acronyms ...\n"
467 if ($self->{'verbosity'} >= 2);
468
469 my $acro_array = &acronym::acronyms($textref);
470
471 foreach my $acro (@$acro_array) {
472
473 #check that this is the first time ...
474 my $seen_before = "false";
475 my $previous_data = $doc_obj->get_metadata($thissection, "Acronym");
476 foreach my $thisAcro (@$previous_data) {
477 if ($thisAcro eq $acro->to_string()) {
478 $seen_before = "true";
479 print $outhandle " already seen ". $acro->to_string() . "\n"
480 if ($self->{'verbosity'} >= 4);
481 }
482 }
483
484 if ($seen_before eq "false") {
485 #write it to the file ...
486 $acro->write_to_file();
487
488 #do the normal acronym
489 $doc_obj->add_utf8_metadata($thissection, "Acronym", $acro->to_string());
490 print $outhandle " adding ". $acro->to_string() . "\n"
491 if ($self->{'verbosity'} >= 3);
492
493 }
494 }
495 print $outhandle " done extracting acronyms. \n"
496 if ($self->{'verbosity'} >= 2);
497}
498
499sub markup_acronyms {
500 my $self = shift (@_);
501 my ($text, $doc_obj, $thissection) = @_;
502 my $outhandle = $self->{'outhandle'};
503
504 print $outhandle " marking up acronyms ...\n"
505 if ($self->{'verbosity'} >= 2);
506
507 #self is passed in to check for verbosity ...
508 $text = &acronym::markup_acronyms($text, $self);
509
510 print $outhandle " done marking up acronyms. \n"
511 if ($self->{'verbosity'} >= 2);
512
513 return $text;
514}
515
5161;
517
518
519
Note: See TracBrowser for help on using the repository browser.