File Coverage

blib/lib/Pandoc/Elements.pm
Criterion Covered Total %
statement 417 537 77.6
branch 183 394 46.4
condition 60 88 68.1
subroutine 80 91 87.9
pod 6 19 31.5
total 746 1129 66.0


line stmt bran cond sub pod time code
1             package Pandoc::Elements;
2 31     31   1971684 use strict;
  31         303  
  31         1052  
3             ## no critic (ProhibitNoStrict, ProhibitSubroutinePrototypes)
4 31     31   203 use warnings;
  31         69  
  31         901  
5 31     31   734 use 5.010001;
  31         126  
6              
7             our $VERSION = '0.37';
8              
9 31     31   253 use Carp;
  31         77  
  31         2300  
10 31     31   16895 use JSON qw(decode_json);
  31         354556  
  31         226  
11 31     31   5470 use Scalar::Util qw(blessed reftype);
  31         76  
  31         2074  
12 31     31   11578 use Pandoc::Walker qw(walk);
  31         100  
  31         2034  
13 31     31   14410 use Pandoc::Version;
  31         66133  
  31         24197  
14              
15              
16             our $PANDOC_VERSION; # a string like '1.16'
17             $PANDOC_VERSION ||= eval { Pandoc::Version->new($ENV{PANDOC_VERSION}) };
18              
19             # internal variables
20              
21             my $PANDOC_API_MIN = Pandoc::Version->new('1.12.3'); # since pandoc 1.12.1
22             my $PANDOC_BIN_MIN = Pandoc::Version->new('1.12.1');
23              
24             # release version => minimal required api version
25             my @REQUIRED_API = map { Pandoc::Version->new($_) }
26             '1.19' => '1.17', # pandoc 1.19 has api 1.17.0.4, compatible with api 1.17
27             '1.18' => '1.17', # pandoc 1.18 has api 1.17.0.4, compatible with api 1.17
28             '1.16' => '1.16', # pandoc 1.16 has api 1.16
29             '1.17' => '1.16', # pandoc 1.17 has api 1.16
30             ;
31              
32             sub _as_pandoc_version {
33 32 100 66 32   309 (blessed $_[0] and $_[0]->isa('Pandoc::Version'))
34             ? $_[0] : Pandoc::Version->new($_[0])
35             }
36              
37             sub pandoc_version {
38 54 100   54 1 1964 if (@_) {
    100          
39 29         55 my $doc = shift;
40 29 100       97 if (@_) {
41 9   100     20 $doc->api_version(
42             _minimum_pandoc_api_for(@_)
43             // croak "pandoc version not supported"
44             );
45             }
46 27         121 _minimum_pandoc_version_for_api($doc->api_version);
47             } elsif (defined $PANDOC_VERSION) {
48 23         80 _as_pandoc_version($PANDOC_VERSION)
49             } else {
50 2         51 $REQUIRED_API[0]
51             }
52             }
53              
54             sub _minimum_pandoc_version_for_api {
55 27     27   54 my $api = shift;
56              
57 27         46 my $version;
58              
59 27         104 foreach (grep { $_ % 2} 0 .. @REQUIRED_API) { # 1,3,...
  243         452  
60 108 100       5485 if ($api->match($REQUIRED_API[$_]) ) {
61 48 100 100     6177 if (!$version or $version > $REQUIRED_API[$_-1]) {
62 38         1127 $version = $REQUIRED_API[$_-1]
63             }
64             }
65             }
66              
67 27 100 66     2797 if (!$version and $api >= $PANDOC_API_MIN) {
68 3         169 $PANDOC_BIN_MIN;
69             } else {
70 24         522 return $version;
71             }
72             }
73              
74             sub _minimum_pandoc_api_for {
75 9     9   17 my $version = _as_pandoc_version(shift);
76 9 50       431 return if @$version <= 1; # require major.minor
77              
78 9         27 foreach (grep { $_ % 2} 0 .. @REQUIRED_API) { # 1,3,...
  81         126  
79 28 100       2066 if ($version->match($REQUIRED_API[$_-1]) ) {
80 5         555 return $REQUIRED_API[$_];
81             }
82             }
83              
84             # required version is newer than any known version
85             # return the latest known api version and hope it has not changed
86 4 100       454 if ($version > $REQUIRED_API[0]) {
87 1         56 return $REQUIRED_API[1];
88             }
89              
90 3 100       119 return $version >= $PANDOC_BIN_MIN ? $PANDOC_API_MIN : undef;
91             }
92              
93             our %ELEMENTS = (
94              
95             # BLOCK ELEMENTS
96             Plain => [ Block => 'content' ],
97             Para => [ Block => 'content' ],
98             CodeBlock => [ Block => qw(attr content) ],
99             RawBlock => [ Block => qw(format content) ],
100             BlockQuote => [ Block => 'content' ],
101             OrderedList => [ Block => qw(attr content/items) ],
102             BulletList => [ Block => 'content/items' ],
103             DefinitionList => [ Block => 'content/items:[DefinitionPair]' ],
104             Header => [ Block => qw(level attr content) ],
105             HorizontalRule => ['Block'],
106             Table => [ Block => qw(caption alignment widths headers rows) ],
107             Div => [ Block => qw(attr content) ],
108             Null => ['Block'],
109             LineBlock => [ Block => qw(content) ],
110              
111             # INLINE ELEMENTS
112             Str => [ Inline => 'content' ],
113             Emph => [ Inline => 'content' ],
114             Strong => [ Inline => 'content' ],
115             Strikeout => [ Inline => 'content' ],
116             Superscript => [ Inline => 'content' ],
117             Subscript => [ Inline => 'content' ],
118             SmallCaps => [ Inline => 'content' ],
119             Quoted => [ Inline => qw(type content) ],
120             Cite => [ Inline => qw(citations content) ],
121             Code => [ Inline => qw(attr content) ],
122             Space => ['Inline'],
123             SoftBreak => ['Inline'],
124             LineBreak => ['Inline'],
125             Math => [ Inline => qw(type content) ],
126             RawInline => [ Inline => qw(format content) ],
127             Link => [ Inline => qw(attr content target) ],
128             Image => [ Inline => qw(attr content target) ],
129             Note => [ Inline => 'content' ],
130             Span => [ Inline => qw(attr content) ],
131              
132             # METADATA ELEMENTS
133             MetaBool => [ Meta => 'content' ],
134             MetaString => [ Meta => 'content' ],
135             MetaMap => [ Meta => 'content' ],
136             MetaInlines => [ Meta => 'content' ],
137             MetaList => [ Meta => 'content' ],
138             MetaBlocks => [ Meta => 'content' ],
139              
140             # TYPE KEYWORDS
141             map { $_ => ['Keyword'] }
142             qw(DefaultDelim Period OneParen TwoParens SingleQuote DoubleQuote
143             DisplayMath InlineMath AuthorInText SuppressAuthor NormalCitation
144             AlignLeft AlignRight AlignCenter AlignDefault DefaultStyle Example
145             Decimal LowerRoman UpperRoman LowerAlpha UpperAlpha)
146             );
147              
148 31     31   275 use parent 'Exporter';
  31         77  
  31         223  
