#!/usr/bin/env perl
#-*-perl-*-

=encoding utf-8

=head1 NAME

pdf2xml - extract texts from PDF files and put them in XML

=head1 SYNOPSIS

 pdf2xml [OPTIONS] pdf-file > output.xml

=head1 OPTIONS

 -h ............. skip de-hypenation (keep hyphenated words)
 -l lexicon ..... provide a list of words or a text in the target language
 -L ............. skip lowercasing (which is switched in by default)
 -m ............. skip merging character sequences (not recommended)
 -r ............. skip 'pdftotext -raw' (not recommended)
 -x ............. skip standard 'pdftotext'
 -v ............. verbose output

=head1 DESCRIPTION

pdf2xml calls pdftotext and Apache Tika to extract text from PDf files and to convert them to XML (actually XHTML). It also uses some heuristics to find words that should not be split into character sequences (which often happens with pdf-text extraction tools) and it also tries to put hyphenated words together.

Example: raw is without cleanup heuristics

  raw:    <p>PRESENTATION ET R A P P E L DES PRINCIPAUX RESULTATS 9</p>
  clean:  <p>PRESENTATION ET RAPPEL DES PRINCIPAUX RESULTATS 9</p>

  raw:    <p>2. Les c r i t è r e s de choix : la c o n s o m m a t i o n 
             de c o m b u s - t ib les et l e u r moda l i t é 
             d ' u t i l i s a t i on d 'une p a r t , 
             la concen t r a t ion d ' a u t r e p a r t 16</p>

  clean:  <p>2. Les critères de choix : la consommation 
             de combustibles et leur modalité 
             d'utilisation d'une part, 
             la concentration d'autre part 16</p>

=head1 TODO

This is quite slow and loading Apache Tika for each conversion is not very efficient. Using the server mode of Apache Tika would be a solution.

Character merging heuristics are very simple. Using the longest string forming a valid word from the vocabulary may lead to many incorrect words in context for some languages. Also, the implementation of the merging procedure is probably not the most efficient one.

De-hyphenation heuristics could also be improved. The problem is to keep it as language-independent as possible.

=head1 SEE ALSO

Apache Tika: L<http://tika.apache.org>

XPDF (which includes pdftotext): L<http://www.foolabs.com/xpdf/>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2013 by Joerg Tiedemann

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.

=cut

use strict;

use FindBin qw/$Bin/;
use IPC::Open2;
use XML::Parser;
use XML::Writer;

use vars qw($opt_h $opt_L $opt_l $opt_m $opt_r $opt_x $opt_v);
use Getopt::Std;
getopts('hLl:mrxv');

# home of shared data (where Apache Tika should be)

my $SHARED_HOME;
eval{ 
    require File::ShareDir; 
    $SHARED_HOME = File::ShareDir::dist_dir('PDF2XML'); 
};
unless (-d $SHARED_HOME){
    $SHARED_HOME = $Bin.'/share';
}

my $JAVA     = 'java';
my $TIKA     = $SHARED_HOME.'/lib/tika-app-1.3.jar';
my $PDF2TEXT = `which pdftotext`;chomp($PDF2TEXT);

my $pdf_file = shift(@ARGV);

# the vocabulary
my %voc=();

if ($opt_l){
    &read_vocabulary(\%voc,$opt_l);
}


# read output of 'pdftotext -raw'

unless ($opt_r || ( ! -e $PDF2TEXT ) ){
    my $pid = open2(\*OUT, undef, $PDF2TEXT,'-raw',$pdf_file,'-');
    binmode(OUT,":encoding(UTF-8)");

    my $hyphenated=undef;
    while(<OUT>){
	chomp;
	my @tok=split(/\s+/);
	if ($hyphenated){
	    $voc{$hyphenated.$tok[0]}++;
	    print STDERR "possibly hyphenated: $hyphenated -- $tok[0]\n" if ($opt_v);
	    $hyphenated=undef;
	}
	if (@tok){
	    if ($tok[-1]=~/^(.*)-/){
		$hyphenated=$1;
	    }
	}
	foreach (@tok){
	    $voc{$_}++;
	}
    }
    close(OUT);
    waitpid( $pid, 0 );
}


# read output of standard 'pdftotext' (or Tika if no pdftotext is available)

