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


line stmt bran cond sub pod time code
1             package Pandoc;
2 10     10   765292 use 5.014;
  10         162  
3 10     10   54 use warnings;
  10         19  
  10         304  
4              
5 10     10   6081 use utf8;
  10         154  
  10         50  
6              
7             =head1 NAME
8              
9             Pandoc - wrapper for the mighty Pandoc document converter
10              
11             =cut
12              
13             our $VERSION = '0.9.1';
14              
15 10     10   4417 use Pandoc::Version;
  10         30  
  10         339  
16 10     10   62 use Pandoc::Error;
  10         18  
  10         178  
17 10     10   4739 use File::Which;
  10         10112  
  10         611  
18 10     10   3746 use File::Spec::Functions 'catdir';
  10         7243  
  10         606  
19 10     10   5493 use IPC::Run3;
  10         313871  
  10         698  
20 10     10   107 use parent 'Exporter';
  10         21  
  10         163  
21             our @EXPORT = qw(pandoc pandoc_data_dir);
22              
23             our $PANDOC;
24             our $PANDOC_PATH ||= $ENV{PANDOC_PATH} || 'pandoc';
25              
26             sub import {
27 9     9   101 shift;
28              
29 9 50 33     46 if ( @_ and $_[0] =~ /^[v0-9.<>=!, ]+$/ ) {
30 0   0     0 $PANDOC //= Pandoc->new;
31 0         0 $PANDOC->require(shift);
32             }
33 9 50 0     31 $PANDOC //= Pandoc->new(@_) if @_;
34              
35 9         12740 Pandoc->export_to_level( 1, 'pandoc' );
36             }
37              
38             sub VERSION {
39 0     0 0 0 shift;
40 0   0     0 $PANDOC //= Pandoc->new;
41 0 0       0 $PANDOC->require(shift) if @_;
42 0         0 $PANDOC->version;
43             }
44              
45             sub new {
46 8     8 1 29 my $pandoc = bless {}, shift;
47              
48 8 50 33     70 my $bin = ( @_ and $_[0] !~ /^-./ ) ? shift : $PANDOC_PATH;
49              
50 8         40 my $bin_from_version = pandoc_data_dir( "bin", "pandoc-$bin" );
51 8 50 33     196 if ( !-x $bin && $bin =~ /^\d+(\.\d+)*$/ && -x $bin_from_version ) {
      33        
52 0         0 $pandoc->{bin} = $bin_from_version;
53             }
54             else {
55 8         54 $pandoc->{bin} = which($bin);
56             }
57              
58 8         2064 $pandoc->{arguments} = [];
59 8 50       43 $pandoc->arguments(@_) if @_;
60              
61 8         23 my ( $in, $out, $err );
62              
63 8 50       31 if ( $pandoc->{bin} ) {
64 0         0 run3 [ $pandoc->{bin}, '-v' ], \$in, \$out, \$err,
65             { return_if_system_error => 1 };
66             }
67 8 50 33     35 unless ( $out and $out =~ /^[^ ]+ (\d+(\.\d+)+)/ ) {
68 8         64 Pandoc::Error->throw(
69             message => "pandoc executable not found",
70             out => $out,
71             err => $err,
72             );
73             }
74              
75 0         0 $pandoc->{version} = Pandoc::Version->new($1);
76 0 0       0 $pandoc->{data_dir} = $1 if $out =~ /^Default user data directory: (.+)$/m;
77              
78             # before pandoc supported --list-highlight-languages
79 0 0       0 if ( $out =~ /^Syntax highlighting is supported/m ) {
80             $pandoc->{highlight_languages} =
81 0         0 [ map { split /\s*,\s*/, $_ } ( $out =~ /^ (.+)$/mg ) ];
  0         0  
82             }
83              
84 0         0 my %libs;
85 10     10   7173 my $LIBRARY_VERSION = qr/\s+(\pL\w*(?:-\pL\w*)*)\s+(\d+(?:\.\d+)*),?/;
  10         131  
  10         183  
  0         0  
86 0 0       0 if ( $out =~ /^Compiled with($LIBRARY_VERSION+)/m ) {
87 0         0 %libs = $1 =~ /$LIBRARY_VERSION/g;
88 0         0 for my $name ( keys %libs ) {
89 0         0 $libs{$name} = Pandoc::Version->new( $libs{$name} );
90             }
91             }
92 0         0 $pandoc->{libs} = \%libs;
93              
94 0         0 return $pandoc;
95             }
96              
97             sub pandoc(@) { ## no critic
98 8   50 8 1 747 $PANDOC //= eval { Pandoc->new } // 0;
  8   33     55  
99              
100 8 50       36 if (@_) {
101 0 0       0 return $PANDOC ? $PANDOC->run(@_) : -1;
102             }
103             else {
104 8         29 return $PANDOC;
105             }
106             }
107              
108             sub run {
109 0     0 1 0 my $pandoc = shift;
110              
111 0 0       0 my $args = 'ARRAY' eq ref $_[0] ? \@{ shift @_ } : undef; # \@args [ ... ]
  0         0  
112 0 0       0 my $opts = 'HASH' eq ref $_[-1] ? \%{ pop @_ } : undef; # [ ... ] \%opts
  0         0  
113              
114 0 0       0 if (@_) {
115 0 0 0     0 if ( !$args ) { # @args
    0 0        
116 0 0 0     0 if ( $_[0] =~ /^-/ or $opts or @_ % 2 ) {
      0        
117 0         0 $args = \@_;
118             }
119             else { # %opts
120 0         0 $opts = {@_};
121             }
122             }
123             elsif ( $args and !$opts and ( @_ % 2 == 0 ) ) { # \@args [, %opts ]
124 0         0 $opts = {@_};
125             }
126             else {
127             # passed both the args and opts by ref,
128             # so other arguments don't make sense;
129             # or passed args by ref and an odd-length list
130 0         0 Pandoc::Error->throw('Too many or ambiguous arguments');
131             }
132             }
133              
134 0   0     0 $args //= [];
135 0   0     0 $opts //= {};
136              
137 0         0 for my $io (qw(in out err)) {
138 0 0 0     0 $opts->{"binmode_std$io"} //= $opts->{binmode} if $opts->{binmode};
139 0 0       0 if ( 'SCALAR' eq ref $opts->{$io} ) {
140 0 0       0 next unless utf8::is_utf8( ${ $opts->{$io} } );
  0         0  
141 0   0     0 $opts->{"binmode_std$io"} //= ':encoding(UTF-8)';
142             }
143             }
144              
145 0   0     0 my $throw = $opts->{throw} || !( $opts->{return_if_system_error} // 1 );
146 0   0     0 $opts->{out} //= \( my $out );
147 0   0     0 $opts->{err} //= \( my $err );
148              
149 0         0 $opts->{return_if_system_error} = 1;
150 0         0 run3 [ $pandoc->{bin}, @{ $pandoc->{arguments} }, @$args ],
151 0         0 $opts->{in}, $opts->{out}, $opts->{err}, $opts;
152              
153 0 0       0 my $status = $? == -1 ? -1 : $? >> 8;
154              
155 0 0 0     0 if ( $status && $throw ) {
156             Pandoc::Error->throw(
157             system => $!,
158 0         0 out => ${ $opts->{out} },
159 0         0 err => ${ $opts->{err} },
160             status => $status,
161 0   0     0 message => ${ $opts->{err} } || 'pandoc execution failed'
162             );
163             }
164             else {
165 0         0 $status;
166             }
167             }
168              
169             sub convert {
170 0     0 1 0 my $pandoc = shift;
171 0         0 my $from = shift;
172 0         0 my $to = shift;
173 0         0 my $in = shift;
174 0         0 my $out = "";
175              
176 0         0 my $utf8 = utf8::is_utf8($in);
177              
178 0         0 $pandoc->run(
179             [ @_, '-f' => $from, '-t' => $to, '-o' => '-' ],
180             { in => \$in, out => \$out, throw => 1 }
181             );
182              
183 0 0       0 utf8::decode($out) if $utf8;
184              
185 0         0 chomp $out;
186 0         0 return $out;
187             }
188              
189             sub parse {
190 0     0 1 0 my $pandoc = shift;
191 0         0 my $format = shift;
192 0         0 my $json = "";
193              
194 0 0       0 if ( $format eq 'json' ) {
195 0         0 $json = shift;
196             }
197             else {
198 0         0 $pandoc->require('1.12.1');
199 0         0 $json = $pandoc->convert( $format => 'json', @_ );
200             }
201              
202 0         0 require Pandoc::Elements;
203 0         0 Pandoc::Elements::pandoc_json($json);
204             }
205              
206             sub file {
207 0     0 1 0 my $pandoc = shift;
208 0         0 $pandoc->require('1.12.1');
209              
210 0         0 my @args = ( @_, '-t' => 'json', '-o' => '-' );
211 0         0 $pandoc->run( \@args, out => \( my $json ), throw => 1 );
212              
213 0         0 require Pandoc::Elements;
214 0         0 Pandoc::Elements::pandoc_json($json);
215             }
216              
217             sub require {
218 0     0 1 0 my $pandoc = shift;
219 0 0 0     0 $pandoc = do { $PANDOC //= Pandoc->new } if $pandoc eq 'Pandoc';
  0         0  
220 0 0       0 unless ( $pandoc->version(@_) ) {
221             Pandoc::Error->throw(
222             message => "pandoc $_[0] required, only found "
223             . $pandoc->{version},
224             version => $pandoc->{version},
225 0         0 require => $_[0],
226             );
227             }
228 0         0 return $pandoc;
229             }
230              
231             sub version {
232 0 0   0 1 0 my $pandoc = shift or return;
233 0 0       0 my $version = $pandoc->{version} or return;
234              
235             # compare against given version
236 0 0 0     0 return if @_ and not $version->fulfills(@_);
237              
238 0         0 return $version;
239             }
240              
241             sub data_dir {
242 0     0 1 0 catdir( shift->{data_dir}, @_ );
243             }
244              
245             sub pandoc_data_dir {
246 9 50   9 1 146 if ( $^O eq 'MSWin32' ) {
247 0         0 catdir( $ENV{APPDATA}, 'pandoc', @_ );
248             }
249             else {
250 9         99 catdir( $ENV{HOME}, '.pandoc', @_ );
251             }
252             }
253              
254             sub bin {
255 0     0 1   my $pandoc = shift;
256 0 0         if (@_) {
257 0           my $new = Pandoc->new(shift);
258 0           $pandoc->{$_} = $new->{$_} for (qw(version bin data_dir));
259             }
260 0           $pandoc->{bin};
261             }
262              
263             sub arguments {
264 0     0 1   my $pandoc = shift;
265 0 0         if (@_) {
266 0 0         my $args = 'ARRAY' eq ref $_[0] ? shift : \@_;
267 0 0 0       Pandoc::Error->throw("first default argument must be an -option")
268             if @$args and $args->[0] !~ /^-./;
269 0           $pandoc->{arguments} = $args;
270             }
271 0           @{ $pandoc->{arguments} };
  0            
272             }
273              
274             sub _list {
275 0     0     my ( $pandoc, $which ) = @_;
276 0 0         if ( !$pandoc->{$which} ) {
277 0 0         if ( $pandoc->version('1.18') ) {
    0          
278 0           my $list = "";
279 0           my $command = $which;
280 0           $command =~ s/_/-/g;
281 0           $pandoc->run( "--list-$command", { out => \$list } );
282 0           $pandoc->{$which} = [ split /\n/, $list ];
283             }
284             elsif ( !defined $pandoc->{help} ) {
285 0           my $help;
286 0           $pandoc->run( '--help', { out => \$help } );
287 0           for my $inout (qw(Input Output)) {
288 0 0         $help =~ /^$inout formats:\s+([a-z_0-9,\+\s*]+)/m or next;
289 0           $pandoc->{ lc($inout) . '_formats' } =
290             [ split /\*?,\s+|\*?\s+/, $1 ];
291             }
292 0           $pandoc->{help} = $help;
293             }
294             }
295 0   0       @{ $pandoc->{$which} // [] };
  0            
296             }
297              
298             sub input_formats {
299 0     0 1   $_[0]->_list('input_formats');
300             }
301              
302             sub output_formats {
303 0     0 1   $_[0]->_list('output_formats');
304             }
305              
306             sub highlight_languages {
307 0     0 1   $_[0]->_list('highlight_languages');
308             }
309              
310             sub extensions {
311 0     0 1   my $pandoc = shift;
312 0   0       my $format = shift // '';
313 0           my $out = "";
314 0           my %ext;
315              
316 0 0         if ( $pandoc->version < 1.18 ) {
317 0           warn "pandoc >= 1.18 required for --list-extensions\n";
318             }
319             else {
320 0 0         if ($format) {
321 0 0 0       if ( $format =~ /^[a-z0-9_]$/ and $pandoc->version >= '2.0.6' ) {
322 0           $format = "=$format";
323             }
324             else {
325 0           warn "ignoring format argument to Pandoc->extensions\n";
326 0           $format = '';
327             }
328             }
329 0           $pandoc->run( "--list-extensions$format", { out => \$out } );
330             %ext = map {
331 0           $_ =~ /^([+-]?)\s*([^-+ ]+)\s*([+-]?)$/;
  0            
332 0 0 0       ( $2 => ( $1 || $3 ) eq '+' ? 1 : 0 );
333             } split /\n/, $out;
334             }
335              
336 0           %ext;
337             }
338              
339             sub libs {
340 0     0 1   $_[0]->{libs};
341             }
342              
343             sub symlink {
344 0     0 1   my $self = shift;
345 0 0         my ( $name, %opts ) = @_ % 2 ? @_ : ( '', @_ );
346              
347 0 0 0       if ( '' eq $name // '' ) {
    0          
348 0           $name = pandoc_data_dir( 'bin', 'pandoc' );
349             }
350             elsif ( -d $name ) {
351 0           $name = "$name/pandoc";
352             }
353              
354 0           my $bin = $self->bin;
355              
356 0 0         unlink $name if -l $name;
357 0 0         if ( symlink $bin, $name ) {
358 0 0         say "symlinked $name -> $bin" if $opts{verbose};
359 0           $self->bin($name);
360             }
361             else {
362 0           die "failed to create symlink $name -> $bin\n";
363             }
364              
365 0           $self;
366             }
367              
368             1;
369              
370             __END__