source: main/tags/2.30/gsdl/perllib/plugins/BasPlug.pm@ 23841

Last change on this file since 23841 was 1756, checked in by say1, 24 years ago

added detection and handling of unreadable files
  • Property svn:keywords set to Author Date Id Revision
File size: 17.5 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\n\n";
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 if (!-r $filename)
264 {
265 print STDERR "Read permission denied for $filename\n";
266 return;
267 }
268
269 $$textref = "";
270
271 open (FILE, $filename) || die "BasPlug::read_file could not open $filename for reading ($!)\n";
272
273 if ($self->{'input_encoding'} eq "ascii") {
274 undef $/;
275 $$textref = <FILE>;
276 $/ = "\n";
277 } else {
278 my $reader = new multiread();
279 $reader->set_handle ('BasPlug::FILE');
280 $reader->set_encoding ($self->{'input_encoding'});
281 $reader->read_file ($textref);
282
283 if ($self->{'input_encoding'} eq "gb") {
284 # segment the Chinese words
285 $$textref = &cnseg::segment($$textref);
286 }
287 }
288
289 close FILE;
290}
291
292# add any extra metadata that's been passed around from one
293# plugin to another.
294# extra_metadata uses add_utf8_metadata so it expects metadata values
295# to already be in utf8
296sub extra_metadata {
297 my $self = shift (@_);
298 my ($doc_obj, $cursection, $metadata) = @_;
299
300 foreach my $field (keys(%$metadata)) {
301 # $metadata->{$field} may be an array reference
302 if (ref ($metadata->{$field}) eq "ARRAY") {
303 map {
304 $doc_obj->add_utf8_metadata ($cursection, $field, $_);
305 } @{$metadata->{$field}};
306 } else {
307 $doc_obj->add_utf8_metadata ($cursection, $field, $metadata->{$field});
308 }
309 }
310}
311
312# initialise metadata extractors
313sub initialise_extractors {
314 my $self = shift (@_);
315
316 if ($self->{'extract_acronyms'} || $self->{'markup_acronyms'}) {
317 &acronym::initialise_acronyms();
318 }
319}
320
321# finalise metadata extractors
322sub finalise_extractors {
323 my $self = shift (@_);
324
325 if ($self->{'extract_acronyms'} || $self->{'markup_acronyms'}) {
326 &acronym::finalise_acronyms();
327 }
328}
329
330# FIRSTNNN: extract the first NNN characters as metadata
331sub extract_first_NNNN_characters {
332 my $self = shift (@_);
333 my ($textref, $doc_obj, $thissection) = @_;
334
335 foreach my $size (split /,/, $self->{'first'}) {
336 my $tmptext = $$textref;
337 $tmptext =~ s/^\s+//;
338 $tmptext =~ s/\s+$//;
339 $tmptext =~ s/\s+/ /gs;
340 $tmptext = substr ($tmptext, 0, $size);
341 $tmptext =~ s/\s\S*$/&#8230;/;
342 $doc_obj->add_utf8_metadata ($thissection, "First$size", $tmptext);
343 }
344}
345
346sub extract_email {
347 my $self = shift (@_);
348 my ($textref, $doc_obj, $thissection) = @_;
349 my $outhandle = $self->{'outhandle'};
350
351 print $outhandle " extracting email addresses ...\n"
352 if ($self->{'verbosity'} >= 2);
353
354 my @email = ($$textref =~ m/([-a-z0-9\.@+_=]+@(?:[-a-z0-9]+\.)+(?:com|org|edu|mil|int|[a-z][a-z]))/g);
355 @email = sort @email;
356
357 my @email2 = ();
358 foreach my $address (@email) {
359 if (!(join(" ",@email2) =~ m/$address/ )) {
360 push @email2, $address;
361 $doc_obj->add_utf8_metadata ($thissection, "emailAddress", $address);
362 print $outhandle " extracting $address\n"
363 if ($self->{'verbosity'} >= 3);
364 }
365 }
366 print $outhandle " done extracting email addresses.\n"
367 if ($self->{'verbosity'} >= 2);
368
369}
370
371# extract metadata
372sub auto_extract_metadata {
373 my $self = shift (@_);
374 my ($doc_obj) = @_;
375
376 if ($self->{'extract_email'}) {
377 my $thissection = $doc_obj->get_top_section();
378 while (defined $thissection) {
379 my $text = $doc_obj->get_text($thissection);
380 $self->extract_email (\$text, $doc_obj, $thissection) if $text =~ /./;
381 $thissection = $doc_obj->get_next_section ($thissection);
382 }
383 }
384 if ($self->{'first'}) {
385 my $thissection = $doc_obj->get_top_section();
386 while (defined $thissection) {
387 my $text = $doc_obj->get_text($thissection);
388 $self->extract_first_NNNN_characters (\$text, $doc_obj, $thissection) if $text =~ /./;
389 $thissection = $doc_obj->get_next_section ($thissection);
390 }
391 }
392
393 if ($self->{'extract_acronyms'}) {
394 my $thissection = $doc_obj->get_top_section();
395 while (defined $thissection) {
396 my $text = $doc_obj->get_text($thissection);
397 $self->extract_acronyms (\$text, $doc_obj, $thissection) if $text =~ /./;
398 $thissection = $doc_obj->get_next_section ($thissection);
399 }
400 }
401
402 if ($self->{'markup_acronyms'}) {
403 my $thissection = $doc_obj->get_top_section();
404 while (defined $thissection) {
405 my $text = $doc_obj->get_text($thissection);
406 $text = $self->markup_acronyms ($text, $doc_obj, $thissection);
407 $doc_obj->delete_text($thissection);
408 $doc_obj->add_text($thissection, $text);
409 $thissection = $doc_obj->get_next_section ($thissection);
410 }
411 }
412
413 if($self->{'date_extract'}) {
414 my $thissection = $doc_obj->get_top_section();
415 while (defined $thissection) {
416
417 my $text = $doc_obj->get_text($thissection);
418 &DateExtract::get_date_metadata($text, $doc_obj,
419 $thissection,
420 $self->{'no_biblio'},
421 $self->{'max_year'},
422 $self->{'max_century'});
423 $thissection = $doc_obj->get_next_section ($thissection);
424 }
425 }
426
427 if ($self->{'extract_language'}) {
428 my $thissection = $doc_obj->get_top_section();
429 while (defined $thissection) {
430 my $text = $doc_obj->get_text($thissection);
431 $self->extract_language (\$text, $doc_obj, $thissection) if $text =~ /./;
432 $thissection = $doc_obj->get_next_section ($thissection);
433 }
434 }
435
436}
437
438
439# Identify the language of a section and add it to the metadata
440sub extract_language {
441 my $self = shift (@_);
442 my ($textref, $doc_obj, $thissection) = @_;
443
444 # remove all HTML tags
445 my $text = $$textref;
446 $text =~ s/<P[^>]*>/\n/sgi;
447 $text =~ s/<H[^>]*>/\n/sgi;
448 $text =~ s/<[^>]*>//sgi;
449 $text =~ tr/\n/\n/s;
450
451 # get the language
452 my @results = textcat::classify($text);
453 @results = ("unknown") if ($#results > 2);
454
455 # create language string and remove encoding information
456 my $language = join(" or ", @results);
457 $language =~ s/\-\w+//g;
458 $doc_obj->add_utf8_metadata($thissection, "Language", $language);
459 # print "Language: ", time, "-> $language\n";
460
461}
462
463# extract acronyms from a section in a document. progress is
464# reported to outhandle based on the verbosity. both the Acronym
465# and the AcronymKWIC metadata items are created.
466
467sub extract_acronyms {
468 my $self = shift (@_);
469 my ($textref, $doc_obj, $thissection) = @_;
470 my $outhandle = $self->{'outhandle'};
471
472 print $outhandle " extracting acronyms ...\n"
473 if ($self->{'verbosity'} >= 2);
474
475 my $acro_array = &acronym::acronyms($textref);
476
477 foreach my $acro (@$acro_array) {
478
479 #check that this is the first time ...
480 my $seen_before = "false";
481 my $previous_data = $doc_obj->get_metadata($thissection, "Acronym");
482 foreach my $thisAcro (@$previous_data) {
483 if ($thisAcro eq $acro->to_string()) {
484 $seen_before = "true";
485 print $outhandle " already seen ". $acro->to_string() . "\n"
486 if ($self->{'verbosity'} >= 4);
487 }
488 }
489
490 if ($seen_before eq "false") {
491 #write it to the file ...
492 $acro->write_to_file();
493
494 #do the normal acronym
495 $doc_obj->add_utf8_metadata($thissection, "Acronym", $acro->to_string());
496 print $outhandle " adding ". $acro->to_string() . "\n"
497 if ($self->{'verbosity'} >= 3);
498
499 }
500 }
501 print $outhandle " done extracting acronyms. \n"
502 if ($self->{'verbosity'} >= 2);
503}
504
505sub markup_acronyms {
506 my $self = shift (@_);
507 my ($text, $doc_obj, $thissection) = @_;
508 my $outhandle = $self->{'outhandle'};
509
510 print $outhandle " marking up acronyms ...\n"
511 if ($self->{'verbosity'} >= 2);
512
513 #self is passed in to check for verbosity ...
514 $text = &acronym::markup_acronyms($text, $self);
515
516 print $outhandle " done marking up acronyms. \n"
517 if ($self->{'verbosity'} >= 2);
518
519 return $text;
520}
521
5221;
523
524
525
Note: See TracBrowser for help on using the repository browser.