File Coverage

blib/lib/Pandoc/Elements.pm
Criterion Covered Total %
statement 427 537 79.5
branch 182 394 46.1
condition 60 88 68.1
subroutine 80 91 87.9
pod 6 19 31.5
total 755 1129 66.8


line stmt bran cond sub pod time code
1             package Pandoc::Elements;
2 30     30   1958124 use strict;
  30         324  
  30         1080  
3             ## no critic (ProhibitNoStrict, ProhibitSubroutinePrototypes)
4 30     30   200 use warnings;
  30         70  
  30         992  
5 30     30   932 use 5.010001;
  30         113  
6              
7             our $VERSION = '0.36';
8              
9 30     30   247 use Carp;
  30         65  
  30         2375  
10 30     30   18106 use JSON qw(decode_json);
  30         354993  
  30         243  
11 30     30   5776 use Scalar::Util qw(blessed reftype);
  30         80  
  30         2159  
12 30     30   12616 use Pandoc::Walker qw(walk);
  30         91  
  30         1949  
13 30     30   15144 use Pandoc::Version;
  30         64417  
  30         21696  
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   315 (blessed $_[0] and $_[0]->isa('Pandoc::Version'))
34             ? $_[0] : Pandoc::Version->new($_[0])
35             }
36              
37             sub pandoc_version {
38 54 100   54 1 1634 if (@_) {
    100          
39 29         73 my $doc = shift;
40 29 100       103 if (@_) {
41 9   100     23 $doc->api_version(
42             _minimum_pandoc_api_for(@_)
43             // croak "pandoc version not supported"
44             );
45             }
46 27         109 _minimum_pandoc_version_for_api($doc->api_version);
47             } elsif (defined $PANDOC_VERSION) {
48 23         76 _as_pandoc_version($PANDOC_VERSION)
49             } else {
50 2         66 $REQUIRED_API[0]
51             }
52             }
53              
54             sub _minimum_pandoc_version_for_api {
55 27     27   61 my $api = shift;
56              
57 27         56 my $version;
58              
59 27         104 foreach (grep { $_ % 2} 0 .. @REQUIRED_API) { # 1,3,...
  243         460  
60 108 100       5232 if ($api->match($REQUIRED_API[$_]) ) {
61 48 100 100     5540 if (!$version or $version > $REQUIRED_API[$_-1]) {
62 38         854 $version = $REQUIRED_API[$_-1]
63             }
64             }
65             }
66              
67 27 100 66     2500 if (!$version and $api >= $PANDOC_API_MIN) {
68 3         157 $PANDOC_BIN_MIN;
69             } else {
70 24         435 return $version;
71             }
72             }
73              
74             sub _minimum_pandoc_api_for {
75 9     9   20 my $version = _as_pandoc_version(shift);
76 9 50       430 return if @$version <= 1; # require major.minor
77              
78 9         32 foreach (grep { $_ % 2} 0 .. @REQUIRED_API) { # 1,3,...
  81         124  
79 28 100       2177 if ($version->match($REQUIRED_API[$_-1]) ) {
80 5         574 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       387 if ($version > $REQUIRED_API[0]) {
87 1         37 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 30     30   335 use parent 'Exporter';
  30         75  
  30         245  
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 30     30   3955 no strict 'refs'; ## no critic
  30         94  
  30         14244  
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 476 100   476   21082 croak "$name expects $numargs arguments, but given " . scalar @_
171             if @_ != $numargs;
172 475 100       2583 my $self = bless {
173             t => $name,
174             c => ( @_ == 1 ? $_[0] : [@_] )
175             }, "Pandoc::Document::$name";
176 475         2205 $self->set_content(@_);
177 475         2479 $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 6 0   6   20 *{"Pandoc::Document::${name}::$_"} = eval "sub { $code }";
  6 50       17  
  6 0       23  
  0 0       0  
  0 0       0  
  0 50       0  
  1 0       7  
  1 50       7  
  1 0       9  
  35 50       78  
  35 0       75  
  35 50       186  
  7 0       195  
  7 50       17  
  7 0       26  
  11 0       65  
  11 0       35  
  11 50       72  
  1 0       5  
  1 0       5  
  1 50       5  
  0 100       0  
  0 0       0  
  0 50       0  
  4 0       14  
  4 50       14  
  4 0       17  
  0 0       0  
  0 0       0  
  0 50       0  
  3 0       13  
  3 0       14  
  3 0       16  
  5 50       160  
  5 0       15  
  5 50       17  
  1 0       4  
  1 0       4  
  1 0       4  
  0 50       0  
  0 0       0  
  0 50       0  
  2 0       6  
  2 50       6  
  2 0       10  
  0 0       0  
  0 0       0  
  0 0       0  
  4 0       40  
  4 50       13  
  4 0       7  
  18 50       84  
  14 0       39  
  10 50       54  
  0 0       0  
  0 0       0  
  0 0       0  
  4 0       135  
  4 0       12  
  5 50       15  
  1 0       4  
  1 50       5  
  4 0       162  
  4 50       15  
  4 0       29  
  8 0       267  
  8 0       29  
  8 50       29  
  2 0       8  
  1 0       3  
  0 50       0  
  0 100       0  
  0 0       0  
  0 0       0  
  0 0       0  
  19 50       47  
  20 50       53  
  22 50       77  
  3 0       18  
  2 50       23  
  63 0       158  
  63 50       161  
  65 0       408  
  2 0       7  
  2 0       7  
  0 0       0  
  0 0       0  
  0 50       0  
  0 50       0  
  24 100       67  
  47 0       140  
  47 50       248  
  23 0       156  
  10 0       29  
  25 0       84  
  25 50       77  
  15 0       112  
  0 0       0  
  0 0       0  
  0 50       0  
  0 0       0  
  0 50       0  
  0 0       0  
  3 50       36  
  3 0       11  
  5 50       29  
  2 0       9  
  71 50       274  
  69 0       162  
  94 50       404  
  25 0       70  
  25 0       144  
  0 0       0  
  0 0       0  
  0         0  
  2         127  
  2         14  
  2         15  
  1         34  
  5         20  
  5         16  
  5         21  
  51         119  
  51         125  
  50         196  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  10         23  
  10         20  
  22         88  
  14         104  
  14         99  
  5         22  
  3         25  
  3         16  
  5         20  
  5         22  
  5         32  
  0         0  
  0         0  
  0         0  
  2         10  
  2         10  
  2         16  
  0         0  
  14         38  
  14         31  
  22         181  
  8         26  
  8         41  
  1         3  
  1         5  
  1         44  
  3         126  
  3         16  
  3         30  
  11         34  
  24         382  
  24         96  
  14         60  
  1         5  
  1         4  
  39         103  
  39         86  
  39         163  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
192             }
193             }
194             }
195              
196             sub element {
197 4     4 1 454 my $name = shift;
198 30     30   278 no strict 'refs'; #
  30         90  
  30         43752  
199 4 50       18 croak "undefined element" unless defined $name;
200 4 100       262 croak "unknown element $name" unless $ELEMENTS{$name};
201 3         20 &$name(@_);
202             }
203              
204             sub Document {
205              
206 50     50 1 30611 my $from_json;
207 50         108 my $arg = do {
208 50 100       248 if ( @_ == 1 ) {
    100          
    100          
209 26         56 $from_json = 1;
210 26   100     171 my $reftype = reftype $_[0] // '';
211 26 100       112 if ( $reftype eq 'ARRAY') {
    100          
212             # old JSON format
213             {
214             meta => $_[0]->[0]->{unMeta},
215 19         118 blocks => $_[0]->[1],
216             api_version => 1.16,
217             }
218             } elsif ( $reftype eq 'HASH' ) {
219 6         19 $_[0]
220             } else {
221 1         10 croak 'Document: expect array or hash reference'
222             }
223             } elsif ( @_ == 2 ) {
224             # \%meta, \@blocks
225 9         45 { meta => $_[0], blocks => $_[1] }
226             } elsif ( @_ % 2 ) {
227             # odd number of args
228 1         12 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 48   66     447 // $arg->{api_version};
      66        
239              
240             # We copy values here because $arg may not be a pure AST representation
241 48   50     408 my $doc = bless { blocks => ( $arg->{blocks} // [] ) }, 'Pandoc::Document';
242              
243             # unblessed metadata in internal format can only come from JSON
244 48   100     195 my $meta = $arg->{meta} // {};
245 48 100       153 if ($from_json) {
246 25 50       141 croak "Document metadata must be a hash" unless 'HASH' eq reftype $meta;
247             $doc->{meta} = bless {
248 25         189 map { $_ => _bless_pandoc_element( $meta->{$_} ) } keys %$meta
  25         90  
249             }, 'Pandoc::Document::Metadata';
250             } else {
251             # otherwise allow user-friendly upgrade via 'metadata' function
252 23         100 $doc->meta($meta)
253             }
254              
255 48 100 100     279 if (!defined $api_version and defined $arg->{pandoc_version}) {
256 9         31 $doc->pandoc_version($arg->{pandoc_version});
257             } else {
258 39   66     487 $doc->api_version($api_version // $REQUIRED_API[1]);
259             }
260              
261 45         289 walk $doc, \&_bless_pandoc_element;
262              
263 45         529 return $doc;
264              
265             }
266              
267             # internal helper method
268             sub _bless_pandoc_element {
269 445     445   728 my $e = shift;
270 445 50       967 return $e unless ref $e;
271 445 100 66     2024 return $e if blessed $e and $e->isa('Pandoc::Document::Element');
272              
273             # TODO: run recursively via set_content (don't require 'walk')
274 264 100       613 if ( 'MetaMap' eq $e->{t} ) {
275 5         11 for my $v ( values %{ $e->{c} } ) {
  5         25  
276 15         38 _bless_pandoc_element( $v );
277             }
278             }
279              
280 264         891 bless $e, 'Pandoc::Document::' . $e->{t};
281 264 100       1392 $e->upgrade($e) if $e->can('upgrade');
282 264         758 return $e;
283             }
284              
285              
286             # specific accessors
287              
288 1     1   4 sub Pandoc::Document::DefinitionPair::term { $_[0]->[0] }
289 1     1   14 sub Pandoc::Document::DefinitionPair::definitions { $_[0]->[1] }
290              
291             # additional functions
292              
293             sub attributes($) {
294              
295 39     39 1 9198 my $e = Span(['',[],[]],[]); # to make use of AttributesRole
296 39         214 $e->keyvals(@_);
297              
298 39         2782 return $e->attr;
299             }
300              
301             sub citation($) {
302 1     1 1 2 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     36 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 216 my $value = shift;
324 47 100       278 if ( !ref $value ) {
    100          
    100          
    100          
    100          
325 6   100     30 MetaString($value // '')
326             }
327             elsif ( JSON::is_bool($value) ) {
328 2         22 MetaBool($value)
329             }
330             elsif ( blessed($value) ) {
331 11 100 100     329 if ( $value->can('is_meta') and $value->is_meta ) {
    100 100        
    100 66        
    50          
332 8         58 $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         7 MetaBlocks([ $value ])
339             } elsif ( $value->isa('Pandoc::Document::Metadata') ) {
340 0         0 MetaMap( { map { $_ => $value->{$_} } keys %$value } )
  0         0  
341             } else {
342 1         15 MetaString("$value")
343             }
344             }
345             elsif ( reftype $value eq 'ARRAY' ) {
346 2         22 MetaList( [ map { metadata $_ } @$value ] )
  2         10  
347             }
348             elsif ( reftype $value eq 'HASH' ) {
349 25         428 MetaMap( { map { $_ => metadata $value->{$_} } keys %$value } )
  10         76  
350             }
351             else {
352 1         31 MetaString("$value")
353             }
354             }
355              
356             sub pandoc_json($) {
357 20 50   20 1 13601 shift if $_[0] =~ /^Pandoc::/;
358              
359 20         60 my $ast = eval { decode_json( $_[0] ) };
  20         628  
360 20 50       89 if ($@) {
361 0         0 $@ =~ s/ at [^ ]+Elements\.pm line \d+//;
362 0         0 chomp $@;
363 0         0 croak $@;
364             }
365 20         82 return Document $ast;
366             }
367              
368             *pandoc_query = *Pandoc::Walker::query;
369              
370             # document element packages
371              
372             {
373              
374             package Pandoc::Document;
375 30     30   300 use strict;
  30         136  
  30         1131  
376 30     30   234 use Carp 'croak';
  30         84  
  30         2150  
377 30     30   295 use Scalar::Util qw(blessed reftype);
  30         86  
  30         1701  
378 30     30   17457 use Pandoc;
  30         1965284  
  30         293  
379             our $VERSION = '0.04';
380             our @ISA = ('Pandoc::Document::Element');
381             sub blocks;
382 1     1   6 sub name { 'Document' }
383             sub meta {
384 73 100   73   11561 if (@_ > 1) {
385 24 50       159 croak "document metadata must be a hash"
386             unless 'HASH' eq reftype $_[1];
387 24         131 my $map = Pandoc::Elements::metadata($_[1])->content;
388 24         238 $_[0]->{meta} = bless $map, 'Pandoc::Document::Metadata';
389             }
390 73         464 $_[0]->{meta};
391             }
392             sub content {
393 13 50   13   552 $_[0]->{blocks} = $_[1] if @_ > 1;
394 13         147 $_[0]->{blocks};
395             }
396             *blocks = \&content;
397 1     1   11 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 24     24   7364 shift->meta->value(@_);
403             }
404             *metavalue = \&value;
405             sub string {
406 2     2   10 join '', map { $_->string } @{$_[0]->content}
  3         37  
  2         13  
407             }
408             sub api_version {
409 103     103   752 my $self = shift;
410 103 100       352 if ( @_ ) {
411 47         339 my $version = Pandoc::Version->new(shift);
412 47 100       3195 croak "api_version must be >= $PANDOC_API_MIN"
413             if $version < $PANDOC_API_MIN;
414 46 50       2573 croak "api_version must have major and minor part"
415             if @$version < 2;
416 46         227 $self->{'pandoc-api-version'} = $version;
417             }
418 102         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 30     30   28146 no strict 'refs';
  30         82  
  30         4487  
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 30     30   240 use strict;
  30         90  
  30         819  
489 30     30   214 use warnings;
  30         74  
  30         1720  
490             our $VERSION = $Pandoc::Document::VERSION;
491 30     30   239 use JSON ();
  30         67  
  30         744  
492 30     30   172 use Scalar::Util qw(reftype blessed);
  30         63  
  30         2128  
493 30     30   203 use Pandoc::Walker ();
  30         67  
  30         600  
494 30     30   14990 use Pandoc::Selector;
  30         104  
  30         1284  
495 30     30   17099 use subs qw(walk query transform); # Silence syntax warnings
  30         810  
  30         182  
496              
497             sub to_json {
498 32     32 0 4890 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 1209 my ( $ast, $maybe_blessed ) = @_;
511 581 100 100     2505 if ( $maybe_blessed && blessed $ast ) {
    100          
    50          
512 193 50       992 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       511 return [ map { ref($_) ? TO_JSON( $_, 1 ) : "$_"; } @$ast ];
  287         785  
521             }
522             elsif ( 'HASH' eq reftype $ast ) {
523 219         787 my %ret = %$ast;
524 219         770 while ( my ( $k, $v ) = each %ret ) {
525 438 100       1602 $ret{$k} = ref($v) ? TO_JSON( $v, 1 ) : "$v";
526             }
527 219         1476 return \%ret;
528             }
529 0         0 else { return "$ast" }
530             }
531              
532 691     691 0 5124 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 460     460 0 768 my $e = shift;
540 460 100       1586 $e->{c} = @_ == 1 ? $_[0] : [@_]
541             }
542 1     1 0 5 sub is_document { 0 }
543 2     2 0 13 sub is_block { 0 }
544 3     3 0 22 sub is_inline { 0 }
545 3     3 0 24 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 42 100   42 0 183 if ( $_[0]->name =~ /^(Str|Code|CodeBlock|Math|MetaString)$/ ) {
    100          
557 25         651 return $_[0]->content;
558             }
559             elsif ( $_[0]->name =~ /^(LineBreak|SoftBreak|Space)$/ ) {
560 1         10 return ' ';
561             }
562             join '', @{
563 16         111 $_[0]->query(
564             {
565 29     29   771 'Str|Code|CodeBlock|Math|MetaString' => sub { $_->content },
566 14     14   38 'LineBreak|Space|SoftBreak' => sub { ' ' },
567             }
568 16         252 );
569             };
570             }
571              
572             sub match {
573 163     163 0 2350 my $self = shift;
574 163 100       726 my $selector = blessed $_[0] ? shift : Pandoc::Selector->new(shift);
575 163         487 $selector->match($self);
576             }
577             }
578              
579             {
580              
581             package Pandoc::Document::AttributesRole;
582 30     30   39098 use Hash::MultiValue;
  30         66087  
  30         1339  
583 30     30   239 use Scalar::Util qw(reftype blessed);
  30         60  
  30         1963  
584 30     30   206 use Carp qw(croak);
  30         67  
  30         26306  
585              
586             sub id {
587 107 100   107   816 $_[0]->attr->[0] = defined $_[1] ? "$_[1]" : "" if @_ > 1;
    100          
588 107         2702 $_[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   78 my $e = shift;
600 24 100       60 if (@_) {
601             $e->attr->[1] = [
602 5         52 grep { $_ ne '' }
603 4         34 map { split qr/\s+/, $_ }
604 1 100 66     74 map { (ref $_ and reftype $_ eq 'ARRAY') ? @$_ : $_ }
  3         28  
605             @_
606             ];
607             }
608 24         61 join ' ', @{$e->attr->[1]}
  24         532  
609             }
610              
611             sub add_attribute {
612 41     41   115 my ($e, $key, $value) = @_;
613 41 100       152 if ($key eq 'id') {
    100          
614 14         55 $e->id($value);
615             } elsif ($key eq 'class') {
616 15   100     49 $value //= '';
617 15 100 100     131 $value = ["$value"] unless (reftype $value // '') eq 'ARRAY';
618 15         35 push @{$e->attr->[1]}, grep { $_ ne '' } map { split qr/\s+/, $_ } @$value;
  15         389  
  28         117  
  22         215  
619             } else {
620 12         48 push @{$e->attr->[2]}, [ $key, "$value" ];
  12         381  
621             }
622             }
623              
624             sub keyvals {
625 49     49   1012 my $e = shift;
626 49 100       175 if (@_) {
627 44 100       147 my $attrs = @_ == 1 ? shift : Hash::MultiValue->new(@_);
628 44 100 66     346 unless (blessed $attrs and $attrs->isa('Hash::MultiValue')) {
629 41         286 $attrs = Hash::MultiValue->new(%$attrs);
630             }
631 44 100       2662 $e->attr->[1] = [] if exists $attrs->{class};
632 44         1423 $e->attr->[2] = [];
633 44     41   387 $attrs->each(sub { $e->add_attribute(@_) });
  41         602  
634             }
635 49         1088 my @h;
636 49 100       261 push @h, id => $e->id if $e->id ne '';
637 49 100       110 push @h, class => $e->class if @{$e->attr->[1]};
  49         1067  
638 49         117 Hash::MultiValue->new( @h, map { @$_ } @{$e->attr->[2]} );
  20         118  
  49         1093  
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   37 sub is_block { 1 }
649 1     1   4 sub as_block { $_[0] }
650             sub null { # TODO: document this (?)
651 1     1   3 %{$_[0]} = (t => 'Null', c => []);
  1         6  
652 1         5 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   2196 sub is_inline { 1 }
662             sub as_block {
663 1     1   9 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 30     30   269 no strict 'refs'; #no critic
  30         79  
  30         36032  
674             unshift @{"Pandoc::Document::${Element}::ISA"}, __PACKAGE__; # no critic
675             }
676              
677 15 100 100 15   68 sub url { my $e = shift; $e->{c}->[-1][0] = shift if @_; return $e->{c}->[-1][0] //= ""; }
  15         43  
  15         86  
678 6 100 100 6   15 sub title { my $e = shift; $e->{c}->[-1][1] = shift if @_; return $e->{c}->[-1][1] //= ""; }
  6         24  
  6         40  
679              
680             sub upgrade {
681             # prepend attributes to old-style ast
682 2         13 unshift @{ $_[0]->{c} }, [ "", [], [] ]
683 16 100   16   27 if 2 == @{ $_[0]->{c} };
  16         59  
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   74539 my ($self) = @_;
692              
693 16   66     118 local $Pandoc::Elements::PANDOC_VERSION =
694             $Pandoc::Elements::PANDOC_VERSION // $self->pandoc_version;
695              
696 16         263 return Pandoc::Document::Element::to_json( $self->TO_JSON );
697             }
698              
699             sub Pandoc::Document::TO_JSON {
700 19     19   1733 my ( $self ) = @_;
701             return $self->api_version >= 1.17
702             ? { %$self }
703 19 100       86 : [ { unMeta => $self->{meta} }, $self->{blocks} ]
704             }
705              
706             sub Pandoc::Document::SoftBreak::TO_JSON {
707 14 100   14   46 if ( pandoc_version() < '1.16' ) {
708 4         464 return { t => 'Space', c => [] };
709             } else {
710 10         841 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       15 if ( pandoc_version() < 1.16 ) {
717             # remove attributes
718 2         295 $ast->{c} = [ @{ $ast->{c} }[ 1, 2 ] ];
  2         12  
719             }
720 4         363 return $ast;
721             }
722              
723             sub Pandoc::Document::Header::TO_JSON {
724 9     9   51 my $ast = Pandoc::Document::Element::TO_JSON( $_[0] );
725              
726             # coerce heading level to int
727 9         147 $ast->{c}[0] = int( $ast->{c}[0] );
728 9         63 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   9 my $ast = Pandoc::Document::Element::TO_JSON( $_[0] );
761 2         7 my $content = $ast->{c};
762              
763 2         6 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     29 next unless @$line and $line->[0]->{t} eq 'Str';
768 6         24 $line->[0]->{c} =~ s{^(\x{20}+)}{ "\x{a0}" x length($1) }e;
  2         12  
769             }
770              
771 2 100       7 return $ast if pandoc_version() >= 1.18;
772              
773 1         230 my $c = [ map { ; @$_, LineBreak() } @{$content} ];
  3         7  
  1         3  
774 1         3 pop @$c; # remove trailing line break
775 1         19 return Para( $c )->TO_JSON;
776             }
777              
778             1;
779             __END__