File Coverage

blib/lib/Text/Amuse/Preprocessor.pm

Criterion	Covered	Total	%
statement	174	185	94.0
branch	59	80	73.7
condition	10	15	66.6
subroutine	35	38	92.1
pod	15	15	100.0
total	293	333	87.9

package Text::Amuse::Preprocessor;

use strict;
use warnings;

use Text::Amuse::Preprocessor::HTML;
use Text::Amuse::Preprocessor::Parser;
use Text::Amuse::Preprocessor::Typography qw/get_typography_filter/;
use Text::Amuse::Preprocessor::Footnotes;
use Text::Amuse::Functions;
use File::Spec;
use File::Temp qw();
use File::Copy qw();
use Data::Dumper;

=head1 NAME

Text::Amuse::Preprocessor - Helpers for Text::Amuse document formatting.

=head1 VERSION

Version 0.66

=cut

our $VERSION = '0.66';


=head1 SYNOPSIS

  use Text::Amuse::Preprocessor;
  my $pp = Text::Amuse::Preprocessor->new(
                                          input => $infile,
                                          output => $outfile,
                                          html           => 1,
                                          fix_links      => 1,
                                          fix_typography => 1,
                                          fix_nbsp       => 1,
                                          fix_footnotes  => 1
                                         );
  $pp->process;

=head1 DESCRIPTION

This module provides a solution to apply some common fixes to muse
files.

Without any option save for C and C (which are
mandatory), the only things the module does is to remove carriage
returns, replace character ligatures or characters which shouldn't
enter at all and expand the tabs to 4 spaces (no smart expanding).

=head1 LANGUAGE SUPPORT

The following languages are supported

=over 4

=item english

smart quotes, dashes, and the common superscripts (like 11th)

=item russian

smart quotes, dashes and non-breaking spaces

=item spanish

smart quotes and dashes

=item finnish

smart quotes and dashes

=item swedish

smart quotes and dashes

=item serbian

smart quotes and dashes

=item croatian

smart quotes and dashes

=item italian

smart quotes and dashes

=item macedonian

smart quotes and dashes

=item german

smart quotes and dashes

=back

=head1 ACCESSORS

The following values are read-only and must be passed to the constructor.

=head2 Mandatory

=head3 input

Can be a string (with the input file path) or a reference to a scalar
with the text to process).

=head3 output

Can be a string (with the output file path) or a reference to a scalar
with the processed text.

=head2 Optional

=head3 html

Before doing anything, convert the HTML input into a muse file. Even
if possible, you're discouraged to do the html import and the fixing
in the same processing. Instead, create two objects, then first do the
HTML to muse convert, save the result somewhere, add the headers, then
reprocess it with the required fixes above.

Notably, the output will be without an header, so the language will
not be detected.

Default to false.

=head3 fix_links

Find the links and add the markup if needed. Default to false.

=head3 fix_typography

Apply the typographical fixes. Default to false. This add the "smart
quotes" feature.

=head3 remove_nbsp

Remove all the non-break spaces in the document, unconditionally. This
options does not conflict with the following. If both are provided,
first the non-break spaces are removed, then reinserted.

=head3 fix_nbsp

Add non-break spaces where appropriate (whatever this means).

=head3 show_nbsp

Make the non-break spaces visible and explicit as ~~ (available on
Text::Amuse since version 0.94).

=head3 fix_footnotes

Rearrange the footnotes if needed. Default to false.

=head3 debug

Don't unlink the temporary files and be verbose

=head1 METHODS

=head2 new(%options)

Constructor. Accepts the above options.

=cut

sub new {
    my ($class, %options) = @_;
    my $self = {
                html            => 0,
                fix_links       => 0,
                fix_typography  => 0,
                fix_footnotes   => 0,
                remove_nbsp     => 0,
                show_nbsp       => 0,
                fix_nbsp        => 0,
                debug  => 0,
                input  => undef,
                output => undef,
               };
    foreach my $k (keys %$self) {
        if (exists $options{$k}) {
            $self->{$k} = delete $options{$k};
        }
    }
    $self->{_error} = '';
    $self->{_verbatim_pieces} = {};
    $self->{_unique_counter} = 0;
    die "Unrecognized option: " . join(' ', keys %options) . "\n" if %options;
    die "Missing input" unless defined $self->{input};
    die "Missing output" unless defined $self->{output};
    bless $self, $class;
}

