File Coverage

blib/lib/Pandoc.pm

Criterion	Covered	Total	%
statement	50	201	24.8
branch	9	100	9.0
condition	7	83	8.4
subroutine	14	31	45.1
pod	18	19	94.7
total	98	434	22.5

package Pandoc;
use 5.014;
use warnings;

use utf8;

=head1 NAME

Pandoc - wrapper for the mighty Pandoc document converter

=cut

our $VERSION = '0.9.1';

use Pandoc::Version;
use Pandoc::Error;
use File::Which;
use File::Spec::Functions 'catdir';
use IPC::Run3;
use parent 'Exporter';
our @EXPORT = qw(pandoc pandoc_data_dir);

our $PANDOC;
our $PANDOC_PATH ||= $ENV{PANDOC_PATH} || 'pandoc';

sub import {
    shift;

    if ( @_ and $_[0] =~ /^[v0-9.<>=!, ]+$/ ) {
        $PANDOC //= Pandoc->new;
        $PANDOC->require(shift);
    }
    $PANDOC //= Pandoc->new(@_) if @_;

    Pandoc->export_to_level( 1, 'pandoc' );
}

sub VERSION {
    shift;
    $PANDOC //= Pandoc->new;
    $PANDOC->require(shift) if @_;
    $PANDOC->version;
}

sub new {
    my $pandoc = bless {}, shift;

    my $bin = ( @_ and $_[0] !~ /^-./ ) ? shift : $PANDOC_PATH;

    my $bin_from_version = pandoc_data_dir( "bin", "pandoc-$bin" );
    if ( !-x $bin && $bin =~ /^\d+(\.\d+)*$/ && -x $bin_from_version ) {
        $pandoc->{bin} = $bin_from_version;
    }
    else {
        $pandoc->{bin} = which($bin);
    }

    $pandoc->{arguments} = [];
    $pandoc->arguments(@_) if @_;

    my ( $in, $out, $err );

    if ( $pandoc->{bin} ) {
        run3 [ $pandoc->{bin}, '-v' ], \$in, \$out, \$err,
          { return_if_system_error => 1 };
    }
    unless ( $out and $out =~ /^[^ ]+ (\d+(\.\d+)+)/ ) {
        Pandoc::Error->throw(
            message => "pandoc executable not found",
            out     => $out,
            err     => $err,
        );
    }

    $pandoc->{version} = Pandoc::Version->new($1);
    $pandoc->{data_dir} = $1 if $out =~ /^Default user data directory: (.+)$/m;

    # before pandoc supported --list-highlight-languages
    if ( $out =~ /^Syntax highlighting is supported/m ) {
        $pandoc->{highlight_languages} =
          [ map { split /\s*,\s*/, $_ } ( $out =~ /^    (.+)$/mg ) ];
    }

    my %libs;
    my $LIBRARY_VERSION = qr/\s+(\pL\w*(?:-\pL\w*)*)\s+(\d+(?:\.\d+)*),?/;
    if ( $out =~ /^Compiled with($LIBRARY_VERSION+)/m ) {
        %libs = $1 =~ /$LIBRARY_VERSION/g;
        for my $name ( keys %libs ) {
            $libs{$name} = Pandoc::Version->new( $libs{$name} );
        }
    }
    $pandoc->{libs} = \%libs;

    return $pandoc;
}

sub pandoc(@) {    ## no critic
    $PANDOC //= eval { Pandoc->new } // 0;

    if (@_) {
        return $PANDOC ? $PANDOC->run(@_) : -1;
    }
    else {
        return $PANDOC;
    }
}

