source: trunk/gsdl/src/phind/generate/phproc.pm@ 1631

###########################################################################
#
# phproc.pm -- the Phind document processor
#
# Copyright (C) 2000 Gordon W. Paynter
# Copyright 2000 The New Zealand Digital Library Project
#
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###########################################################################

# This is the phind document processor object.  It is used by the document
# reader plugins to extract the clauses from each document.

package phproc;

use docproc;
use util;

sub BEGIN {
    @ISA = ('docproc');
}

sub new {
    my ($class, $archive_dir, $phindex_dir, $phindcfg,
    $language, $delimiter, $verbosity, $outhandle) = @_;

    my $self = new docproc ();
    
    $self->{'archive_dir'} = $archive_dir;
    $self->{'phindex_dir'} = $phindex_dir;
    $self->{'indexes'} = $phindcfg;

    $language =~ s/,/\|/g;
    $self->{'language_exp'} = $language;
    $self->{'delimiter'} = $delimiter;

    $self->{'verbosity'} = $verbosity;
    $self->{'outhandle'} = STDERR;
    $self->{'outhandle'} = $outhandle if defined $outhandle;
    
    &util::rm("$phindex_dir/clauses") if (-e "$phindex_dir/clauses");
    open(TEXT, ">$phindex_dir/clauses") 
    || die "Cannot open $phindex_dir/clauses: $!";
    $self->{'txthandle'} = TEXT;

    my $docfile = &util::filename_cat("$phindex_dir", "docs.txt");
    &util::rm($docfile) if (-e $docfile);
    open(DOCS, ">$docfile")
    || die "Cannot open $docfile: $!";
    $self->{'dochandle'} = DOCS;

   return bless $self, $class;

}

sub process {
    my $self = shift (@_);
    my ($doc_obj) = @_;

    my $verbosity = $self->{'verbosity'};
    my $top_section = $doc_obj->get_top_section();

    my $title = $doc_obj->get_metadata_element ($top_section, "Title");
    print "process: $title\n" if ($verbosity > 2);


    # only consider english-language files
    my $doclanguage = $doc_obj->get_metadata_element ($top_section, "Language");
    my $phrlanguage = $self->{'language_exp'};
    return if ($doclanguage && ($doclanguage !~ /$phrlanguage/i));
    
    # record this file
    my $total++;
    print "file $total: $file\n" if ($self->{'$verbosity'});
    
    # store object ID & title in document index file
    my $OID = $doc_obj->get_OID();
    $OID = "NULL" unless defined $OID;

    my $dochandle = $self->{'dochandle'};
    # print "dochandle: =$dochandle=\n";
    print $dochandle "<Document>\t$OID\t$title\n";
    
    # Store the text of this object
    my $indexlist = $self->{'indexes'};
    my @parts;
    my ($index, $part, $level, $field, $section, $data, $text);

    # Output the document delimiter
    my $txthandle = $self->{'txthandle'};
    print $txthandle $self->{'delimiter'}, "\n";

    # Iterarate over all the indexes specified in collect.cfg and
    # add their text to the clauses file.
    foreach $index (@$indexlist) {
    $text = "";

    # Iterate over all the feilds in each index
    @parts = split(/,/, $index);
    foreach $part (@parts) {

        # Each field has a level and a data element ((e.g. document:Title)
        ($level, $field) = split(/:/, $part);
        die unless ($level && $field);

        # Extract the text from every section
        # (In phind, document:text and section:text are equivalent)
        if ($field eq "text") {
        $data = "";
        $section = $doc_obj->get_top_section();
        while (defined($section)) {
            $data .= $doc_obj->get_text($section) . "\n";
            $section = $doc_obj->get_next_section($section);
        }
        $text .= convert_gml_to_tokens($data) . "\n";
        }

        # Extract a metadata field from a document
        elsif ($level eq "document") {
        $data = $doc_obj->get_metadata_element($doc_obj->get_top_section(), $field);
        $text .= convert_gml_to_tokens($data) . "\n";
        } 
        
        # Extract metadata from every section in a document
        elsif ($level eq "section") {
        $data = "";
        $section = $doc_obj->get_top_section();
        while (defined($section)) {
            $data .= $doc_obj->get_metadata_element($section, $field) . "\n";
            $section = $doc_obj->get_next_section($section);
        }
        $text .= convert_gml_to_tokens($data) . "\n";
        } 
        
        # Some sort of specification which I don't understand
        else {
        die "Unknown level ($level) in phind key ($part) in phind index ($index)\n";
        }

    }

    # print the text
    print $txthandle "$text";

    }
}



sub convert_gml_to_tokens {
    
    $_ = shift @_;

    # FIRST, remove GML tags

    # Replace all whitespace with a simple space
    s/\s+/ /gs;

    # Remove everything that is in a tag
    s/\s*<p>\s*/ PARAGRAPHBREAK /isg;
    s/\s*<br>\s*/ LINEBREAK /isg;
    s/<[^>]*>/ /sg;

    # Now we have the text, but it may contain HTML 
    # elements coded as &gt; etc.  Remove these tags. 
    s/&lt;/</sg;
    s/&gt;/>/sg;

    s/\s+/ /sg;
    s/\s*<p>\s*/ PARAGRAPHBREAK /isg;
    s/\s*<br>\s*/ LINEBREAK /isg;
    s/<[^>]*>/ /sg;

    # remove &amp; and other miscellaneous markup tags
    s/&amp;/&/sg;
    s/&lt;/</sg;
    s/&gt;/>/sg;
    s/&amp;/&/sg;

    # replace<p> and <br> placeholders with carriage returns
    s/PARAGRAPHBREAK/\n/sg;
    s/LINEBREAK/\n/sg;


    # Exceptional punctuation
    # 
    # We make special cases of some punctuation

    # remove any apostrophe that indicates omitted letters 
    s/(\w+)\'(\w*\s)/ $1$2 /g;

    # remove period that appears in a person's initals
    s/\s([A-Z])\./ $1 /g;

    # replace hyphens in hypheanted words and names with a space
    s/([A-Za-z])-\s*([A-Za-z])/$1 $2/g;


    # Convert the remaining text to "clause format",
    # This means removing all excess punctuation and garbage text,
    # normalising valid punctuation to fullstops and commas,
    # then putting one cluse on each line.

    # Insert newline when the end of a sentence is detected
    # (delimter is:  "[\.\?\!]\s")
    s/\s*[\.\?\!]\s+/\n/g; 

    # split numbers after four digits
    s/(\d\d\d\d)/$1 /g;

    # split words after 32 characters

    # squash repeated punctuation 
    tr/A-Za-z0-9 //cs;

    # save email addresses
    # s/\w+@\w+\.[\w\.]+/EMAIL/g;

    # normalise clause breaks (mostly punctuation symbols) to commas
    s/[^A-Za-z0-9 \n]+/ , /g;

    # Remove repeated commas, and replace with newline
    s/\s*,[, ]+/\n/g;

    # remove extra whitespace
    s/ +/ /sg;
    s/^\s+//mg;
    s/\s*$/\n/mg;

    # remove lines that contain one word or less
    s/^\w*$//mg;
    s/^\s*$//mg;
    tr/\n//s;

    return $_;
}



1;