149             our @EXPORT = (
150             keys %ELEMENTS,
151             qw(Document attributes metadata citation pandoc_version pandoc_json pandoc_query)
152             );
153             our @EXPORT_OK = ( @EXPORT, 'element' );
154              
155             # create constructor functions
156             foreach my $name ( keys %ELEMENTS ) {
157 31     31   4503 no strict 'refs'; ## no critic
  31         89  
  31         15378  
158              
159             my ( $parent, @accessors ) = @{ $ELEMENTS{$name} };
160             my $numargs = scalar @accessors;
161             my @parents = map { "Pandoc::Document::$_" } ($parent);
162             $parent = join ' ', map { "Pandoc::Document::$_" } $parent,
163             map { 'AttributesRole' } grep { $_ eq 'attr' } @accessors;
164              
165             ## no critic (ProhibitStringyEval)
166             eval "package Pandoc::Document::$name; our \@ISA = qw($parent);";
167              
168             *{ __PACKAGE__ . "::$name" } = Scalar::Util::set_prototype(
169             sub {
170 600 100   600   28094 croak "$name expects $numargs arguments, but given " . scalar @_
171             if @_ != $numargs;
172 599 100       3261 my $self = bless {
173             t => $name,
174             c => ( @_ == 1 ? $_[0] : [@_] )
175             }, "Pandoc::Document::$name";
176 599         2794 $self->set_content(@_);
177 599         7135 $self;
178             },
179             '$' x $numargs
180             );
181              
182             for ( my $i = 0 ; $i < @accessors ; $i++ ) {
183             my $member = @accessors == 1 ? "\$e->{c}" : "\$e->{c}->[$i]";
184             my $code = "my \$e = shift; $member = ( 1 == \@_ ? \$_[0] : [\@_] ) if \@_; return";
185             # auto-bless on access via accessor (TODO: move to constructor?)
186             $code .= $accessors[$i] =~ s/:\[(.+)\]$//
187             ? " [ map { bless \$_, 'Pandoc::Document::$1' } \@{$member} ];"
188             : " $member;";
189             for ( split '/', $accessors[$i] ) {
190             ## no critic
191 4 0   4   17 *{"Pandoc::Document::${name}::$_"} = eval "sub { $code }";
  4 50       17  
  4 0       16  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 100       0  
  0 0       0  
  18 50       66  
  18 0       70  
  18 0       110  
  39 0       236  
  39 50       95  
  39 0       185  
  0 50       0  
  0 50       0  
  0 100       0  
  69 0       350  
  69 0       211  
  69 0       383  
  2 50       67  
  2 0       10  
  2 50       10  
  88 0       362  
  88 50       285  
  88 0       534  
  0 50       0  
  0 0       0  
  0 50       0  
  0 0       0  
  0 50       0  
  17 0       57  
  22 0       82  
  22 0       214  
  5 0       21  
  0 0       0  
  0 0       0  
  36 0       91  
  38 0       92  
  38 0       162  
  2 50       8  
  2 0       8  
  2 50       10  
  2 0       11  
  1 50       5  
  1 0       6  
  1 50       7  
  0 0       0  
  0 50       0  
  0 0       0  
  0 50       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 0       0  
  0 0       0  
  1 0       3  
  1 50       3  
  1 0       2  
  1 50       3  
  1 0       4  
  1 50       3  
  0 50       0  
  0 50       0  
  4 0       150  
  5 50       57  
  5 0       44  
  1 50       10  
  5 0       209  
  5 0       21  
  5 0       27  
  0 50       0  
  0 0       0  
  15 50       39  
  15 0       43  
  15 0       80  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 0       0  
  0 0       0  
  1 0       4  
  1 50       5  
  1 0       4  
  0 50       0  
  0 0       0  
  0 0       0  
  11 0       42  
  12 0       40  
  12 0       88  
  1 0       6  
  14 0       30  
  14 50       27  
  17 50       216  
  4 100       53  
  4 0       33  
  1 50       6  
  0 0       0  
  0 50       0  
  25 0       88  
  25 50       78  
  25 0       140  
  0 50       0  
  0 0       0  
  1 50       4  
  1 0       5  
  3 50       47  
  2 0       10  
  2 50       13  
  0         0  
  6         19  
  6         20  
  6         27  
  7         27  
  7         25  
  7         41  
  0         0  
  0         0  
  0         0  
  0         0  
  3         13  
  3         12  
  3         19  
  0         0  
  0         0  
  0         0  
  0         0  
  1         3  
  2         9  
  2         8  
  1         7  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  1         4  
  1         9  
  8         268  
  9         77  
  8         41  
  28         99  
  28         123  
  29         282  
  8         277  
  8         39  
  12         53  
  18         394  
  18         66  
  23         367  
  13         74  
  13         40  
  14         63  
  15         86  
  15         104  
  4         9  
  8         71  
  4         15  
  25         69  
  25         71  
  25         212  
  60         194  
  60         208  
  60         317  
  6         23  
  6         21  
  6         30  
192             }
193             }
194             }
195              
196             sub element {
197 4     4 1 511 my $name = shift;
198 31     31   286 no strict 'refs'; #
  31         92  
  31         46877  
199 4 50       25 croak "undefined element" unless defined $name;
200 4 100       201 croak "unknown element $name" unless $ELEMENTS{$name};
201 3         14 &$name(@_);
202             }
203              
204             sub Document {
205              
206 52     52 1 36248 my $from_json;
207 52         166 my $arg = do {
208 52 100       253 if ( @_ == 1 ) {
    100          
    100          
209 28         77 $from_json = 1;
210 28   100     194 my $reftype = reftype $_[0] // '';
211 28 100       120 if ( $reftype eq 'ARRAY') {
    100          
212             # old JSON format
213             {
214             meta => $_[0]->[0]->{unMeta},
215 21         149 blocks => $_[0]->[1],
216             api_version => 1.16,
217             }
218             } elsif ( $reftype eq 'HASH' ) {
219 6         18 $_[0]
220             } else {
221 1         11 croak 'Document: expect array or hash reference'
222             }
223             } elsif ( @_ == 2 ) {
224             # \%meta, \@blocks
225 9         43 { meta => $_[0], blocks => $_[1] }
226             } elsif ( @_ % 2 ) {
227             # odd number of args
228 1         13 croak "Document: too many or ambiguous arguments";
229             } else {
230             # even number of args: api_version as named parameter
231 14         69 { meta => shift, blocks => shift, @_ }
232             }
233             };
234              
235             # prefer haskell-style key but accept perl-style and abbreviated key
236             my $api_version = $arg->{'pandoc-api-version'}
237             // $arg->{pandoc_api_version}
238 50   66     491 // $arg->{api_version};
      66        
239              
240             # We copy values here because $arg may not be a pure AST representation
241 50   50     375 my $doc = bless { blocks => ( $arg->{blocks} // [] ) }, 'Pandoc::Document';
242              
243             # unblessed metadata in internal format can only come from JSON
244 50   100     209 my $meta = $arg->{meta} // {};
245 50 100       162 if ($from_json) {
246 27 50       152 croak "Document metadata must be a hash" unless 'HASH' eq reftype $meta;
247             $doc->{meta} = bless {
248 27         187 map { $_ => _bless_pandoc_element( $meta->{$_} ) } keys %$meta
  36         116  
249             }, 'Pandoc::Document::Metadata';
250             } else {
251             # otherwise allow user-friendly upgrade via 'metadata' function
252 23         94 $doc->meta($meta)
253             }
254              
255 50 100 100     384 if (!defined $api_version and defined $arg->{pandoc_version}) {
256 9         26 $doc->pandoc_version($arg->{pandoc_version});
257             } else {
258 41   66     491 $doc->api_version($api_version // $REQUIRED_API[1]);
259             }
260              
261 47         326 walk $doc, \&_bless_pandoc_element;
262              
263 47         500 return $doc;
264              
265             }
266              
267             # internal helper method
268             sub _bless_pandoc_element {
269 583     583   1249 my $e = shift;
270 583 50       1697 return $e unless ref $e;
271 583 100 66     3602 return $e if blessed $e and $e->isa('Pandoc::Document::Element');
272              
273             # TODO: run recursively via set_content (don't require 'walk')
274 278 100       817 if ( 'MetaMap' eq $e->{t} ) {
275 5         12 for my $v ( values %{ $e->{c} } ) {
  5         25  
276 15         38 _bless_pandoc_element( $v );
277             }
278             }
279              
280 278         1002 bless $e, 'Pandoc::Document::' . $e->{t};
281 278 100       1699 $e->upgrade($e) if $e->can('upgrade');
282 278         1023 return $e;
283             }
284              
285              
286             # specific accessors
287              
288 1     1   6 sub Pandoc::Document::DefinitionPair::term { $_[0]->[0] }
289 1     1   6 sub Pandoc::Document::DefinitionPair::definitions { $_[0]->[1] }
290              
291             # additional functions
292              
293             sub attributes($) {
294              
295 39     39 1 9549 my $e = Span(['',[],[]],[]); # to make use of AttributesRole
296 39         209 $e->keyvals(@_);
297              
298 39         3150 return $e->attr;
299             }
300              
301             sub citation($) {
302 1     1 1 3 my $a = shift;
303             {
304             citationId => $a->{id} // "missing",
305             citationPrefix => $a->{prefix} // [],
306             citationSuffix => $a->{suffix} // [],
307             citationMode => $a->{mode} // bless(
308             { t => 'NormalCitation', c => [] },
309             'Pandoc::Document::NormalCitation'
310             ),
311             citationNoteNum => $a->{num} // 0,
312 1   50     40 citationHash => $a->{hash} // 1,
      50        
      50        
      50        
      50        
      50        
313             };
314             }
315              
316             # XXX: must require rather than use Pandoc::Metadata
317             # or its attempt to use Pandoc::Elements will result in a broken state.
318             require Pandoc::Metadata;
319              
320             sub metadata($); ## no critic
321              
322             sub metadata($) { ## no critic
323 47     47 0 184 my $value = shift;
324 47 100       237 if ( !ref $value ) {
    100          
    100          
    100          
    100          
325 6   100     31 MetaString($value // '')
326             }
327             elsif ( JSON::is_bool($value) ) {
328 2         23 MetaBool($value)
329             }
330             elsif ( blessed($value) ) {
331 11 100 100     270 if ( $value->can('is_meta') and $value->is_meta ) {
    100 100        
    100 66        
    50          
332 8         66 $value
333             }
334             elsif ( $value->can('is_inline') and $value->is_inline ) {
335 1         6 MetaInlines([ $value ])
336             }
337             elsif ( $value->can('is_block') and $value->is_block ) {
338 1         4 MetaBlocks([ $value ])
339             } elsif ( $value->isa('Pandoc::Document::Metadata') ) {
340 0         0 MetaMap( { map { $_ => $value->{$_} } keys %$value } )
  0         0  
341             } else {
342 1         10 MetaString("$value")
343             }
344             }
345             elsif ( reftype $value eq 'ARRAY' ) {
346 2         26 MetaList( [ map { metadata $_ } @$value ] )
  2         11  
347             }
348             elsif ( reftype $value eq 'HASH' ) {
349 25         373 MetaMap( { map { $_ => metadata $value->{$_} } keys %$value } )
  10         50  
350             }
351             else {
352 1         16 MetaString("$value")
353             }
354             }
355              
356             sub pandoc_json($) {
357 21 50   21 1 15756 shift if $_[0] =~ /^Pandoc::/;
358              
359 21         65 my $ast = eval { decode_json( $_[0] ) };
  21         698  
360 21 50       107 if ($@) {
361 0         0 $@ =~ s/ at [^ ]+Elements\.pm line \d+//;
362 0         0 chomp $@;
363 0         0 croak $@;
364             }
365 21         91 return Document $ast;
366             }
367              
368             *pandoc_query = *Pandoc::Walker::query;
369              
370             # document element packages
371              
372             {
373              
374             package Pandoc::Document;
375 31     31   287 use strict;
  31         93  
  31         1063  
376 31     31   246 use Carp 'croak';
  31         91  
  31         1874  
377 31     31   239 use Scalar::Util qw(blessed reftype);
  31         107  
  31         1761  
378 31     31   16143 use Pandoc;
  31         2066133  
  31         258  
379             our $VERSION = '0.04';
380             our @ISA = ('Pandoc::Document::Element');
381             sub blocks;
382 1     1   7 sub name { 'Document' }
383             sub meta {
384 159 100   159   13237 if (@_ > 1) {
385 24 50       166 croak "document metadata must be a hash"
386             unless 'HASH' eq reftype $_[1];
387 24         89 my $map = Pandoc::Elements::metadata($_[1])->content;
388 24         270 $_[0]->{meta} = bless $map, 'Pandoc::Document::Metadata';
389             }
390 159         988 $_[0]->{meta};
391             }
392             sub content {
393 13 50   13   400 $_[0]->{blocks} = $_[1] if @_ > 1;
394 13         165 $_[0]->{blocks};
395             }
396             *blocks = \&content;
397 1     1   13 sub is_document { 1 }
398             sub as_block {
399 0     0   0 bless { t => 'Div', c => [ {}, $_[0]->{blocks} ] }, 'Pandoc::Document::Div';
400             }
401             sub value {
402 108     108   54517 shift->meta->value(@_);
403             }
404             *metavalue = \&value;
405             sub string {
406 2     2   12 join '', map { $_->string } @{$_[0]->content}
  3         31  
  2         12  
407             }
408             sub api_version {
409 105     105   753 my $self = shift;
410 105 100       466 if ( @_ ) {
411 49         305 my $version = Pandoc::Version->new(shift);
412 49 100       3258 croak "api_version must be >= $PANDOC_API_MIN"
413             if $version < $PANDOC_API_MIN;
414 48 50       2926 croak "api_version must have major and minor part"
415             if @$version < 2;
416 48         178 $self->{'pandoc-api-version'} = $version;
417             }
418 104         411 return $self->{'pandoc-api-version'};
419             }
420             *pandoc_version = \&Pandoc::Elements::pandoc_version;
421             sub outline {
422 0     0   0 my ($self, $depth) = @_;
423 0         0 _sections( [@{$self->blocks}], $depth );
  0         0  
424             }
425             sub _sections {
426 0     0   0 my ($list, $depth) = @_;
427 0         0 my (@blocks, @sections);
428              
429             # everything up to the first Header
430 0         0 while (@$list) {
431 0 0       0 if ($list->[0]->name eq 'Header') {
432 0 0 0     0 last if !$depth or $depth >= $list->[0]->level;
433             }
434 0         0 push @blocks, shift @$list;
435             }
436              
437             # divide into sections
438 0         0 while (@$list) {
439 0         0 my $header = shift @$list;
440 0         0 my $level = $header->level;
441              
442 0         0 my @content;
443 0         0 while (@$list) {
444 0 0       0 if ($list->[0]->name eq 'Header') {
445 0 0       0 last if $list->[0]->level <= $level;
446             }
447 0         0 push @content, shift @$list;
448             }
449              
450 0 0 0     0 my $s = ($depth and $depth < $level)
451             ? { blocks => \@content }
452             : _sections(\@content,$depth);
453 0         0 push @sections, { header => $header, %$s };
454             }
455              
456 0         0 return { blocks => \@blocks, sections => \@sections };
457             }
458             sub to_pandoc {
459 0     0   0 my ($self, @args) = @_;
460 0 0 0     0 my $pandoc = (@args and blessed($args[0]) and $args[0]->isa('Pandoc'))
461             ? shift(@args) : pandoc;
462              
463 0         0 my $api_version = $self->api_version; # save
464 0         0 $self->pandoc_version( $pandoc->version );
465              
466 0         0 my $in = $self->to_json;
467 0         0 $self->api_version($api_version); # restore
468              
469 0         0 $pandoc->run( [ -f => 'json', @args ], { in => \$in, out => \my $out } );
470 0         0 return $out;
471             }
472             foreach my $format (qw(markdown latex html rst plain)) {
473 31     31   29529 no strict 'refs';
  31         85  
  31         4260  
474             *{ __PACKAGE__ . "::to_$format" } = sub {
475 0     0   0 shift()->to_pandoc( @_, '-t' => $format );
476             }
477             }
478             }
479              
480             {
481             package Pandoc::Document::Keyword;
482             our @ISA = ('Pandoc::Document::Element');
483             }
484              
485             {
486              
487             package Pandoc::Document::Element;
488 31     31   233 use strict;
  31         75  
  31         835  
489 31     31   198 use warnings;
  31         80  
  31         1570  
490             our $VERSION = $Pandoc::Document::VERSION;
491 31     31   212 use JSON ();
  31         66  
  31         762  
492 31     31   188 use Scalar::Util qw(reftype blessed);
  31         66  
  31         1981  
493 31     31   209 use Pandoc::Walker ();
  31         74  
  31         639  
494 31     31   13121 use Pandoc::Selector;
  31         93  
  31         1259  
495 31     31   16483 use subs qw(walk query transform); # Silence syntax warnings
  31         831  
  31         184  
496              
497             sub to_json {
498 32     32 0 4279 JSON->new->utf8->canonical->convert_blessed->encode( $_[0] );
499             }
500              
501             sub TO_JSON {
502              
503             # Run everything thru this method so arrays/hashes are cloned
504             # and objects without TO_JSON methods are stringified.
505             # Required to ensure correct scalar types for Pandoc.
506              
507             # There is no easy way in Perl to tell if a scalar value is already a string or number,
508             # so we stringify all scalar values and numify/boolify as needed afterwards.
509              
510 581     581 0 1472 my ( $ast, $maybe_blessed ) = @_;
511 581 100 100     3064 if ( $maybe_blessed && blessed $ast ) {
    100          
    50          
512 193 50       1250 return $ast if $ast->can('TO_JSON'); # JSON.pm will convert
513             # may have overloaded stringification! Should we check?
514             # require overload;
515             # return "$ast" if overload::Method($ast, q/""/) or overload::Method($ast, q/0+/);
516             # carp "Non-stringifiable object $ast";
517 0         0 return "$ast";
518             }
519             elsif ( 'ARRAY' eq reftype $ast ) {
520 169 100       610 return [ map { ref($_) ? TO_JSON( $_, 1 ) : "$_"; } @$ast ];
  287         969  
521             }
522             elsif ( 'HASH' eq reftype $ast ) {
523 219         996 my %ret = %$ast;
524 219         992 while ( my ( $k, $v ) = each %ret ) {
525 438 100       1953 $ret{$k} = ref($v) ? TO_JSON( $v, 1 ) : "$v";
526             }
527 219         1814 return \%ret;
528             }
529 0         0 else { return "$ast" }
530             }
531              
532 719     719 0 6339 sub name { $_[0]->{t} }
533             sub content {
534 0     0 0 0 my $e = shift;
535 0 0       0 $e->set_content(@_) if @_;
536             $e->{c}
537 0         0 }
538             sub set_content { # TODO: document this
539 584     584 0 1074 my $e = shift;
540 584 100       2440 $e->{c} = @_ == 1 ? $_[0] : [@_]
541             }
542 1     1 0 6 sub is_document { 0 }
543 2     2 0 24 sub is_block { 0 }
544 3     3 0 22 sub is_inline { 0 }
545 3     3 0 27 sub is_meta { 0 }
546             sub as_block {
547 0     0 0 0 bless { t => 'Null', c => [] }, 'Pandoc::Document::Null';
548             }
549             *walk = *Pandoc::Walker::walk;
550             *query = *Pandoc::Walker::query;
551             *transform = *Pandoc::Walker::transform;
552              
553             sub string {
554              
555             # TODO: fix issue #4 to avoid this duplication
556 60 100   60 0 248 if ( $_[0]->name =~ /^(Str|Code|CodeBlock|Math|MetaString)$/ ) {
    100          
557 41         1292 return $_[0]->content;
558             }
559             elsif ( $_[0]->name =~ /^(LineBreak|SoftBreak|Space)$/ ) {
560 1         7 return ' ';
561             }
562             join '', @{
563 18         52 $_[0]->query(
564             {
565 31     31   1006 'Str|Code|CodeBlock|Math|MetaString' => sub { $_->content },
566 14     14   49 'LineBreak|Space|SoftBreak' => sub { ' ' },
567             }
568 18         228 );
569             };
570             }
571              
572             sub match {
573 167     167 0 2306 my $self = shift;
574 167 100       896 my $selector = blessed $_[0] ? shift : Pandoc::Selector->new(shift);
575 167         604 $selector->match($self);
576             }
577             }
578              
579             {
580              
581             package Pandoc::Document::AttributesRole;
582 31     31   38818 use Hash::MultiValue;
  31         68338  
  31         1239  
583 31     31   239 use Scalar::Util qw(reftype blessed);
  31         70  
  31         2039  
584 31     31   215 use Carp qw(croak);
  31         91  
  31         28862  
585              
586             sub id {
587 107 100   107   974 $_[0]->attr->[0] = defined $_[1] ? "$_[1]" : "" if @_ > 1;
    100          
588 107         3015 $_[0]->attr->[0]
589             }
590              
591             sub classes {
592 0     0   0 my $e = shift;
593 0 0       0 croak 'Method classes() is not a setter' if @_;
594 0         0 warn "->classes is deprecated. Use [ split ' ', \$e->class ] instead\n";
595 0         0 $e->attr->[1]
596             }
597              
598             sub class {
599 24     24   75 my $e = shift;
600 24 100       73 if (@_) {
601             $e->attr->[1] = [
602 5         45 grep { $_ ne '' }
603 4         31 map { split qr/\s+/, $_ }
604 1 100 66     4 map { (ref $_ and reftype $_ eq 'ARRAY') ? @$_ : $_ }
  3         23  
605             @_
606             ];
607             }
608 24         50 join ' ', @{$e->attr->[1]}
  24         619  
609             }
610              
611             sub add_attribute {
612 41     41   131 my ($e, $key, $value) = @_;
613 41 100       166 if ($key eq 'id') {
    100          
614 14         68 $e->id($value);
615             } elsif ($key eq 'class') {
616 15   100     112 $value //= '';
617 15 100 100     132 $value = ["$value"] unless (reftype $value // '') eq 'ARRAY';
618 15         38 push @{$e->attr->[1]}, grep { $_ ne '' } map { split qr/\s+/, $_ } @$value;
  15         462  
  28         140  
  22         236  
619             } else {
620 12         91 push @{$e->attr->[2]}, [ $key, "$value" ];
  12         359  
621             }
622             }
623              
624             sub keyvals {
625 49     49   1124 my $e = shift;
626 49 100       167 if (@_) {
627 44 100       167 my $attrs = @_ == 1 ? shift : Hash::MultiValue->new(@_);
628 44 100 66     359 unless (blessed $attrs and $attrs->isa('Hash::MultiValue')) {
629 41         286 $attrs = Hash::MultiValue->new(%$attrs);
630             }
631 44 100       2632 $e->attr->[1] = [] if exists $attrs->{class};
632 44         1366 $e->attr->[2] = [];
633 44     41   367 $attrs->each(sub { $e->add_attribute(@_) });
  41         547  
634             }
635 49         1138 my @h;
636 49 100       209 push @h, id => $e->id if $e->id ne '';
637 49 100       121 push @h, class => $e->class if @{$e->attr->[1]};
  49         1232  
638 49         134 Hash::MultiValue->new( @h, map { @$_ } @{$e->attr->[2]} );
  20         115  
  49         1250  
639             }
640              
641             }
642              
643             {
644              
645             package Pandoc::Document::Block;
646             our $VERSION = $PANDOC::Document::VERSION;
647             our @ISA = ('Pandoc::Document::Element');
648 3     3   19 sub is_block { 1 }
649 1     1   6 sub as_block { $_[0] }
650             sub null { # TODO: document this (?)
651 1     1   4 %{$_[0]} = (t => 'Null', c => []);
  1         8  
652 1         7 bless $_[0], 'Pandoc::Document::Null';
653             }
654             }
655              
656             {
657              
658             package Pandoc::Document::Inline;
659             our $VERSION = $PANDOC::Document::VERSION;
660             our @ISA = ('Pandoc::Document::Element');
661 13     13   1956 sub is_inline { 1 }
662             sub as_block {
663 1     1   12 bless { t => 'Plain', c => [ $_[0] ] }, 'Pandoc::Document::Plain';
664             }
665             }
666              
667             {
668              
669             package Pandoc::Document::LinkageRole;
670             our $VERSION = $PANDOC::Document::VERSION;
671              
672             for my $Element (qw[ Link Image ]) {
673 31     31   271 no strict 'refs'; #no critic
  31         79  
  31         36209  
674             unshift @{"Pandoc::Document::${Element}::ISA"}, __PACKAGE__; # no critic
675             }
676              
677 15 100 100 15   77 sub url { my $e = shift; $e->{c}->[-1][0] = shift if @_; return $e->{c}->[-1][0] //= ""; }
  15         50  
  15         94  
678 6 100 100 6   15 sub title { my $e = shift; $e->{c}->[-1][1] = shift if @_; return $e->{c}->[-1][1] //= ""; }
  6         20  
  6         37  
679              
680             sub upgrade {
681             # prepend attributes to old-style ast
682 2         13 unshift @{ $_[0]->{c} }, [ "", [], [] ]
683 16 100   16   32 if 2 == @{ $_[0]->{c} };
  16         76  
684             }
685             }
686              
687             # Special TO_JSON methods to coerce data to int/number/Boolean as appropriate
688             # and to downgrade document model depending on pandoc_version
689              
690             sub Pandoc::Document::to_json {
691 16     16   91755 my ($self) = @_;
692              
693 16   66     107 local $Pandoc::Elements::PANDOC_VERSION =
694             $Pandoc::Elements::PANDOC_VERSION // $self->pandoc_version;
695              
696 16         272 return Pandoc::Document::Element::to_json( $self->TO_JSON );
697             }
698              
699             sub Pandoc::Document::TO_JSON {
700 19     19   2030 my ( $self ) = @_;
701             return $self->api_version >= 1.17
702             ? { %$self }
703 19 100       74 : [ { unMeta => $self->{meta} }, $self->{blocks} ]
704             }
705              
706             sub Pandoc::Document::SoftBreak::TO_JSON {
707 14 100   14   53 if ( pandoc_version() < '1.16' ) {
708 4         516 return { t => 'Space', c => [] };
709             } else {
710 10         1129 return { t => 'SoftBreak', c => [] };
711             }
712             }
713              
714             sub Pandoc::Document::LinkageRole::TO_JSON {
715 4     4   14 my $ast = Pandoc::Document::Element::TO_JSON( $_[0] );
716 4 100       72 if ( pandoc_version() < 1.16 ) {
717             # remove attributes
718 2         340 $ast->{c} = [ @{ $ast->{c} }[ 1, 2 ] ];
  2         9  
719             }
720 4         346 return $ast;
721             }
722              
723             sub Pandoc::Document::Header::TO_JSON {
724 9     9   43 my $ast = Pandoc::Document::Element::TO_JSON( $_[0] );
725              
726             # coerce heading level to int
727 9         37 $ast->{c}[0] = int( $ast->{c}[0] );
728 9         64 return $ast;
729             }
730              
731             sub Pandoc::Document::OrderedList::TO_JSON {
732 0     0   0 my $ast = Pandoc::Document::Element::TO_JSON( $_[0] );
733              
734             # coerce first item number to int
735 0         0 $ast->{c}[0][0] = int( $ast->{c}[0][0] );
736 0         0 return $ast;
737             }
738              
739             sub Pandoc::Document::Table::TO_JSON {
740 0     0   0 my $ast = Pandoc::Document::Element::TO_JSON( $_[0] );
741              
742             # coerce column widths to numbers (floats)
743 0         0 $_ += 0 for @{ $ast->{c}[2] }; # faster than map
  0         0  
744 0         0 return $ast;
745             }
746              
747             sub Pandoc::Document::Cite::TO_JSON {
748 0     0   0 my $ast = Pandoc::Document::Element::TO_JSON( $_[0] );
749 0         0 for my $citation ( @{ $ast->{c}[0] } ) {
  0         0  
750 0         0 for my $key (qw[ citationHash citationNoteNum ]) {
751              
752             # coerce to int
753 0         0 $citation->{$key} = int( $citation->{$key} );
754             }
755             }
756 0         0 return $ast;
757             }
758              
759             sub Pandoc::Document::LineBlock::TO_JSON {
760 2     2   7 my $ast = Pandoc::Document::Element::TO_JSON( $_[0] );
761 2         6 my $content = $ast->{c};
762              
763 2         4 for my $line ( @$content ) {
764              
765             # Convert spaces at the beginning of each line
766             # to Unicode non-breaking spaces, because pandoc does.
767 6 50 33     37 next unless @$line and $line->[0]->{t} eq 'Str';
768 6         22 $line->[0]->{c} =~ s{^(\x{20}+)}{ "\x{a0}" x length($1) }e;
  2         13  
769             }
770              
771 2 100       6 return $ast if pandoc_version() >= 1.18;
772              
773 1         169 my $c = [ map { ; @$_, LineBreak() } @{$content} ];
  3         7  
  1         3  
774 1         2 pop @$c; # remove trailing line break
775 1         6 return Para( $c )->TO_JSON;
776             }
777              
778             1;
779             __END__