#!/usr/bin/perl -w

###########################################################################
#
# gsConvert.pl -- convert documents to HTML or TEXT format
#
# 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.
#
###########################################################################

# gsConvert.pl converts documents in a range of formats to HTML or TEXT
# by exploiting third-party programs.  These are usually found in the
# $GSDLHOME/packages directory.
#
# Currently, we can convert Microsoft Word and Adobe PDF using specialised
# conversion utilities.   We can convery any file to text with a perl 
# implementation of the UNIX strings command.
#
# We try to convert Postscript files to text using "gs" which is often on
# *nix machines. If it isn't (or we're running on Windoze), we do some feeble
# text extraction on it using regexps.

BEGIN {
    die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
    unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
}

use parsargv;
use util;
use Cwd;
use File::Basename;


sub print_usage
{
    print STDERR "\n";
    print STDERR "gsConvert.pl: Converts documents in a range of formats to html\n";
    print STDERR "              or text using third-party programs.\n\n";
    print STDERR "  usage: $0 [options] filename\n";
    print STDERR "  options:\n\t-type\tdoc|pdf|ps|rtf\n\t-output\thtml|text\n";
    print STDERR "\t-timeout\t<max cpu seconds>\n";
    exit(1);
}


sub main
{
    my (@ARGV) = @_;
    my ($input_type,$output_type,$verbose,$timeout);

    $timeout = 0;
    # read command-line arguments
    if (!parsargv::parse(\@ARGV,
			 'type/(doc|pdf|ps|rtf)/', \$input_type,
			 'output/(html|text)/', \$output_type,
			 'timeout/\d+/0',\$timeout,
			 'verbose/\d+/0',   \$verbose))
    {
	print_usage();
    }

    # Make sure the input file exists and can be opened for reading
    if (scalar(@ARGV!=1)) {
	print_usage();
    }

    my $input_filename = $ARGV[0];
    if (!-r $input_filename) {
	print STDERR "Error: unable to open $input_filename for reading\n";
	exit(1);
    }

    # Deduce filenames
    my ($tailname,$dirname,$suffix) 
	= File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
    my $output_filestem = &util::filename_cat($dirname, "$tailname");

    if ($input_type eq "")
    {
	$input_type = lc (substr($suffix,1,length($suffix)-1));
    }
    
    # Change to temporary working directory
    my $stored_dir = cwd();
    chdir ($dirname) || die "Unable to change to directory $dirname";
    
    # Select convert utility
    if (!defined $input_type) {
	print STDERR "Error: No filename extension or input type defined\n";
	exit(1);
    } 
    elsif ($input_type eq "doc") {
	print &convertDOC($input_filename, $output_filestem, $output_type);
	print "\n";
    } 
    elsif ($input_type eq "rtf") {
	print &convertRTF($input_filename, $output_filestem, $output_type);
	print "\n";
    } 
    elsif ($input_type eq "pdf") {
	print &convertPDF($dirname, $input_filename, $output_filestem, $output_type);
	print "\n";
    } 
    elsif ($input_type eq "ps") {
	print &convertPS($input_filename, $output_filestem, $output_type);
	print "\n";
    } 
    else {
	print STDERR "Error: Unable to convert type '$input_type'\n";
	exit(1);
    }
    
    # restore to original working directory
    chdir ($stored_dir) || die "Unable to return to directory $stored_dir";

}

&main(@ARGV);



# Document-type conversion functions
#
# The following functions attempt to convert documents from their
# input type to the specified output type.  If no output type was
# given, then they first attempt HTML, and then TEXT.
#
# Each returns the output type ("html" or "text") or "fail" if no 
# conversion is possible.

# Convert a Microsoft word document

sub convertDOC {
    ($input_filename, $output_filestem, $output_type) = @_;

    # Many .doc files are not in fact word documents!
    my $realtype = &find_docfile_type($input_filename);

    if ($realtype eq "word6" || $realtype eq "word7" || $realtype eq "word8") {
	return &convertWord678($input_filename, $output_filestem, $output_type);
    } elsif ($realtype eq "rtf") {
	return &convertRTF($input_filename, $output_filestem, $output_type);
    } else {
	return &convertAnything($input_filename, $output_filestem, $output_type);
    }
}

