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

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

acronym markup functionality
  • Property svn:keywords set to Author Date Id Revision
File size: 14.0 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 strict;
34use doc;
35use diagnostics;
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, .pdf, .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}
72
73# print_usage should be overridden for any sub-classes having
74# their own plugin specific options
75sub print_usage {
76 print STDERR "\nThis plugin has no plugin specific options\n\n";
77
78}
79
80sub new {
81 my $class = shift (@_);
82 my $plugin_name = shift (@_);
83
84 my $self = {};
85 my $encodings = "^(iso_8859_1|Latin1|ascii|gb|iso_8859_6|windows_1256|Arabic|utf8|unicode)\$";
86
87 # general options available to all plugins
88 if (!parsargv::parse(\@_,
89 qq^input_encoding/$encodings/ascii^, \$self->{'input_encoding'},
90 q^process_exp/.*/^, \$self->{'process_exp'},
91 q^block_exp/.*/^, \$self->{'block_exp'},
92 q^extract_acronyms^, \$self->{'extract_acronyms'},
93 q^markup_acronyms^, \$self->{'markup_acronyms'},
94 q^extract_language^, \$self->{'extract_language'},
95 "allow_extra_options")) {
96
97 print STDERR "\nThe $plugin_name plugin uses an incorrect general option (general options are those\n";
98 print STDERR "available to all plugins). Check your collect.cfg configuration file.\n";
99 &print_general_usage($plugin_name);
100 die "\n";
101 }
102
103 return bless $self, $class;
104}
105
106# initialize BasPlug options
107# if init() is overridden in a sub-class, remember to call BasPlug::init()
108sub init {
109 my $self = shift (@_);
110 my ($verbosity) = @_;
111
112 # verbosity is passed through from the processor
113 $self->{'verbosity'} = $verbosity;
114
115 # set process_exp and block_exp to defaults unless they were
116 # explicitly set
117
118 if ((!$self->is_recursive()) and
119 (!defined $self->{'process_exp'}) || ($self->{'process_exp'} eq "")) {
120
121 $self->{'process_exp'} = $self->get_default_process_exp ();
122 if ($self->{'process_exp'} eq "") {
123 warn ref($self) . " Warning: Non-recursive plugin has no process_exp\n";
124 }
125 }
126
127 if ((!defined $self->{'block_exp'}) || ($self->{'block_exp'} eq "")) {
128 $self->{'block_exp'} = $self->get_default_block_exp ();
129 }
130
131 # handle input_encoding aliases
132 $self->{'input_encoding'} = "iso_8859_1" if $self->{'input_encoding'} eq "Latin1";
133 $self->{'input_encoding'} = "windows_1256" if $self->{'input_encoding'} eq "Arabic";
134}
135
136sub begin {
137 my $self = shift (@_);
138 my ($pluginfo, $base_dir, $processor, $maxdocs) = @_;
139}
140
141sub end {
142 my ($self) = @_;
143}
144
145# this function should be overridden to return 1
146# in recursive plugins
147sub is_recursive {
148 my $self = shift (@_);
149
150 return 0;
151}
152
153sub get_default_block_exp {
154 my $self = shift (@_);
155
156 return "";
157}
158
159sub get_default_process_exp {
160 my $self = shift (@_);
161
162 return "";
163}
164
165# The BasPlug read() function. This function does all the right things
166# to make general options work for a given plugin. It calls the process()
167# function which does all the work specific to a plugin (like the old
168# read functions used to do). Most plugins should define their own
169# process() function and let this read() function keep control.
170#
171# recursive plugins (e.g. RecPlug) and specialized plugins like those
172# capable of processing many documents within a single file (e.g.
173# GMLPlug) should normally implement their own version of read()
174#
175# Return number of files processed, undef if can't process
176# Note that $base_dir might be "" and that $file might
177# include directories
178
179sub read {
180 my $self = shift (@_);
181 my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs) = @_;
182
183 if ($self->is_recursive()) {
184 die "BasPlug::read function must be implemented in sub-class for recursive plugins\n";
185 }
186
187 my $filename = &util::filename_cat($base_dir, $file);
188 return 0 if $self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/;
189 if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
190 return undef;
191 }
192 my $plugin_name = ref ($self);
193 $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
194
195 # create a new document
196 my $doc_obj = new doc ($filename, "indexed_doc");
197
198 # read in file ($text will be in utf8)
199 my $text = "";
200 $self->read_file ($filename, \$text);
201
202 if ($text !~ /\w/) {
203 print STDERR "$plugin_name: ERROR: $file contains no text\n" if $self->{'verbosity'};
204 return 0;
205 }
206
207 # include any metadata passed in from previous plugins
208 # note that this metadata is associated with the top level section
209 $self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
210
211 # do plugin specific processing of doc_obj
212 return undef unless defined ($self->process (\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj));
213
214 # do any automatic metadata extraction
215 $self->auto_extract_metadata ($doc_obj);
216
217 # add an OID
218 $doc_obj->set_OID();
219
220 # process the document
221 $processor->process($doc_obj);
222
223 return 1; # processed the file
224}
225
226# returns undef if file is rejected by the plugin
227sub process {
228 my $self = shift (@_);
229 my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
230
231 die "Basplug::process function must be implemented in sub-class\n";
232
233 return undef; # never gets here
234}
235
236# uses the multiread package to read in the entire file pointed to
237# by filename and loads the resulting text into $$textref. Input text
238# may be in any of the encodings handled by multiread, output text
239# will be in utf8
240sub read_file {
241 my $self = shift (@_);
242 my ($filename, $textref) = @_;
243
244 $$textref = "";
245
246 open (FILE, $filename) || die "BasPlug::read_file could not open $filename for reading ($!)\n";
247
248 if ($self->{'input_encoding'} eq "ascii") {
249 undef $/;
250 $$textref = <FILE>;
251 $/ = "\n";
252 } else {
253 my $reader = new multiread();
254 $reader->set_handle ('BasPlug::FILE');
255 $reader->set_encoding ($self->{'input_encoding'});
256 $reader->read_file ($textref);
257
258 if ($self->{'input_encoding'} eq "gb") {
259 # segment the Chinese words
260 $$textref = &cnseg::segment($$textref);
261 }
262 }
263
264 close FILE;
265}
266
267# add any extra metadata that's been passed around from one
268# plugin to another.
269# extra_metadata uses add_utf8_metadata so it expects metadata values
270# to already be in utf8
271sub extra_metadata {
272 my $self = shift (@_);
273 my ($doc_obj, $cursection, $metadata) = @_;
274
275 foreach my $field (keys(%$metadata)) {
276 # $metadata->{$field} may be an array reference
277 if (ref ($metadata->{$field}) eq "ARRAY") {
278 map {
279 $doc_obj->add_utf8_metadata ($cursection, $field, $_);
280 } @{$metadata->{$field}};
281 } else {
282 $doc_obj->add_utf8_metadata ($cursection, $field, $metadata->{$field});
283 }
284 }
285}
286
287# extract acronyms (and hopefully other stuff soon too).
288sub auto_extract_metadata {
289 my $self = shift (@_);
290 my ($doc_obj) = @_;
291
292 if ($self->{'extract_acronyms'}) {
293 my $thissection = $doc_obj->get_top_section();
294 while (defined $thissection) {
295 my $text = $doc_obj->get_text($thissection);
296 $self->extract_acronyms (\$text, $doc_obj, $thissection) if $text =~ /./;
297 $thissection = $doc_obj->get_next_section ($thissection);
298 }
299 }
300
301 if ($self->{'markup_acronyms'}) {
302 my $thissection = $doc_obj->get_top_section();
303 while (defined $thissection) {
304 my $text = $doc_obj->get_text($thissection);
305 $text = $self->markup_acronyms ($text, $doc_obj, $thissection);
306 $doc_obj->delete_text($thissection);
307 $doc_obj->add_text($thissection, $text);
308 $thissection = $doc_obj->get_next_section ($thissection);
309 }
310 }
311
312 if ($self->{'extract_language'}) {
313 my $thissection = $doc_obj->get_top_section();
314 while (defined $thissection) {
315 my $text = $doc_obj->get_text($thissection);
316 $self->extract_language (\$text, $doc_obj, $thissection) if $text =~ /./;
317 $thissection = $doc_obj->get_next_section ($thissection);
318 }
319 }
320
321}
322
323
324# Identify the language of a section and add it to the metadata
325sub extract_language {
326 my $self = shift (@_);
327 my ($textref, $doc_obj, $thissection) = @_;
328
329 # remove all HTML tags
330 my $text = $$textref;
331 $text =~ s/<P[^>]*>/\n/sgi;
332 $text =~ s/<H[^>]*>/\n/sgi;
333 $text =~ s/<[^>]*>//sgi;
334 $text =~ tr/\n/\n/s;
335
336 # get the language
337 my @results = textcat::classify($text);
338 @results = ("unknown") if ($#results > 2);
339
340 # create language string and remove encoding information
341 my $language = join(" or ", @results);
342 $language =~ s/\-\w+//g;
343 $doc_obj->add_utf8_metadata($thissection, "Language", $language);
344 # print "Language: ", time, "-> $language\n";
345
346}
347
348# extract acronyms from a section in a document. progress is
349# reported to STDERR based on the verbosity. both the Acronym
350# and the AcronymKWIC metadata items are created.
351
352sub extract_acronyms {
353 my $self = shift (@_);
354 my ($textref, $doc_obj, $thissection) = @_;
355
356 print STDERR " extracting acronyms ...\n"
357 if ($self->{'verbosity'} >= 2);
358
359 my $acro_array = &acronym::acronyms($textref);
360
361 foreach my $acro (@$acro_array) {
362
363 #check that this is the first time ...
364 my $seen_before = "false";
365 my $previous_data = $doc_obj->get_metadata($thissection, "Acronym");
366 foreach my $thisAcro (@$previous_data) {
367 if ($thisAcro eq $acro->to_string())
368 {
369 $seen_before = "true";
370 print STDERR " already seen ". $acro->to_string() . "\n"
371 if ($self->{'verbosity'} >= 2);
372 }
373 }
374
375 if ($seen_before eq "false")
376 {
377 #write it to the file ...
378 $acro->write_to_file();
379
380 #do the normal acronym
381 $doc_obj->add_utf8_metadata($thissection, "Acronym", $acro->to_string());
382 print STDERR " adding ". $acro->to_string() . "\n"
383 if ($self->{'verbosity'} >= 1);
384
385# # do the KWIC (Key Word In Context) acronym
386# my @kwic = $acro->to_string_kwic();
387# foreach my $kwic (@kwic) {
388# $doc_obj->add_utf8_metadata($thissection, "AcronymKWIC", $kwic);
389# print STDERR " adding ". $kwic . "\n"
390# if ($self->{'verbosity'} >= 2);
391# }
392 }
393 }
394 print STDERR " done extracting acronyms. \n"
395 if ($self->{'verbosity'} >= 2);
396}
397
398sub markup_acronyms {
399 my $self = shift (@_);
400 my ($text, $doc_obj, $thissection) = @_;
401
402 print STDERR " marking up acronyms ...\n"
403 if ($self->{'verbosity'} >= 2);
404
405 #self is passed in to check for verbosity ...
406 $text = &acronym::markup_acronyms($text, $self);
407
408 print STDERR " done marking up acronyms. \n"
409 if ($self->{'verbosity'} >= 2);
410
411 return $text;
412}
413
4141;
Note: See TracBrowser for help on using the repository browser.