source: trunk/gsdl/perllib/plugins/EMAILPlug.pm@ 638

###########################################################################
#
# EMAILPlug.pm - a plugin for parsing email files
#
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 1999 New Zealand Digital Library Project
#
# 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.
#
###########################################################################


#
# EMAILPlug reads an email file (*.email)
#
# Version 1.1   1999 Sep 20  by Gordon Paynter ([email protected])
#                            loosely based on the original HTMLPlug code
#
# Document text:
#   The document text consists of all the text occuring after the first 
#   blank line in this document.
#
# Metadata:
#   $Subject      Subject: header
#   $To           To: header
#   $From         From: header - this will be stored as Creator
#   $DateText     Date: header
#   $Date         Date: header in GSDL format (eg: 19990924)
#   $OtherHeaders All the other headers
#   $NewText      The unquoted text in this message
#


package EMAILPlug;

use BasPlug;
use sorttools;
use util;


# EMAILPlug is a sub-class of BasPlug.

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


# Create a new EMAILPlug object with which to parse a file.
# This is done by creating a new BasPlug and usig bless to 
# turn it into an EMAILPlug.

sub new {
    my ($class) = @_;
    $self = new BasPlug ();

    return bless $self, $class;
}


# Is the EMAILPlug recursive?  No.

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

    return 0; # this is not a recursive plugin
}


#
# read
#
# read attempts to read a file and store its contents in a 
# new document object.
#
# Returns: number of files processed or undef if can't process
# This plugin only processes one file at a time.
#
# Note: $base_dir might be "" and $file might include directories,
# but that doesn't affect EMAILPlug
#

sub read {
    my $self = shift (@_);
    my ($pluginfo, $base_dir, $file, $metadata, $processor) = @_;

    # Make sure file exists and is an email file
    my $filename = &util::filename_cat($base_dir, $file);
    return undef unless ($filename =~ /\.email$/i && (-e $filename));

    print STDERR "EMAILPlug: processing $filename\n" if $processor->{'verbosity'};

    # create a new document object
    my $doc_obj = new doc ($file, "indexed_doc");
    open (FILE, $filename) || die "EMAILPlug::read - can't open $filename\n";
    my $cursection = $doc_obj->get_top_section();

    # Metadata fields 
    my $Subject = "";
    my $To = "";
    my $From = ""; 
    my $DateText = "";
    my $Date = "";
    my $OtherHeaders = "";
    my $NewText = "";
    my $text = "";
    my $line = "";

    my $headers_read = 0;
    
    # Read and process each line in te email file.
    # Each file consists of a set of header lines, then a blank line, 
    # then the body of the email.
    while (<FILE>) {
    
    $line = $_;
    
    # Remove carriage returns from the line.
    # We will later replace single cariage returns with <BR> tags
    # and double carriage returns with <P> tags.
    $line =~ s/\n/ /g;

        if ($headers_read) {
        # The headers have been read, so add this line to the body text
        $text .= "$line\n";
            # If the line isn't quoted, add it to the NewText metadata
        if ($line =~ /^[^>|]/) {
        $NewText .= "$line\n";
        }
        
    } elsif ($line =~ /^\s*$/) {
        # An empty line signals the end of the headers.
        $headers_read = 1;

    } else {
        # Read a line of header information and add it to the metadata
        $line .= "\n";
        if ($line =~ /^From:/) {
        $line =~ s/^From:\s*//;
        $From .= $line;
        } elsif ($line =~ /^To:/) {
        $line =~ s/^To:\s*//;
        $To .= $line;
        } elsif ($line =~ /^Date:/) {
        $line =~ s/^Date:\s*//;
        $DateText .= $line;
        if ($Date !~ /\d+/) {
            # Convert the date text to internal date format
            my ($day, $month, $year) = $line =~ /(\d?\d)\s([A-Z][a-z][a-z])\s(\d\d\d\d)/;
            $Date = &sorttools::format_date($day, $month, $year);
        }
        } elsif ($line =~ /^Subject:/) {
        $line =~ s/^Subject:\s*//;
        $Subject .= $line;
        } else {
        $OtherHeaders .= $line;
        }
    }   
    }

    # Add Subject metadata
    $Subject = &text_into_html($Subject);
    $Subject = "No Subject" unless ($Subject =~ /\w/);
    $doc_obj->add_metadata ($cursection, "Subject", $Subject);
    
    # Add Sender
    $From = &text_into_html($From);
    $From = "No Sender" unless ($From =~ /\w/);
    $doc_obj->add_metadata ($cursection, "Creator", $From);

    # Add Recipient
    $To = &text_into_html($To);
    $To = "No Recipient" unless ($To =~ /\w/);
    $doc_obj->add_metadata ($cursection, "To", $To);

    # Add Date Text
    $DateText =~ &text_into_html($Date);
    $doc_obj->add_metadata ($cursection, "DateText", $DateText) if ($DateText =~ /\w/);

    # Add Date 
    $Date =~ &text_into_html($Date);
    $doc_obj->add_metadata ($cursection, "Date", $Date) if ($Date =~ /\w/);

    # Add Other Headers
    $OtherHeaders = &text_into_html($OtherHeaders);
    $doc_obj->add_metadata ($cursection, "OtherHeaders", $OtherHeaders) if ($OtherHeaders =~ /\w/);
    
    # Add New Text
    $NewText = &text_into_html($NewText);
    $doc_obj->add_metadata ($cursection, "NewText", $NewText) if ($NewText =~ /\w/);

    # Add text
    $text =~ s/<BR>\s*<BR>/<P>/g;
    $text = &text_into_html($text);
    $doc_obj->add_text ($cursection, $text) if ($text =~ /\w/);
    
    # Add the OID - that is, the big HASH value used as a unique ID
    $doc_obj->set_OID ();

    # Process the document
    $processor->process($doc_obj);

    return 1; # processed the file
}


1;



#
# Convert a text string into HTML.
#
# The HTML is going to be inserted into a GML file, so 
# we have to be careful not to use symbols like ">",
# which ocurs frequently in email messages (and use
# &gt instead.
#
# This function also turns links and email addresses into hyperlinks,
# and replaces carriage returns with <BR> tags (and multiple carriage
# returns with <P> tags).
#

sub text_into_html {
    my ($text) = @_;


    # Convert problem charaters into HTML symbols
    $text =~ s/&/&amp;/g;
    $text =~ s/</&lt;/g;
    $text =~ s/>/&gt;/g;
    $text =~ s/\"/&quot;/g;

    # convert email addresses and URLs into links
    $text =~ s/([\w\d\.\-]+@[\w\d\.\-]+)/<a href=\"mailto:$1\">$1<\/a>/g;
    $text =~ s/(http:\/\/[\w\d\.\-]+[\/\w\d\.\-]*)/<a href=\"$1">$1<\/a>/g;

    # Clean up whitespace and convert \n charaters to <BR> or <P>
    $text =~ s/ +/ /g;
    $text =~ s/\s*$//; 
    $text =~ s/^\s*//; 
    $text =~ s/\n/\n<BR>/g;
    $text =~ s/<BR>\s*<BR>/<P>/g;

    return $text;
}