Changeset 1279 for branches/New_Config_Format-branch/gsdl/perllib/plugins/BasPlug.pm

Timestamp:

2000-07-13T10:21:53+12:00 (24 years ago)

Author:

sjboddie

Message:

merged changes to trunk into New_Config_Format branch

File:

• branches/New_Config_Format-branch/gsdl/perllib/plugins/BasPlug.pm (modified) (2 diffs)

branches/New_Config_Format-branch/gsdl/perllib/plugins/BasPlug.pm

@@ -26 +26 @@
 package BasPlug;
 
+use parsargv;
+use multiread;
+use cnseg;
+use acronym;
+use strict;
+use doc;
+
+sub print_general_usage {
+    my ($plugin_name) = @_;
+
+    print STDERR "\n  usage: plugin $plugin_name [options]\n\n";
+    print STDERR "   -input_encoding   The encoding of the source documents. Documents will be\n";
+    print STDERR "                     converted from these encodings and stored internally as\n";
+    print STDERR "                     utf8. The default input_encoding is Latin1. Accepted values\n";
+    print STDERR "                     are:\n";
+    print STDERR "                        iso_8859_1 (extended ascii)\n";
+    print STDERR "                        Latin1 (the same as iso-8859-1)\n";
+    print STDERR "                        ascii (7 bit ascii -- may be faster than Latin1 as no\n";
+    print STDERR "                               conversion is neccessary)\n";
+    print STDERR "                        gb (GB or GBK simplified Chinese)\n";
+    print STDERR "                        iso_8859_6 (8 bit Arabic)\n";
+    print STDERR "                        windows_1256 (Windows codepage 1256 (Arabic))\n";
+    print STDERR "                        Arabic (the same as windows_1256)\n";
+    print STDERR "                        utf8 (either utf8 or unicode -- automatically detected)\n";
+    print STDERR "                        unicode (just unicode -- doesn't currently do endian\n";
+    print STDERR "                                 detection)\n";
+    print STDERR "   -process_exp      A perl regular expression to match against filenames.\n";
+    print STDERR "                     Matching filenames will be processed by this plugin.\n";
+    print STDERR "                     Each plugin has its own default process_exp. e.g HTMLPlug\n";
+    print STDERR "                     defaults to '(?i)\.html?\$' i.e. all documents ending in\n";
+    print STDERR "                     .htm or .html (case-insensitive).\n";
+    print STDERR "   -block_exp        Files matching this regular expression will be blocked from\n";
+    print STDERR "                     being passed to any further plugins in the list. This has no\n";
+    print STDERR "                     real effect other than to prevent lots of warning messages\n";
+    print STDERR "                     about input files you don't care about. Each plugin may or may\n";
+    print STDERR "                     not have a default block_exp. e.g. by default HTMLPlug blocks\n";
+    print STDERR "                     any files with .gif, .jpg, .jpeg, .png, .pdf, .rtf or .css\n";
+    print STDERR "                     file extensions.\n";
+    print STDERR "   -extract_acronyms Extract acronyms from within text and set as metadata\n\n";
+}
+
+# print_usage should be overridden for any sub-classes having 
+# their own plugin specific options
+sub print_usage {
+    print STDERR "\nThis plugin has no plugin specific options\n\n";
+
+}
 
 sub new {
-    my ($class) = @_;
-
-    return bless {}, $class;
+    my $class = shift (@_);
+    my $plugin_name = shift (@_);
+
+    my $self = {};
+    my $encodings = "^(iso_8859_1|Latin1|ascii|gb|iso_8859_6|windows_1256|Arabic|utf8|unicode)\$";
+
+    # general options available to all plugins
+    if (!parsargv::parse(\@_,
+             qq^input_encoding/$encodings/Latin1^, \$self->{'input_encoding'},
+             q^process_exp/.*/^, \$self->{'process_exp'},
+             q^block_exp/.*/^, \$self->{'block_exp'},
+             q^extract_acronyms^, \$self->{'extract_acronyms'},
+             "allow_extra_options")) {
+
+    print STDERR "\nThe $plugin_name plugin uses an incorrect general option (general options are those\n";
+    print STDERR "available to all plugins). Check your collect.cfg configuration file.\n";
+        &print_general_usage($plugin_name);
+    die "\n";
+    }
+
+    return bless $self, $class;
+}
+
+# initialize BasPlug options
+# if init() is overridden in a sub-class, remember to call BasPlug::init()
+sub init {
+    my $self = shift (@_);
+    my ($verbosity) = @_;
+
+    # verbosity is passed through from the processor
+    $self->{'verbosity'} = $verbosity;
+
+    # set process_exp and block_exp to defaults unless they were
+    # explicitly set
+
+    if ((!$self->is_recursive()) and 
+    (!defined $self->{'process_exp'}) || ($self->{'process_exp'} eq "")) {
+
+    $self->{'process_exp'} = $self->get_default_process_exp ();
+    if ($self->{'process_exp'} eq "") {
+        warn ref($self) . " Warning: Non-recursive plugin has no process_exp\n";
+    }
+    }
+
+    if ((!defined $self->{'block_exp'}) || ($self->{'block_exp'} eq "")) {
+    $self->{'block_exp'} = $self->get_default_block_exp ();
+    }
+    
+    # handle input_encoding aliases
+    $self->{'input_encoding'} = "iso_8859_1" if $self->{'input_encoding'} eq "Latin1";
+    $self->{'input_encoding'} = "windows_1256" if $self->{'input_encoding'} eq "Arabic";
 }
 
