File Coverage

blib/lib/App/pod2pandoc.pm

Criterion	Covered	Total	%
statement	47	94	50.0
branch	6	40	15.0
condition	3	23	13.0
subroutine	13	17	76.4
pod	2	2	100.0
total	71	176	40.3

package App::pod2pandoc;
use strict;
use warnings;
use 5.010;

our $VERSION = '0.3.2';

use Getopt::Long qw(:config pass_through);
use Pod::Usage;
use Pod::Simple::Pandoc;
use Pandoc;
use Pandoc::Elements;
use Scalar::Util qw(reftype blessed);
use JSON;
use Carp;

use parent 'Exporter';
our @EXPORT    = qw(pod2pandoc);
our @EXPORT_OK = qw(pod2pandoc parse_arguments);

sub parse_arguments {
    my %opt;
    Getopt::Long::GetOptionsFromArray(
        \@_,              \%opt,    'help|h|?', 'parse=s',
        'podurl=s',       'ext=s',  'index=s',  'wiki',
        'default-meta=s', 'update', 'quiet'
    ) or exit 1;
    pod2usage(1) if delete $opt{help};

    my @input = @_ ? () : '-';

    my ($index) = grep { $_[$_] eq '--' } ( 0 .. @_ - 1 );

    if ( defined $index ) {
        push @input, shift @_ for 0 .. $index - 1;
        shift @_;    # --
    }
    else {
        push( @input, shift @_ ) while @_ and $_[0] !~ /^-./;
    }

    if ( $opt{parse} and $opt{parse} ne '*' ) {
        $opt{parse} = [ split /[, ]+/, $opt{parse} ];
    }

    return ( \@input, \%opt, @_ );
}

# TODO: move to Pandoc::Elements
sub _add_default_meta {
    my ( $doc, $meta ) = @_;
    return unless $meta;
    $doc->meta->{$_} //= $meta->{$_} for keys %$meta;
}

sub _plain2meta {
    my $value = shift;
    if ( !ref $value ) {
        MetaString $value;
    }
    elsif ( JSON::is_bool($value) ) {
        MetaBool $value;
    }
    elsif ( blessed($value) ) {
        if ( $value->can('is_meta') and $value->is_meta ) {
            $value;
        }
        else {
            MetaString "$value";
        }
    }
    elsif ( reftype $value eq 'ARRAY' ) {
        MetaList [ map { _plain2meta($_) } @$value ];
    }
    else {
        MetaMap {
            map { $_ => _plain2meta( $value->{$_} ) } keys %$value
        }
    }
}

sub _default_meta {
    my $meta = shift || {};
    return $meta if ref $meta;

    # read default metadata from file
    if ( $meta =~ /\.json$/ ) {
        open( my $fh, "<:encoding(UTF-8)", $meta )
          or croak "failed to open $meta";
        local $/;
        $meta = decode_json(<$fh>);
        for ( keys %$meta ) {
            $meta->{$_} = _plain2meta( $meta->{$_} );
        }
        return $meta;
    }
    else {
        pandoc->require('1.12.1');
        return pandoc->file($meta)->meta;
    }
}

sub pod2pandoc {
    my $input = shift;
    my $opt   = ref $_[0] ? shift : {};
    my @args  = @_;

    $opt->{meta} =
      _default_meta( $opt->{meta} // delete $opt->{'default-meta'} );

    # directories
    if ( @$input > 0 and -d $input->[0] ) {
        my $target = @$input > 1 ? pop @$input : $input->[0];

        my $modules = Pod::Pandoc::Modules->new;
        foreach my $dir (@$input) {
            my $found = Pod::Simple::Pandoc->new->parse_modules($dir);
            warn "no .pm, .pod or Perl script found in $dir\n"
              unless %$found or $opt->{quiet};
            $modules->add( $_ => $found->{$_} ) for keys %$found;
        }

        _add_default_meta( $modules->{$_}, $opt->{meta} ) for %$modules;

        $modules->serialize( $target, $opt, @args );
    }

    # files and/or module names
    else {
        my $parser = Pod::Simple::Pandoc->new(%$opt);
        my $doc = $parser->parse_and_merge( @$input ? @$input : '-' );

        _add_default_meta( $doc, $opt->{meta} );

        if (@args) {
            pandoc->require('1.12.1');
            $doc->pandoc_version( pandoc->version );
            print $doc->to_pandoc(@args);
        }
        else {
            print $doc->to_json, "\n";
        }
    }
}

1;
__END__