# Convert a Microsoft word 6/7/8 document

sub convertWord678 {
    ($input_filename, $output_filestem, $output_type) = @_;

    my $success = 0;

    # Attempt specialised conversion to HTML
    if (!$output_type || ($output_type =~ /html/i)) {
	$success = &doc_to_html($input_filename, $output_filestem);
	if ($success) {
	    return "html";
	}
    }

    return &convertAnything($input_filename, $output_filestem, $output_type);
}


# Convert a Rich Text Format (RTF) file

sub convertRTF {
    ($input_filename, $output_filestem, $output_type) = @_;

    my $success = 0;

    # Attempt specialised conversion to HTML
    if (!$output_type || ($output_type =~ /html/i)) {
	$success = &rtf_to_html($input_filename, $output_filestem);
	if ($success) {
	    return "html";
	}
    }

    return &convertAnything($input_filename, $output_filestem, $output_type);
}


# Convert an unidentified file

sub convertAnything {
    ($input_filename, $output_filestem, $output_type) = @_;
    
    my $success = 0;
    
    # Attempt simple conversion to HTML
    if (!$output_type || ($output_type =~ /html/i)) {
	$success = &any_to_html($input_filename, $output_filestem);
	if ($success) {
	    return "html";
	}
    }

    # Convert to text
    if (!$output_type || ($output_type =~ /text/i)) {
	$success = &any_to_text($input_filename, $output_filestem);
	if ($success) {
	    return "text";
	}
    }
    return "fail";
}



# Convert an Adobe PDF document

sub convertPDF {
    ($dirname, $input_filename, $output_filestem, $output_type) = @_;

    my $success = 0;

    # Attempt conversion to HTML
    if (!$output_type || ($output_type =~ /html/i)) {
	$success = &pdf_to_html($dirname, $input_filename, $output_filestem);
	if ($success) {
	    return "html";
	}
    }

    # Attempt conversion to TEXT
    if (!$output_type || ($output_type =~ /text/i)) {
	$success = &pdf_to_text($dirname, $input_filename, $output_filestem);
	if ($success) {
	    return "text";
	}
    }

    return "fail";

}


# Convert an Adobe PostScript document

sub convertPS {
    ($input_filename, $output_filestem, $output_type) = @_;

    my $success = 0;

    # Attempt conversion to TEXT
    if (!$output_type || ($output_type =~ /text/i)) {
	$success = &ps_to_text($input_filename, $output_filestem);
	if ($success) {
	    return "text";
	}
    }

    return "fail";

}


# Find the real type of a .doc file
#
# We seem to have a lot of files with a .doc extension that are .rtf 
# files or Word 5 files.  This function attempts to tell the difference.