@@ -42 +137 @@
 }
 
-# return 1 if this class might recurse using $pluginfo
+# this function should be overridden to return 1
+# in recursive plugins
 sub is_recursive {
     my $self = shift (@_);
 
-    die "BasPlug::is_recursive function must be implemented in sub classes\n";
-}
-
-# return number of files processed, undef if can't process
+    return 0; 
+}
+
+sub get_default_block_exp {
+    my $self = shift (@_);
+
+    return "";
+}
+
+sub get_default_process_exp {
+    my $self = shift (@_);
+
+    return "";
+}
+
+# The BasPlug read() function. This function does all the right things
+# to make general options work for a given plugin. It calls the process()
+# function which does all the work specific to a plugin (like the old
+# read functions used to do). Most plugins should define their own 
+# process() function and let this read() function keep control.
+#
+# recursive plugins (e.g. RecPlug) and specialized plugins like those
+# capable of processing many documents within a single file (e.g.
+# GMLPlug) should normally implement their own version of read()
+#
+# Return number of files processed, undef if can't process
 # Note that $base_dir might be "" and that $file might 
 # include directories
+
 sub read {
     my $self = shift (@_);
     my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs) = @_;
 
-    die "BasPlug::read function must be implemented in sub classes\n";
-
-    return undef; # will never get here
-}
-
-sub extra_metadata
-{
-    my ($self,$doc_obj,$cursection, $metadata) = @_;
-
-    foreach $field (keys(%$metadata)) {
+    if ($self->is_recursive()) {
+    die "BasPlug::read function must be implemented in sub-class for recursive plugins\n";
+    }
+
+    my $filename = &util::filename_cat($base_dir, $file);
+    return 0 if $self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/;
+    if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
+    return undef;
+    }
+    my $plugin_name = ref ($self);
+    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
+    
+    # create a new document
+    my $doc_obj = new doc ($file, "indexed_doc");
+    
+    # read in file ($text will be in utf8)
+    my $text = "";
+    $self->read_file ($filename, \$text);
+
+    if ($text !~ /\w/) {
+    print STDERR "$plugin_name: ERROR: $file contains no text\n" if $self->{'verbosity'};
+    return 0;
+    }
+
+    # include any metadata passed in from previous plugins 
+    # note that this metadata is associated with the top level section
+    $self->extra_metadata ($doc_obj, $doc_obj->get_top_section(), $metadata);
+
+    # do plugin specific processing of doc_obj
+    return undef unless defined ($self->process (\$text, $pluginfo, $base_dir, $file, $metadata, $doc_obj));
+
+    # do any automatic metadata extraction
+    $self->auto_extract_metadata ($doc_obj);
+
+    # add an OID
+    $doc_obj->set_OID();
+
+    # process the document
+    $processor->process($doc_obj);
+
+    return 1; # processed the file
+}
+
+# returns undef if file is rejected by the plugin
+sub process {
+    my $self = shift (@_);
+    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
+
+    die "Basplug::process function must be implemented in sub-class\n";
+
+    return undef; # never gets here
+}
+
+# uses the multiread package to read in the entire file pointed to
+# by filename and loads the resulting text into $$textref. Input text
+# may be in any of the encodings handled by multiread, output text
+# will be in utf8
+sub read_file {
+    my $self = shift (@_);
+    my ($filename, $textref) = @_;
+
+    $$textref = "";
+
+    open (FILE, $filename) || die "BasPlug::read_file could not open $filename for reading ($!)\n";
+
+    if ($self->{'input_encoding'} eq "ascii") {
+    undef $/;
+    $$textref = <FILE>;
+    $/ = "\n";
+    } else {
+    my $reader = new multiread();
+    $reader->set_handle ('BasPlug::FILE');
+    $reader->set_encoding ($self->{'input_encoding'});
+    $reader->read_file ($textref);
+
+    if ($self->{'input_encoding'} eq "gb") {
+        # segment the Chinese words
+        $$textref = &cnseg::segment($$textref);
+    }
+    }
+
+    close FILE;
+}
+
+# add any extra metadata that's been passed around from one
+# plugin to another.
+# extra_metadata uses add_utf8_metadata so it expects metadata values
+# to already be in utf8
+sub extra_metadata {
+    my $self = shift (@_);
+    my ($doc_obj, $cursection, $metadata) = @_;
+
+    foreach my $field (keys(%$metadata)) {
     # $metadata->{$field} may be an array reference
     if (ref ($metadata->{$field}) eq "ARRAY") {
         map { 
-        $doc_obj->add_metadata ($cursection, $field, $_); 
+        $doc_obj->add_utf8_metadata ($cursection, $field, $_); 
         } @{$metadata->{$field}};
     } else {
-        $doc_obj->add_metadata ($cursection, $field, $metadata->{$field}); 
+        $doc_obj->add_utf8_metadata ($cursection, $field, $metadata->{$field}); 
+    }
+    }
+}
+
+# extract acronyms (and hopefully other stuff soon too).
+sub auto_extract_metadata {
+    my $self = shift (@_);
+    my ($doc_obj) = @_;
+
+    if ($self->{'extract_acronyms'}) {
+    my $thissection = $doc_obj->get_top_section();
+    while (defined $thissection) {
+        my $text = $doc_obj->get_text($thissection);
+        $self->extract_acronyms (\$text, $doc_obj, $thissection) if $text =~ /./;
+        $thissection = $doc_obj->get_next_section ($thissection);
+    }
+    }
+}
+
+sub extract_acronyms {
+    my $self = shift (@_);
+    my ($textref, $doc_obj, $thissection) = @_;
+
+    my $acro_array =  &acronym::acronyms($textref);
+
+    foreach my $acro (@$acro_array) {
+
+    #do the normal acronym
+    $doc_obj->add_utf8_metadata($thissection, "Acronym",  $acro->to_string());
+    print "found " . $acro->to_string() . "\n";
+        
+    # do the KWIC (Key Word In Context) acronym
+    my @kwic = $acro->to_string_kwic();
+    foreach my $kwic (@kwic) {
+        $doc_obj->add_utf8_metadata($thissection, "AcronymKWIC",  $kwic);
+        print "found (KWIC)" . $kwic . "\n";
     }
     }