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

###########################################################################
#
# 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 strict;
no strict 'refs'; # allow filehandles to be variables and viceversa

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

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

my $options = { 'name'     => "TEXTPlug",
        'desc'     => "{TEXTPlug.desc}",
        'abstract' => "no",
        'inherits' => "yes",
        'srcreplaceable' => "yes", # Source docs in regular txt format can be replaced with GS-generated html
        'args'     => $arguments };


sub new {
    my ($class) = shift (@_);
    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
    push(@$pluginlist, $class);

    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};

    my $self = new BasPlug($pluginlist, $inputargs, $hashArgOptLists);

    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, $gli) = @_;
    my $outhandle = $self->{'outhandle'};

    print STDERR "<Processing n='$file' p='TEXTPlug'>\n" if ($gli);
    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/\[/&#91;/g;
        $title =~ s/\[/&#93;/g;
        $title =~ s/\</&#60;/g;
        $title =~ s/\>/&#62;/g;
    $doc_obj->add_utf8_metadata ($cursection, "Title", $title);
    }
    # Add FileFormat metadata
    $doc_obj->add_metadata($cursection, "FileFormat", "TEXT");

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

    return 1;
}

sub text_to_html {
    my $self = shift (@_);
    my ($textref) = @_;
    
    # 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
    $$textref = "<pre>\n$$textref\n</pre>";
}


# replace_srcdoc_with_html.pl requires all subroutines that support src_replaceable
# to contain a method called tmp_area_convert_file - this is indeed the case with all
# Perl modules that are subclasses of ConvertToPlug.pm, but as we want TEXTPlug to also
# be srcreplaceable and because TEXTPlug does not inherit from ConvertToPlug.pm, we have
# a similar subroutine with the same name here.
sub tmp_area_convert_file {
    my $self = shift (@_);
    my ($output_ext, $input_filename) = @_;
    
    my $outhandle = $self->{'outhandle'};
    #my $failhandle = $self->{'failhandle'};
    
    # derive output filename from input filename
    my ($tailname, $dirname, $suffix)
    = &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");

    # softlink to collection tmp dir
    my $tmp_dirname = $dirname;
    if(defined $ENV{'GSDLCOLLECTDIR'}) {
    $tmp_dirname = $ENV{'GSDLCOLLECTDIR'};
    } elsif(defined $ENV{'GSDLHOME'}) {
    $tmp_dirname = $ENV{'GSDLHOME'};
    }
    $tmp_dirname = &util::filename_cat($tmp_dirname, "tmp");
    &util::mk_dir($tmp_dirname) if (!-e $tmp_dirname);


    # convert to utf-8 otherwise we have problems with the doc.xml file
    # later on
    &unicode::ensure_utf8(\$tailname); # TODO: does this change the filename or not?
             # need to test this out on a windows computer using a Greek filename

    my $tmp_filename = &util::filename_cat($tmp_dirname, "$tailname$suffix"); 
    &util::soft_link($input_filename, $tmp_filename);
    # softlink symbolic link to or copy of original, so we don't accidentally damage it

    #my $output_filename = $tailname$output_ext;#output_ext has to be html!
    my $output_filename = &util::filename_cat($tmp_dirname, $tailname.".html");
    
    # read contents of text file line by line into an array
    # create an HTML file from the text file
    # Recreate the original file for writing the updated contents
    unless(open(TEXT, "<$tmp_filename")) { # open it as a new file for writing
    print STDERR "TEXTPlug.pm: Unable to open and read from $input_filename for converting to html...ERROR\n";
    return ""; # no file name
    }

    my $text;
    { 
    local $/ = undef; # Read entire file at once. This is from http://perl.plover.com/local.html
    $text = <TEXT>;  # Now file is read in as one single 'line'
    }
    close(TEXT); # close the file
   
    # convert the text
    $self->text_to_html(\$text);
       
    #print STDERR "****output_filename: $output_filename\n";
    #print STDERR "****text: $text\n";

    # try creating this new file writing and try opening it for writing, else exit with error value
    unless(open(HTML, ">$output_filename")) {  # open the new html file for writing
    print STDERR "TEXTPlug.pm: Unable to create $output_filename for writing $tailname$suffix txt converted to html...ERROR\n";
    return ""; # no filename
    }
    # write the html contents in text out to the file
    print HTML $text; 
    close HTML;

    # remove the copy of the original file/remove the symbolic link to original file
    &util::rm($tmp_filename);

    return $output_filename; # return the output file path
}


1;