sub run {
    my $pandoc = shift;

    my $args = 'ARRAY' eq ref $_[0] ? \@{ shift @_ } : undef;   # \@args [ ... ]
    my $opts = 'HASH' eq ref $_[-1] ? \%{ pop @_ }   : undef;   # [ ... ] \%opts

    if (@_) {
        if ( !$args ) {                                         # @args
            if ( $_[0] =~ /^-/ or $opts or @_ % 2 ) {
                $args = \@_;
            }
            else {                                              # %opts
                $opts = {@_};
            }
        }
        elsif ( $args and !$opts and ( @_ % 2 == 0 ) ) {    # \@args [, %opts ]
            $opts = {@_};
        }
        else {
            # passed both the args and opts by ref,
            # so other arguments don't make sense;
            # or passed args by ref and an odd-length list
            Pandoc::Error->throw('Too many or ambiguous arguments');
        }
    }

    $args //= [];
    $opts //= {};

    for my $io (qw(in out err)) {
        $opts->{"binmode_std$io"} //= $opts->{binmode} if $opts->{binmode};
        if ( 'SCALAR' eq ref $opts->{$io} ) {
            next unless utf8::is_utf8( ${ $opts->{$io} } );
            $opts->{"binmode_std$io"} //= ':encoding(UTF-8)';
        }
    }

    my $throw = $opts->{throw} || !( $opts->{return_if_system_error} // 1 );
    $opts->{out} //= \( my $out );
    $opts->{err} //= \( my $err );

    $opts->{return_if_system_error} = 1;
    run3 [ $pandoc->{bin}, @{ $pandoc->{arguments} }, @$args ],
      $opts->{in}, $opts->{out}, $opts->{err}, $opts;

    my $status = $? == -1 ? -1 : $? >> 8;

    if ( $status && $throw ) {
        Pandoc::Error->throw(
            system  => $!,
            out     => ${ $opts->{out} },
            err     => ${ $opts->{err} },
            status  => $status,
            message => ${ $opts->{err} } || 'pandoc execution failed'
        );
    }
    else {
        $status;
    }
}

sub convert {
    my $pandoc = shift;
    my $from   = shift;
    my $to     = shift;
    my $in     = shift;
    my $out    = "";

    my $utf8 = utf8::is_utf8($in);

    $pandoc->run(
        [ @_, '-f' => $from, '-t' => $to, '-o' => '-' ],
        { in => \$in, out => \$out, throw => 1 }
    );

    utf8::decode($out) if $utf8;

    chomp $out;
    return $out;
}

sub parse {
    my $pandoc = shift;
    my $format = shift;
    my $json   = "";

    if ( $format eq 'json' ) {
        $json = shift;
    }
    else {
        $pandoc->require('1.12.1');
        $json = $pandoc->convert( $format => 'json', @_ );
    }

    require Pandoc::Elements;
    Pandoc::Elements::pandoc_json($json);
}

sub file {
    my $pandoc = shift;
    $pandoc->require('1.12.1');

    my @args = ( @_, '-t' => 'json', '-o' => '-' );
    $pandoc->run( \@args, out => \( my $json ), throw => 1 );

    require Pandoc::Elements;
    Pandoc::Elements::pandoc_json($json);
}

sub require {
    my $pandoc = shift;
    $pandoc = do { $PANDOC //= Pandoc->new } if $pandoc eq 'Pandoc';
    unless ( $pandoc->version(@_) ) {
        Pandoc::Error->throw(
            message => "pandoc $_[0] required, only found "
              . $pandoc->{version},
            version => $pandoc->{version},
            require => $_[0],
        );
    }
    return $pandoc;
}

sub version {
    my $pandoc = shift or return;
    my $version = $pandoc->{version} or return;

    # compare against given version
    return if @_ and not $version->fulfills(@_);

    return $version;
}

sub data_dir {
    catdir( shift->{data_dir}, @_ );
}

sub pandoc_data_dir {
    if ( $^O eq 'MSWin32' ) {
        catdir( $ENV{APPDATA}, 'pandoc', @_ );
    }
    else {
        catdir( $ENV{HOME}, '.pandoc', @_ );
    }
}

sub bin {
    my $pandoc = shift;
    if (@_) {
        my $new = Pandoc->new(shift);
        $pandoc->{$_} = $new->{$_} for (qw(version bin data_dir));
    }
    $pandoc->{bin};
}

sub arguments {
    my $pandoc = shift;
    if (@_) {
        my $args = 'ARRAY' eq ref $_[0] ? shift : \@_;
        Pandoc::Error->throw("first default argument must be an -option")
          if @$args and $args->[0] !~ /^-./;
        $pandoc->{arguments} = $args;
    }
    @{ $pandoc->{arguments} };
}

sub _list {
    my ( $pandoc, $which ) = @_;
    if ( !$pandoc->{$which} ) {
        if ( $pandoc->version('1.18') ) {
            my $list    = "";
            my $command = $which;
            $command =~ s/_/-/g;
            $pandoc->run( "--list-$command", { out => \$list } );
            $pandoc->{$which} = [ split /\n/, $list ];
        }
        elsif ( !defined $pandoc->{help} ) {
            my $help;
            $pandoc->run( '--help', { out => \$help } );
            for my $inout (qw(Input Output)) {
                $help =~ /^$inout formats:\s+([a-z_0-9,\+\s*]+)/m or next;
                $pandoc->{ lc($inout) . '_formats' } =
                  [ split /\*?,\s+|\*?\s+/, $1 ];
            }
            $pandoc->{help} = $help;
        }
    }
    @{ $pandoc->{$which} // [] };
}

sub input_formats {
    $_[0]->_list('input_formats');
}

sub output_formats {
    $_[0]->_list('output_formats');
}

sub highlight_languages {
    $_[0]->_list('highlight_languages');
}

sub extensions {
    my $pandoc = shift;
    my $format = shift // '';
    my $out    = "";
    my %ext;

    if ( $pandoc->version < 1.18 ) {
        warn "pandoc >= 1.18 required for --list-extensions\n";
    }
    else {
        if ($format) {
            if ( $format =~ /^[a-z0-9_]$/ and $pandoc->version >= '2.0.6' ) {
                $format = "=$format";
            }
            else {
                warn "ignoring format argument to Pandoc->extensions\n";
                $format = '';
            }
        }
        $pandoc->run( "--list-extensions$format", { out => \$out } );
        %ext = map {
            $_ =~ /^([+-]?)\s*([^-+ ]+)\s*([+-]?)$/;
            ( $2 => ( $1 || $3 ) eq '+' ? 1 : 0 );
        } split /\n/, $out;
    }

    %ext;
}

sub libs {
    $_[0]->{libs};
}

sub symlink {
    my $self = shift;
    my ( $name, %opts ) = @_ % 2 ? @_ : ( '', @_ );

    if ( '' eq $name // '' ) {
        $name = pandoc_data_dir( 'bin', 'pandoc' );
    }
    elsif ( -d $name ) {
        $name = "$name/pandoc";
    }

    my $bin = $self->bin;

    unlink $name if -l $name;
    if ( symlink $bin, $name ) {
        say "symlinked $name -> $bin" if $opts{verbose};
        $self->bin($name);
    }
    else {
        die "failed to create symlink $name -> $bin\n";
    }

    $self;
}

1;

__END__