source: trunk/gsdl/perllib/plugins/TEXTPlug.pm@ 5096

###########################################################################
#
# TEXTPlug.pm -- simple text plugin
# 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.
#
###########################################################################

# creates simple single-level document. Adds Title metadata 
# of first line of text (up to 100 characters long).

# 12/05/02 Added usage datastructure - John Thompson

package TEXTPlug;

use BasPlug;
use parsargv;


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

my $arguments =
    [ { 'name' => "process_exp",
    'desc' => "{BasPlug.process_exp}",
    'type' => "string",
    'deft' => &get_default_process_exp(),
    'reqd' => "no" } ,
      { 'name' => "title_sub",
    'desc' => "{TEXTPlug.title_sub}",
    'type' => "string",
    'deft' => "",
    'reqd' => "no" } ];

my $options = { 'name'     => "TEXTPlug",
        'desc'     => "Creates simple single-level document. Adds Title metadata of first line of text (up to 100 characters long).",
        'inherits' => "yes",
        'args'     => $arguments };

#  sub print_usage {
#      print STDERR "\n  usage: plugin TEXTPlug [options]\n\n";
#      print STDERR "  options:\n";
#      print STDERR "   -title_sub\t     Substitution expression to modify string stored as Title.\n";
#      print STDERR "\t\t     Used by, for example, PSPlug to remove \"Page 1\" etc from\n";
#      print STDERR "\t\t     text used as the title.\n";

#      print STDERR "\n";
#  }

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

    # 14-05-02 To allow for proper inheritance of arguments - John Thompson
    my $option_list = $self->{'option_list'};
    push( @{$option_list}, $options );

    if (!parsargv::parse(\@_, 
             q^title_sub/.*/^, \$self->{'title_sub'},
             "allow_extra_options")) {
    print STDERR "\nIncorrect options passed to TEXTPlug, check your collect.cfg configuration file\n";
    $self->print_txt_usage("");  # Use default resource bundle
        die "\n";
    }


    return bless $self, $class;
}

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

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

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

    print $outhandle "TEXTPlug: processing $file\n" 
    if $self->{'verbosity'} > 1;
    
    my $cursection = $doc_obj->get_top_section();
    
    # get title metadata
    # (don't need to get title if it has been passed
    # in from another plugin)
    if (!defined $metadata->{'Title'}) {
    my ($title) = $$textref;
    $title =~ /^\s+/s;
    if (defined $self->{'title_sub'} &&
           $self->{'title_sub'}) {$title =~ s/$self->{'title_sub'}//;}
    $title =~ /^\s*([^\n]*)/s; $title=$1;
    if (length($title) > 100) {
        $title = substr ($title, 0, 100) . "...";
    }
        $title =~ s/\[/[/g;
        $title =~ s/\[/]/g;
        $title =~ s/\</&#60;/g;
        $title =~ s/\>/&#62;/g;
    $doc_obj->add_utf8_metadata ($cursection, "Title", $title);
    }

    # we need to escape the escape character, or else mg will convert into
    # eg literal newlines, instead of leaving the text as '\n'
    $$textref =~ s/\\/\\\\/g; # macro language
    $$textref =~ s/_/\\_/g; # macro language
    $$textref =~ s/</&lt;/g;
    $$textref =~ s/>/&gt;/g;

    # insert preformat tags and add text to document object
    $doc_obj->add_utf8_text($cursection, "<pre>\n$$textref\n</pre>");

    return 1;
}

1;