sub find_docfile_type {
    ($input_filename) = @_;
    
    open(CHK, "<$input_filename");
    binmode(CHK);
    my $line = "";
    my $first = 1;

    while (<CHK>) {
    
	$line = $_;

	if ($first) {
	    # check to see if this is an rtf file
	    if ($line =~ /^\{\\rtf/) {
		close(CHK);
		return "rtf";
	    }
	}
	
	# is this is a word 6/7/8 document?
	if ($line =~ /Word\.Document\.([678])/) {
	    close(CHK);
	    return "word$1";
	}

	$first = 0;

    }

    return "unknown";
}



# Specific type-to-type conversions
#
# Each of the following functions attempts to convert a document from 
# a specific format to another.  If they succeed yhey return 1 and leave 
# the output document(s) in the appropriate place; if they fail they 
# return 0 and delete any working files.


# Attempt to convert a word document to html with the wv program

sub doc_to_html {
    ($input_filename, $output_filestem) = @_;

    my $wvWare = &util::filename_cat($ENV{'GSDLHOME'}, "bin", 
				     $ENV{'GSDLOS'}, "wvWare");

    # don't include path on windows (to avoid having to play about
    # with quoting when GSDLHOME might contain spaces) but assume
    # that the PATH is set up correctly
    $wvWare = "wvWare" if ($ENV{'GSDLOS'} =~ /^windows$/i);

    my $wv_conf = &util::filename_cat($ENV{'GSDLHOME'}, "etc", 
				      "packages", "wv", "wvHtml.xml");
    
    my $cmd = "";
    if ($timeout) {$cmd = "ulimit -t $timeout;";}
    $cmd .= "$wvWare --charset utf-8 --config \"$wv_conf\"";
    $cmd .= " \"$input_filename\" > \"$output_filestem.html\"";
    
    # redirecting STDERR is a bad idea on windows 95/98
    $cmd .= " 2> \"$output_filestem.err\""
	if $ENV{'GSDLOS'} !~ /^windows$/i;

    # execute the command
    if (system($cmd)!=0)
    {
	print STDERR "Error executing wv converter: $!. Continuing...\n";
    }

    # Was the conversion successful?

    if (-e "$output_filestem.html") {
	open(TMP, "$output_filestem.html");
	$line = <TMP>;
	close(TMP);
	if ($line && $line =~ /DOCTYPE HTML/) {
	    &util::rm("$output_filestem.err") if -e "$output_filestem.err";
	    return 1;
	} else {
	    # An error of some sort occurred
	    &util::rm("$output_filestem.html");
	    &util::rm("$output_filestem.err") if -e "$output_filestem.err";
	}
    }

    return 0;
}


# Attempt to convert an RTF document to html with rtftohtml

sub rtf_to_html {
    my ($input_filename, $output_filestem) = @_;

    # formulate the command
    $cmd = "";
    if ($timeout) {$cmd = "ulimit -t $timeout;";}
    $cmd .= "rtftohtml";

    # it automatically uses $output_filestem.html
    $cmd .= " \"$input_filename\"";

    $cmd .= " 2>\"$output_filestem.err\""
        unless $ENV{'GSDLOS'} =~ /^windows$/i;


    # execute the command
    if (system($cmd)!=0)
    {
	print STDERR "Error executing rtf converter: $!. Continuing...\n";
    }

    &util::rm("$output_filestem.err") if (-e "$output_filestem.err");

    # Was the conversion successful?
    if (-e "$output_filestem.html") {
	return 1;
    }

    return 0;
}


# Convert a pdf file to html with the pdftohtml command

sub pdf_to_html {
    ($dirname, $input_filename, $output_filestem) = @_;

    $cmd = "";
    if ($timeout) {$cmd = "ulimit -t $timeout;";}
    $cmd .= "perl -S pdftohtml.pl -F ";
    $cmd .= " \"$input_filename\" \"$output_filestem\"";
    $!=0;

    if (system($cmd)!=0)
    {
	print STDERR "Error executing $cmd";
	if ($!) {print STDERR ": $!";} 
	print STDERR "\n";
	return 0;
    }

    # make sure the converter made something
    if (! -e "$output_filestem.html")
    {
	&util::rm("$output_filestem.out") if (-e "$output_filestem.out");
	# print out the converters std err, if any
	if (-e "$output_filestem.err") {
	    open (ERRLOG, "$output_filestem.err") || die "$!";
	    print STDERR "pdftohtml:\n";
	    while (<ERRLOG>) {
		print STDERR "$_";
	    }
	    close ERRLOG;
	}
	return 0;
    }

    &util::rm("$output_filestem.out") if (-e "$output_filestem.out");
    return 1;
}

# Convert a PDF file to text with the pdftotext command

sub pdf_to_text {
    ($dirname, $input_filename, $output_filestem) = @_;

    my $cmd = "pdftotext \"$input_filename\" \"$output_filestem.text\"";
    $cmd .= " 2> \"$output_filestem.err\"";
    
    if (system($cmd)!=0)
    {
	print STDERR "Error executing $cmd: $!\n";
	&util::rm("$output_filestem.text") if (-e "$output_filestem.text");
	&util::rm("$output_filestem.err") if (-e "$output_filestem.err");
	return 0;
    }

    # make sure the converter made something
    if (! -e "$output_filestem.text")
    {
	&util::rm("$output_filestem.out") if (-e "$output_filestem.out");
	# print out the converters std err, if any
	if (-e "$output_filestem.err") {
	    open (ERRLOG, "$output_filestem.err") || die "$!";
	    print STDERR "pdftotext:\n";
	    while (<ERRLOG>) {
		print STDERR "$_";
	    }
	    close ERRLOG;
	}
	return 0;
    }

    &util::rm("$output_filestem.err") if (-e "$output_filestem.err");
    return 1;
}

# Convert a PostScript document to text
# note - just using "ps2ascii" isn't good enough, as it
# returns 0 for a postscript interpreter error. ps2ascii is just
# a wrapper to "gs" anyway, so we use that cmd here.

sub ps_to_text {
    my ($input_filename, $output_filestem) = @_;

    my $error = "";

    # if we're on windows we'll fall straight through without attempting
    # to use gs
    if ($ENV{'GSDLOS'} =~ /^windows$/i) {
	$error = "Windows does not support gs";

    } else {
	my $cmd = "gs -q -dNODISPLAY -dNOBIND -dWRITESYSTEMDICT -dSIMPLE -c save ";
	$cmd .= "-f ps2ascii.ps \"$input_filename\" -c quit > \"$output_filestem.text\"";
	$cmd .= " 2> $output_filestem.err";
	$!=0;

	my $retcode=system($cmd);
	$retcode = $? >> 8;  # see man perlfunc - system for this...
	# if system returns -1 | 127 (couldn't start program), look at $! for message

	if ($retcode!=0) {if ($!) {$error=$!;} else {$error="couldn't run.\n";}}
	elsif (! -e "$output_filestem.text") {
	    $error="did not create output file.\n";
	}
	else 
	{   # make sure the interpreter didn't get an error. It is technically
	    # possible for the actual text to start with this, but....
	    open PSOUT, "$output_filestem.text";
	    if (<PSOUT> =~ /^Error: (.*)/) {
		$error="interpreter error - \"$1\"";
	    }
	    close PSOUT;
	}
    }

    if ($error ne "")
    {
	print STDERR "PSPlug: WARNING: Error executing gs: $error\n";
	&util::rm("$output_filestem.text") if (-e "$output_filestem.text");
	&util::rm("$output_filestem.err") if (-e "$output_filestem.err");

	# Fine then. We'll just do a lousy job by ourselves...
	# Based on 5-line regexp sed script found at:
	# http://snark.ptc.spbu.ru/mail-archives/lout/brown/msg00003.html
	# 
	print STDERR "PSPlug: Stripping text from postscript\n";
	my $errorcode=0;
	open (IN, "$input_filename") 
	    ||  ($errorcode=1, warn "Couldn't read file: $!");
	open (OUT, ">$output_filestem.text") 
	    ||  ($errorcode=1, warn "Couldn't write file: $!");
	if ($errorcode) {print STDERR "errors\n";return 0;}
	
	my $text="";  # this is for whole .ps file...
	while (<IN>) {
	    $text.=$_;
	}
	close IN;

	# Make sure this is a ps file...
	if ($text !~ /^%!/) {
	    print STDERR "Bad postscript header: not %!\n";
	    return 0;
	}

	# if ps has Page data, then use it to delete all stuff before it.
	$text =~ s/^.*?%%Page:.*?\n//s; # treat string as single line
	
	# remove all leading non-data stuff
	$text =~ s/^.*?\(//s;

	# remove all newline chars for easier processing
	$text =~ s/\n//g;
	
	# Big assumption here - assume that if any co-ordinates are
	# given, then we are at the end of a sentence.
	$text =~ s/\)-?\d+\ -?\d+/\) \(\n\)/g;

	# special characters--
	$text =~ s/\(\|\)/\(\ - \)/g; # j -> em-dash?

	# ? ps text formatting (eg italics?) ?
	$text =~ s/Fn\(f\)/\(\{\)/g; # f -> {
	$text =~ s/Fn\(g\)/\(\}\)/g; # g -> }
	$text =~ s/Fn\(j\)/\(\|\)/g; # j -> |
	# default - remove the rest
	$text =~ s/\ ?F.\((.+?)\)/\($1\)/g;

	# attempt to add whitespace between words... 
	# this is based purely on observation, and may be completely wrong...
	$text =~ s/([^F])[defghijkuy]\(/$1 \( /g;
	# eg I notice "b(" is sometimes NOT a space if preceded by a 
	# negative number.
	$text =~ s/\)\d+ ?b\(/\) \( /g;

	# change quoted braces to brackets
	$text =~ s/([^\\])\\\(/$1\{/g;
	$text =~ s/([^\\])\\\)/$1\}/g ;

	# remove everything that is not between braces
	$text =~ s/\)([^\(\)])+?\(//sg ;
	
	# remove any Trailer eof stuff.
	$text =~ s/\)[^\)]*$//sg;

	### ligatures have special characters...
	$text =~ s/\\013/ff/g;
	$text =~ s/\\014/fi/g;
	$text =~ s/\\015/fl/g;
	$text =~ s/\\016/ffi/g;
	$text =~ s/\\214/fi/g;
	$text =~ s/\\215/fl/g;
	$text =~ s/\\017/\n\* /g; # asterisk?
	$text =~ s/\\023/\023/g;  # e acute ('e)
	$text =~ s/\\177/\252/g;  # u"
#	$text =~ s/ ?? /\344/g;  # a"

	print OUT "$text";
	close OUT;
    }
    # wrap the text - use a minimum length. ie, first space after this length.
    my $wrap_length=72;
    &util::mv("$output_filestem.text", "$output_filestem.text.tmp");
    open INFILE, "$output_filestem.text.tmp" ||
	die "Couldn't open file: $!";
    open OUTFILE, ">$output_filestem.text" ||
	die "Couldn't open file for writing: $!";
    my $line="";
    while ($line=<INFILE>) {
	while (length($line)>0) {
	    if (length($line)>$wrap_length) {
		$line =~ s/^(.{$wrap_length}[^\s]*)\s*//;
		print OUTFILE "$1\n";
	    } else {
		print OUTFILE "$line";
		$line="";
	    }
	}
    }
    close INFILE;
    close OUTFILE;
    &util::rm("$output_filestem.text.tmp");

    &util::rm("$output_filestem.err") if (-e "$output_filestem.err");
    return 1;
}