sub _get_unique_counter {
    my $self = shift;
    my $counter = ++$self->{_unique_counter};
    return $counter;
}

sub _verbatim_pieces {
    return shift->{_verbatim_pieces};
}

sub html {
    return shift->{html};
}

sub fix_links {
    return shift->{fix_links};
}

sub fix_typography {
    return shift->{fix_typography};
}

sub remove_nbsp {
    return shift->{remove_nbsp};
}

sub show_nbsp {
    return shift->{show_nbsp};
}

sub fix_nbsp {
    return shift->{fix_nbsp};
}

sub fix_footnotes {
    return shift->{fix_footnotes};
}

sub debug {
    return shift->{debug};
}

sub input {
    return shift->{input};
}

sub output {
    return shift->{output};
}

=head2 process

Process C according to the options passed and write into
C. Return C on success, false otherwise.

=cut

sub _infile {
    my ($self, $arg) = @_;
    if ($arg) {
        die "Infile already set" if $self->{_infile};
        $self->{_infile} = $arg;
    }
    return $self->{_infile};
}

# temporary file for output
sub _outfile {
    my $self = shift;
    return File::Spec->catfile($self->tmpdir, 'output.muse');
}

sub _fn_outfile {
    my $self = shift;
    return File::Spec->catfile($self->tmpdir, 'fn-out.muse');
}

sub process {
    my $self = shift;
    my $debug = $self->debug;

    my $wd = $self->tmpdir;
    print "# Using $wd to store temporary files\n" if $debug;
    my $infile = $self->_set_infile;
    die "Something went wrong" unless -f $infile;

    if ($self->html) {
        $self->_process_html;
    }

    # then try to get the language
    my ($filter, $specific_filter, $nbsp_filter);
    my $fixlinks = $self->fix_links;
    my $fixtypo = $self->fix_typography;
    my $remove_nbsp = $self->remove_nbsp;
    my $show_nbsp = $self->show_nbsp;
    my $lang = $self->_get_lang;

    if ($lang && $fixtypo) {
        $filter =
          Text::Amuse::Preprocessor::TypographyFilters::filter($lang);
        $specific_filter =
          Text::Amuse::Preprocessor::TypographyFilters::specific_filter($lang);
    }

    if ($lang && $self->fix_nbsp) {
        $nbsp_filter =
          Text::Amuse::Preprocessor::TypographyFilters::nbsp_filter($lang);
    }

    my $outfile = $self->_outfile;
    my $line;
    my @body = Text::Amuse::Preprocessor::Parser::parse_text($self->_read_file($infile));
    # print Dumper(\@body);
  CHUNK:
    foreach my $piece (@body) {
        next CHUNK if $piece->{type} ne 'text';
        # print "Processing $piece->{type} $piece->{string}\n";

        # do the job
        $line = $piece->{string};

        # some bad things we want to filter anyway
        # $line =~ s/─/—/g; # they look the same, but they are not
        $line =~ s/\x{2500}/\x{2014}/g;
        # ligatures, totally lame to have in input file
        $line =~ s/\x{fb00}/ff/g;
        $line =~ s/\x{fb01}/fi/g;
        $line =~ s/\x{fb02}/fl/g;
        $line =~ s/\x{fb03}/ffi/g;
        $line =~ s/\x{fb04}/ffl/g;
        # remove soft-hyphens + space. They are invisible in browsers
        # and sometimes even on the console
        $line =~ s/\x{ad}\s*//g;
        if ($remove_nbsp) {
            $line =~ s/\x{a0}/ /g;
            $line =~ s/~~/ /g;
        }
        if ($fixtypo) {
            $line =~ s/(?<=\.) (?=\.)//g; # collapse the dots
        }
        if ($fixlinks) {
            $line = Text::Amuse::Preprocessor::TypographyFilters::linkify($line);
        }
        if ($filter) {
            $line = $filter->($line);
        }
        if ($specific_filter) {
            $line = $specific_filter->($line);
        }
        if ($nbsp_filter) {
            $line = $nbsp_filter->($line);
        }
        if ($show_nbsp) {
            $line =~ s/\x{a0}/~~/g;
        }
        $piece->{string} = $line;
    }
    # write out
    $self->_write_file($outfile, join('', map { $_->{string} } @body));

    if ($self->fix_footnotes) {
        my $fn_auxfile = $self->_fn_outfile;
        my $fnfixer = Text::Amuse::Preprocessor::Footnotes
          ->new(input  => $outfile,
                output => $fn_auxfile);
        # print "$outfile $fn_auxfile\n";
        if ($fnfixer->process) {
            # replace the outfile
            $outfile = $fn_auxfile;
        }
        else {
            # set the error
            $self->_set_error({ %{ $fnfixer->error } });
            return;
        }
    }

    my $output = $self->output;
    if (my $ref = ref($output)) {
        if ($ref eq 'SCALAR') {
            $$output = $self->_read_file($outfile);
        }
        else {
            die "Output is not a scalar ref!";
        }
    }
    else {
        File::Copy::move($outfile, $output)
            or die "Cannot move $outfile to $output, $!";
    }
    return $output;
}

