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

###########################################################################
#
# phproc.pm -- the Phind document processor
#
# Copyright (C) 2000 Gordon Paynter
#
# 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, 
    $language, $delimiter, $verbosity, $outhandle) = @_;

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

    $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;

    &util::rm("$phindex_dir/mg-d.txt") if (-e "$phindex_dir/mg-d.txt");
    open(DOCS, ">$phindex_dir/mg-d.txt")
    || die "Cannot open $phindex_dir/mg-d.txt: $!";
    $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 > 1);


    # 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 "$OID\t$title\n";
    
    # store the text
    $text = convert_gml_to_tokens($doc_obj->get_text());

    my $txthandle = $self->{'txthandle'};
    print $txthandle $self->{'delimiter'}, "\n$text\n";
}



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;