source: trunk/niupepa/perllib/plugins/AbstractPlug.pm@ 11745

###########################################################################
#
# AbstractPlug.pm --
# 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.
#
###########################################################################


#***************

# don't bother using this anymore - simply split up abstracts manually with
# the help of the format_abstract.pl script

#***************


# AbstractPlug processes the abstracts created for the Niupepa collection
# (they're word documents). Each series has just one word document that
# contains all the abstracts for that series.
# Word files should be named something like 01abstract.doc (the series number
# at the beginning is the important thing).

# Use this plugin (along with import.pl) to split word documents into 
# multiple files - this is done as an initial step - instead of creating
# meaningful files in the archives directory this plugin will create all the 
# split abstract files in niupepa/newabstracts. these files should then be 
# copied into the correct place in the real import directory so that import.pl
# can be rerun.
# This is kind of an ugly way to do it but NPPlug needs to know if a matching
# abstract exists when it's processing an issue and it can't know that until
# the doc files are split up by issue.

# any archives created by this plugin are an unwanted side-effect (as I'm too
# lazy to override the read() function in this plugin so BasPlug::read() will
# create an empty gml file for each doc file we process).

package AbstractPlug;

use ConvertToPlug;
use util;

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

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

    return q^(?i)\.doc$^;
}

# do plugin specific processing of doc_obj
sub process {
    my $self = shift (@_);
    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;

    my ($seriesnum) = $file =~ /^(\d+)/;
    my $dir = &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, "newabstracts", $seriesnum);

    &util::mk_all_dir ($dir) unless -d $dir;

    # clean up the html we got from the conversion process
    $self->clean_html ($textref);

    # process each issue
    $$textref =~ s/<p(?:\s[^>]*)?>\s*\n
           [^\n]+\n # series title line
           <\/p>\n
           <p(?:\s[^>]*)?>\s*\n
           <b>(.*?)<\/b>.*?\n # issue line (i.e. volume, issue number, date)
           <\/p>\n
           (<table[^>]*>.*?<\/table>)? # the table itself (may not always be defined)
              /$self->process_issue($1, $2, $seriesnum, $dir)/isgxe;
}

sub process_issue {
    my $self = shift @_;
    my ($issue, $text, $seriesnum, $dir) = @_;

    my $OID = $seriesnum . "_";

    my ($volume) = $issue =~ /vol(?:ume)?\s*\.?\s*(\d+)/i;
    if (defined $volume) {
    $OID .= $volume . "_";
#   print STDERR "volume: $volume ($issue)\n";
    } else {
    $OID .= "_";
    my $outhandle = $self->{'outhandle'};
    print $outhandle "AbstractPlug: Warning: No volume found ($issue)\n";
    }

    my ($number) = $issue =~ /(?:no|num(?:ber)?)\s*\.?\s*(\d+)/i;
    if (defined $number) {
    $OID .= $number;
#   print STDERR "number: $number ($issue)\n";
    } else {
    my $outhandle = $self->{'outhandle'};
    print $outhandle "AbstractPlug: Warning: No number found ($issue)\n";
    }

    my $abfile = &util::filename_cat ($dir, "$OID.abstract");
    open (ABFILE, ">$abfile") || die;

    # links to page numbers
    if (defined $text) {
    $text =~ s/(td(?:\s[^>]*)?>\s*\n
           <p(?:\s[^>]*)?>\s*\n)
               (pp?\s*\.\s*(\d+)(?:-\d+)?)(\s*\n)
          /$1<a href=\"_httpdocument_&cl=_cgiargcl_&d=${OID}\.$3&gg=prev\">$2<\/a>$4/isgx;

        print ABFILE $text;
    } else {
    # some don't have any abstract information - we'll just use
    # the issue line to prevent a completely empty page
        print ABFILE $issue;
    }
    close ABFILE;
}

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

    $$textref =~ s/^.*?<body[^>]*>//is; # remove html headers
    $$textref =~ s/(<div[^>]+>|<\/div>)//isg; # don't really need divs either
    $$textref =~ s/\s*?border=\"\d+\"//igs; # many tables have borders that we don't want
    $$textref =~ s/\s*?(row|col)span=\"1\"//igs; # rowspan|colspan=1 don't seem real useful
    $$textref =~ s/\s*?line\-height:[^;]+;//igs; # don't really want hard-coded line heights either
    $$textref =~ s/(<td)/$1 valign=top/igs; # like to valign tables

    # convert macron characters to _amn_ type macros

    # the following characters aren't actually what they should be for utf-8 macron 
    # characters
    # conversion to utf-8 by wvHtml doesn't appear to correctly encode macrons.
    $$textref =~ s/\xC3\xA2/_amn_/g;
    $$textref =~ s/\xC3\xA7/_emn_/g;
    $$textref =~ s/\xC3\xB4/_omn_/g;
    $$textref =~ s/\xC3\xBB/_umn_/g;
    $$textref =~ s/\xC3\x94/_Omn_/g;

    # there might also be some umlauts used in some places
    $$textref =~ s/\xC3\xAF/_imn_/g;

    # pound sign
    $$textref =~ s/\xC2\xA3/&\#163/g;

    # check if we've missed any (if this warning is triggered then the corresponding 
    # character(s) should be added to the above lists
    if ($$textref =~ /([^\x00-\x7F])/) {
    my $outhandle = $self->{'outhandle'};
    print $outhandle "AbstractPlug: Warning: multibyte character found which ";
    print $outhandle "could not be processed ($1)\n";
    }

    $$textref =~ s/\n+/\n/g; # remove all those extra blank lines
}


1;