root/trunk/gsdl/perllib/plugins/BasPlug.pm @ 1335

Revision 1335, 12.9 KB (checked in by say1, 20 years ago)

many acronym changes

  • Property svn:keywords set to Author Date Id Revision
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;
35
36sub print_general_usage {
37    my ($plugin_name) = @_;
38
39    print STDERR "\n  usage: plugin $plugin_name [options]\n\n";
40    print STDERR "   -input_encoding   The encoding of the source documents. Documents will be\n";
41    print STDERR "                     converted from these encodings and stored internally as\n";
42    print STDERR "                     utf8. The default input_encoding is ascii. Accepted values\n";
43    print STDERR "                     are:\n";
44    print STDERR "                        iso_8859_1 (extended ascii)\n";
45    print STDERR "                        Latin1 (the same as iso-8859-1)\n";
46    print STDERR "                        ascii (7 bit ascii -- may be faster than Latin1 as no\n";
47    print STDERR "                               conversion is neccessary)\n";
48    print STDERR "                        gb (GB or GBK simplified Chinese)\n";
49    print STDERR "                        iso_8859_6 (8 bit Arabic)\n";
50    print STDERR "                        windows_1256 (Windows codepage 1256 (Arabic))\n";
51    print STDERR "                        Arabic (the same as windows_1256)\n";
52    print STDERR "                        utf8 (either utf8 or unicode -- automatically detected)\n";
53    print STDERR "                        unicode (just unicode -- doesn't currently do endian\n";
54    print STDERR "                                 detection)\n";
55    print STDERR "   -process_exp      A perl regular expression to match against filenames.\n";
56    print STDERR "                     Matching filenames will be processed by this plugin.\n";
57    print STDERR "                     Each plugin has its own default process_exp. e.g HTMLPlug\n";
58    print STDERR "                     defaults to '(?i)\.html?\$' i.e. all documents ending in\n";
59    print STDERR "                     .htm or .html (case-insensitive).\n";
60    print STDERR "   -block_exp        Files matching this regular expression will be blocked from\n";
61    print STDERR "                     being passed to any further plugins in the list. This has no\n";
62    print STDERR "                     real effect other than to prevent lots of warning messages\n";
63    print STDERR "                     about input files you don't care about. Each plugin may or may\n";
64    print STDERR "                     not have a default block_exp. e.g. by default HTMLPlug blocks\n";
65    print STDERR "                     any files with .gif, .jpg, .jpeg, .png, .pdf, .rtf or .css\n";
66    print STDERR "                     file extensions.\n";
67    print STDERR "   -extract_acronyms Extract acronyms from within text and set as metadata\n\n";
68    print STDERR "   -extract_langauge Identify the language of the text and set as metadata\n\n";
69}
70
71# print_usage should be overridden for any sub-classes having
72# their own plugin specific options
73sub print_usage {
74    print STDERR "\nThis plugin has no plugin specific options\n\n";
75
76}
77
78sub new {
79    my $class = shift (@_);
80    my $plugin_name = shift (@_);
81
82    my $self = {};
83    my $encodings = "^(iso_8859_1|Latin1|ascii|gb|iso_8859_6|windows_1256|Arabic|utf8|unicode)\$";
84
85    # general options available to all plugins
86    if (!parsargv::parse(\@_,
87             qq^input_encoding/$encodings/ascii^, \$self->{'input_encoding'},
88             q^process_exp/.*/^, \$self->{'process_exp'},
89             q^block_exp/.*/^, \$self->{'block_exp'},
90             q^extract_acronyms^, \$self->{'extract_acronyms'},
91             q^extract_language^, \$self->{'extract_language'},
92             "allow_extra_options")) {
93
94    print STDERR "\nThe $plugin_name plugin uses an incorrect general option (general options are those\n";
95    print STDERR "available to all plugins). Check your collect.cfg configuration file.\n";
96        &print_general_usage($plugin_name);
97    die "\n";
98    }
99
100    return bless $self, $class;
101}
102
103# initialize BasPlug options
104# if init() is overridden in a sub-class, remember to call BasPlug::init()
105sub init {
106    my $self = shift (@_);
107    my ($verbosity) = @_;
108
109    # verbosity is passed through from the processor
110    $self->{'verbosity'} = $verbosity;
111
112    # set process_exp and block_exp to defaults unless they were
113    # explicitly set
114
115    if ((!$self->is_recursive()) and
116    (!defined $self->{'process_exp'}) || ($self->{'process_exp'} eq "")) {
117
118    $self->{'process_exp'} = $self->get_default_process_exp ();
119    if ($self->{'process_exp'} eq "") {
120        warn ref($self) . " Warning: Non-recursive plugin has no process_exp\n";
121    }
122    }
123
124    if ((!defined $self->{'block_exp'}) || ($self->{'block_exp'} eq "")) {
125    $self->{'block_exp'} = $self->get_default_block_exp ();
126    }
127   
128    # handle input_encoding aliases
129    $self->{'input_encoding'} = "iso_8859_1" if $self->{'input_encoding'} eq "Latin1";
130    $self->{'input_encoding'} = "windows_1256" if $self->{'input_encoding'} eq "Arabic";
131}
132
133sub begin {
134    my $self = shift (@_);
135    my ($pluginfo, $base_dir, $processor, $maxdocs) = @_;
136}
137
138sub end {
139    my ($self) = @_;
140}
141
142# this function should be overridden to return 1
143# in recursive plugins
144sub is_recursive {
145    my $self = shift (@_);
146
147    return 0;
148}
149
150sub get_default_block_exp {
151    my $self = shift (@_);
152
153    return "";
154}
155
156sub get_default_process_exp {
157    my $self = shift (@_);
158
159    return "";
160}
161
162# The BasPlug read() function. This function does all the right things
163# to make general options work for a given plugin. It calls the process()
164# function which does all the work specific to a plugin (like the old
165# read functions used to do). Most plugins should define their own
166# process() function and let this read() function keep control.
167#
168# recursive plugins (e.g. RecPlug) and specialized plugins like those
169# capable of processing many documents within a single file (e.g.
170# GMLPlug) should normally implement their own version of read()
171#
172# Return number of files processed, undef if can't process
173# Note that $base_dir might be "" and that $file might
174# include directories
175
176sub read {
177    my $self = shift (@_);
178    my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs) = @_;
179
180    if ($self->is_recursive()) {
181    die "BasPlug::read function must be implemented in sub-class for recursive plugins\n";
182    }
183
184    my $filename = &util::filename_cat($base_dir, $file);
185    return 0 if $self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/;
186    if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
187    return undef;
188    }
189    my $plugin_name = ref ($self);
190    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
191   
192    # create a new document
193    my $doc_obj = new doc ($file, "indexed_doc");
194   
195    # read in file ($text will be in utf8)
196    my $text = "";
197    $self->read_file ($filename, \$text);
198
199    if ($text !~ /\w/) {
200    print STDERR "$plugin_name: ERROR: $file contains no text\n" if $self->{'verbosity'};
201    return 0;
202    }
203
204    # include any metadata passed in from previous plugins
205    # note that this metadata is associated with the top level section
206    $self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
207
208    # do plugin specific processing of doc_obj
209    return undef unless defined ($self->process (\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj));
210
211    # do any automatic metadata extraction
212    $self->auto_extract_metadata ($doc_obj);
213
214    # add an OID
215    $doc_obj->set_OID();
216
217    # process the document
218    $processor->process($doc_obj);
219
220    return 1; # processed the file
221}
222
223# returns undef if file is rejected by the plugin
224sub process {
225    my $self = shift (@_);
226    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
227
228    die "Basplug::process function must be implemented in sub-class\n";
229
230    return undef; # never gets here
231}
232
233# uses the multiread package to read in the entire file pointed to
234# by filename and loads the resulting text into $$textref. Input text
235# may be in any of the encodings handled by multiread, output text
236# will be in utf8
237sub read_file {
238    my $self = shift (@_);
239    my ($filename, $textref) = @_;
240
241    $$textref = "";
242
243    open (FILE, $filename) || die "BasPlug::read_file could not open $filename for reading ($!)\n";
244
245    if ($self->{'input_encoding'} eq "ascii") {
246    undef $/;
247    $$textref = <FILE>;
248    $/ = "\n";
249    } else {
250    my $reader = new multiread();
251    $reader->set_handle ('BasPlug::FILE');
252    $reader->set_encoding ($self->{'input_encoding'});
253    $reader->read_file ($textref);
254
255    if ($self->{'input_encoding'} eq "gb") {
256        # segment the Chinese words
257        $$textref = &cnseg::segment($$textref);
258    }
259    }
260
261    close FILE;
262}
263
264# add any extra metadata that's been passed around from one
265# plugin to another.
266# extra_metadata uses add_utf8_metadata so it expects metadata values
267# to already be in utf8
268sub extra_metadata {
269    my $self = shift (@_);
270    my ($doc_obj, $cursection, $metadata) = @_;
271
272    foreach my $field (keys(%$metadata)) {
273    # $metadata->{$field} may be an array reference
274    if (ref ($metadata->{$field}) eq "ARRAY") {
275        map {
276        $doc_obj->add_utf8_metadata ($cursection, $field, $_);
277        } @{$metadata->{$field}};
278    } else {
279        $doc_obj->add_utf8_metadata ($cursection, $field, $metadata->{$field});
280    }
281    }
282}
283
284# extract acronyms (and hopefully other stuff soon too).
285sub auto_extract_metadata {
286    my $self = shift (@_);
287    my ($doc_obj) = @_;
288
289    if ($self->{'extract_acronyms'}) {
290    my $thissection = $doc_obj->get_top_section();
291    while (defined $thissection) {
292        my $text = $doc_obj->get_text($thissection);
293        $self->extract_acronyms (\$text, $doc_obj, $thissection) if $text =~ /./;
294        $thissection = $doc_obj->get_next_section ($thissection);
295    }
296    }
297
298    if ($self->{'extract_language'}) {
299    my $thissection = $doc_obj->get_top_section();
300    while (defined $thissection) {
301        my $text = $doc_obj->get_text($thissection);
302        $self->extract_language (\$text, $doc_obj, $thissection) if $text =~ /./;
303        $thissection = $doc_obj->get_next_section ($thissection);
304    }
305    }
306
307}
308
309
310# Identify the language of a section and add it to the metadata
311sub extract_language {
312    my $self = shift (@_);
313    my ($textref, $doc_obj, $thissection) = @_;
314
315    # remove all HTML tags
316    my $text = $$textref;
317    $text =~ s/<P[^>]*>/\n/sgi;
318    $text =~ s/<H[^>]*>/\n/sgi;
319    $text =~ s/<[^>]*>//sgi;
320    $text =~ tr/\n/\n/s;
321
322    # get the language
323    my @results = textcat::classify($text);
324    @results = ("unknown") if ($#results > 2);
325
326    my $language = join(" or ", @results);
327    $doc_obj->add_utf8_metadata($thissection, "Language",  $language);
328    print "Language: $language\n";
329
330}
331
332# extract acronyms from a section in a document. progress is
333# reported to STDERR based on the verbosity. both the Acronym
334# and the AcronymKWIC metadata items are created.
335
336sub extract_acronyms {
337    my $self = shift (@_);
338    my ($textref, $doc_obj, $thissection) = @_;
339
340    print STDERR " checking for acronyms ...\n"
341    if ($self->{'verbosity'} >= 2);
342
343    my $acro_array =  &acronym::acronyms($textref);
344
345    foreach my $acro (@$acro_array) {
346
347    #check that this is the first time ...
348    my $seen_before = "false";
349    my $previous_data = $doc_obj->get_metadata($thissection, "Acronym");
350    foreach my $thisAcro (@$previous_data) {
351        if ($thisAcro eq $acro->to_string())
352        {
353        $seen_before = "true";
354        print STDERR "  not adding ". $acro->to_string() . "\n"
355            if ($self->{'verbosity'} >= 2);
356        }       
357    }
358
359    if ($seen_before eq "false")
360    {
361        #do the normal acronym
362        $doc_obj->add_utf8_metadata($thissection, "Acronym",  $acro->to_string());
363        print STDERR "  adding ". $acro->to_string() . "\n"
364            if ($self->{'verbosity'} >= 1);
365       
366        # do the KWIC (Key Word In Context) acronym
367        my @kwic = $acro->to_string_kwic();
368        foreach my $kwic (@kwic) {
369        $doc_obj->add_utf8_metadata($thissection, "AcronymKWIC",  $kwic);
370        print STDERR "   adding ".  $kwic . "\n"
371            if ($self->{'verbosity'} >= 2);
372        }
373    }
374    }
375    print STDERR " checked for acronyms.\n"
376    if ($self->{'verbosity'} >= 2);
377}
378
3791;
Note: See TracBrowser for help on using the browser.