# Convert any file to HTML with a crude perl implementation of the
# UNIX strings command.

sub any_to_html {
    ($input_filename, $output_filestem) = @_;

    # First generate a text file
    return 0 unless (&any_to_text($input_filename, $output_filestem));

    # create an HTML file from the text file
    open(TEXT, "<$output_filestem.text");
    open(HTML, ">$output_filestem.html");

    print HTML "<html><head>\n";
    print HTML "<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html\">\n";
    print HTML "<META NAME=\"GENERATOR\" CONTENT=\"Greenstone any_to_html\">\n";
    print HTML "</head><body>\n\n";

    while (<TEXT>) { 
	print HTML "<p> ", $_;
    }
    print HTML "\n</body></html>\n";

    close HTML;
    close TEXT;

    &util::rm("$output_filestem.text") if (-e "$output_filestem.text");
    return 1;
}

# Convert any file to TEXT with a crude perl implementation of the
# UNIX strings command.

sub any_to_text {
    ($input_filename, $output_filestem) = @_;

    open(IN, "<$input_filename");
    binmode(IN);
    open(OUT, ">$output_filestem.text");

    my ($line);
    my $dgcount = 0;
    while (<IN>) { 
	$line = $_;

	# delete anything that isn't a printable character
	$line =~ s/[^\040-\176]+/\n/sg;

	# delete any string less than 10 characters long
	$line =~ s/^.{0,9}$/\n/mg;
	while ($line =~ /^.{1,9}$/m) {
	    $line =~ s/^.{0,9}$/\n/mg;
	    $line =~ s/\n+/\n/sg;
	}

	# remove extraneous whitespace
	$line =~ s/\n+/\n/gs;
	$line =~ s/^\n//gs;

	# output whatever is left
	if ($line =~ /[^\n ]/) {
	    print OUT $line;
	}
    }

    close OUT;
    close IN;

    return 1;
}