sub _process_html {
    my $self = shift;
    # read the infile, process, overwrite. Doc states that it's just lame.
    my $body = $self->_read_file($self->_infile);
    my $html = Text::Amuse::Preprocessor::HTML::html_to_muse($body);
    $self->_write_file($self->_infile, $html);
}

sub _write_file {
    my ($self, $file, $body) = @_;
    die unless $file && $body;
    open (my $fh, '>:encoding(UTF-8)', $file) or die "opening $file $!";
    print $fh $body;
    close $fh or die "closing $file: $!";

}

sub _read_file {
    my ($self, $file) = @_;
    die unless $file;
    open (my $fh, '<:encoding(UTF-8)', $file) or die "$file: $!";
    local $/ = undef;
    my $body = <$fh>;
    close $fh;
    return $body;
}



sub _set_infile {
    my $self = shift;
    my $input = $self->input;
    my $infile = File::Spec->catfile($self->tmpdir, 'input.txt');
    if (my $ref = ref($input)) {
        if ($ref eq 'SCALAR') {
            open (my $fh, '>:encoding(UTF-8)', $infile) or die "$infile: $!";
            print $fh $$input;
            close $fh or die "closing $infile $!";
            $self->_infile($infile);
        }
        else {
            die Dumper($ref) . " is not a scalar ref!";
        }
    }
    else {
        File::Copy::copy($input, $infile) or die "Couldn't copy $input to $infile $!";
        $self->_infile($infile);
    }
    return $self->_infile;
}


=head2 html_to_muse

Can be called on the class and will invoke the
L's C function on the
argument returning the converted chunk.

=cut

sub html_to_muse {
    my ($self, $text) = @_;
    return unless defined $text;
    return Text::Amuse::Preprocessor::HTML::html_to_muse($text);
}

=head2 error

This is set only when processing footnotes. See
L documentation for the hashref
returned when an error has been detected.

=cut

sub error {
    return shift->{_error};
}

sub _set_error {
    my ($self, $error) = @_;
    $self->{_error} = $error if $error;
}

=head2 tmpdir

Return the directory name used internally to hold the temporary files.

=cut

sub tmpdir {
    my $self = shift;
    unless ($self->{_tmpdir}) {
        $self->{_tmpdir} = File::Temp->newdir(CLEANUP => !$self->debug);
    }
    return $self->{_tmpdir}->dirname;
}

sub _get_lang {
    my $self = shift;
    my $infile = $self->_infile;
    # shouldn't happen
    die unless $infile && -f $infile;
    my $info;
    eval {
        $info = Text::Amuse::Functions::muse_fast_scan_header($infile);
    };
    if ($info && $info->{lang}) {
        if ($info->{lang} =~ m/^\s*([a-z]{2,3})\s*$/s) {
            return $1;
        }
    }
    return;
}


=head1 AUTHOR

Marco Pessotto, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to the author's email. If
you find a bug, please provide a minimal muse file which reproduces
the problem (so I can add it to the test suite).

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Text::Amuse::Preprocessor

Repository available at GitHub:
L

=head1 SEE ALSO

The original documentation for the Emacs Muse markup can be found at:
L

The parser itself is L.

This distribution ships the following executables

=over 4

=item * html-to-muse.pl (HTML to muse converter)

=item * muse-check-footnotes.pl (footnote checker)

=item * muse-rearrange-footnotes.pl (fix footnote numbering)

=item * pod-to-muse.pl (POD to muse converter)

=item * muse-preprocessor.pl (script which uses this module)

=back

See the manpage or pass --help to the scripts for usage.

=head1 LICENSE

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See L for more information.


=cut

1; # End of Text::Amuse::Preprocessor