unless ($opt_x){

    my $pid = ( -e $PDF2TEXT ) ? 
	open2(\*OUT, undef, 'pdftotext',$pdf_file,'-') :
	open2(\*OUT, undef, 'java','-jar',$TIKA,'-x',$pdf_file);

    binmode(OUT,":encoding(UTF-8)");

    while(<OUT>){
	chomp;
	my @words = find_words($_);
	foreach (@words){
	    $voc{$_}++;
	}
    }
    close(OUT);
    waitpid( $pid, 0 );
}



binmode(STDOUT,":encoding(UTF-8)");
my $writer = XML::Writer->new( OUTPUT => \*STDOUT, 
			       DATA_MODE => 1,
			       DATA_INDENT => 1 );


my $parser = new XML::Parser( Handlers => { 
    Default => sub{ print $_[1] },
    Char    => sub{ $_[0]->{STRING} .= $_[1] },
    Start   => \&xml_start,
    End     => \&xml_end } );


my $pid = open2(\*OUT, undef, 'java','-jar',$TIKA,'-x',$pdf_file);
$parser->parse(*OUT);

# close(OUT);
# waitpid( $pid, 0 );


sub xml_start{ 
    shift;
    $writer->startTag(shift, @_);
}

sub xml_end{
    if ($_[0]->{STRING}){

	my @words=();
	my @lines = split(/\n+/,$_[0]->{STRING});

	while (@lines){
	    my $OriginalStr     = shift(@lines);
	    my $DehyphenatedStr = undef;

	    unless ($opt_h){
		while ($OriginalStr=~/\-\s*$/ && @lines){
		    $DehyphenatedStr = $OriginalStr unless ($DehyphenatedStr);
		    $DehyphenatedStr=~s/\-\s*$//;
		    my $nextLine = shift(@lines);
		    $OriginalStr     .= "\n".$nextLine;
		    $DehyphenatedStr .= "\n".$nextLine;
		}
	    }

	    my @tok = find_words( $OriginalStr );
	    if ($DehyphenatedStr){
		my @tok2 = find_words( $DehyphenatedStr );
		@tok = @tok2 if ($#tok2 < $#tok);
	    }
	    push(@words,@tok);
	}

	if (@words){
	    $writer->characters( join(' ',@words) );
	    $_[0]->{STRING} = '';
	}
    }
    $writer->endTag($_[1]);
}

sub xml_end_simple{
    if ($_[0]->{STRING}){
	my @words = find_words( $_[0]->{STRING} );
	if (@words){
	    $writer->characters( join(' ',@words) );
	    $_[0]->{STRING} = '';
	}
    }
    $writer->endTag($_[1]);
}




sub find_words{
    my @words = ();

    my @tokens1 = split(/\s+/,$_[0]);
    return @tokens1 if ($opt_m);          # skip merging ...

    my @tokens2   = ();
    my $remaining = \@tokens1;
    my $current   = \@tokens2;

    while (@{$remaining}){
	($current,$remaining) = ($remaining,$current);
	@{$remaining} = ();
	my $str = join('',@{$current});
	$str = lc($str) unless ($opt_L);
	until (exists $voc{$str}){
	    last unless (@{$current});
	    unshift( @{$remaining}, pop(@{$current}) );
	    $str = join('',@{$current});
	    $str = lc($str) unless ($opt_L);
	}
	if ($#{$current}>0){
	    $voc{$str}++;
	    print STDERR join(' ',@{$current})," --> $str\n" if ($opt_v);
	}
	# need to restore non-lowercased version if necessary
	$str = join('',@{$current}) unless ($opt_L);
	if ($str){ push(@words,$str); }
	else{      push(@words,shift @{$remaining}); }
    }
    return @words;
}

sub read_vocabulary{
    my ($voc,$file) = @_;
    if ($file=~/\.gz$/){
	open F,"gzip -cd < $file |" || die "cannot read from $file";
	binmode(F,":encoding(UTF-8)");
    }
    else{
	open F,"<:encoding(UTF-8)",$file || die "cannot read from $file";
    }
    while (<F>){
	chomp;
	my @words = split(/\s+/);
	foreach (@words){
	    $_ = lc($_) unless ($opt_L);
	    $$voc{$_}++;
	}
    }
}

__END__
