File Coverage

blib/lib/Pandoc/Metadata.pm
Criterion Covered Total %
statement 108 113 95.5
branch 39 44 88.6
condition 20 33 60.6
subroutine 24 25 96.0
pod n/a
total 191 215 88.8


line stmt bran cond sub pod time code
1             package Pandoc::Metadata;
2 31     31   248 use strict;
  31         86  
  31         1134  
3 31     31   205 use warnings;
  31         79  
  31         1024  
4 31     31   678 use 5.010001;
  31         133  
5              
6 31     31   205 use Pandoc::Elements;
  31         78  
  31         9323  
7 31     31   262 use Scalar::Util qw(blessed reftype);
  31         78  
  31         1875  
8 31     31   23059 use JSON::PP;
  31         525435  
  31         3128  
9 31     31   297 use Carp;
  31         81  
  31         2430  
10             # # For Pandoc::Metadata::Error
11             # use Carp qw(shortmess longmess);
12              
13             # packages and methods
14              
15             {
16             # key-value map of metadata fields
17             package Pandoc::Document::Metadata;
18              
19             {
20 31     31   232 no warnings 'once';
  31         83  
  31         15376  
21             *to_json = \&Pandoc::Document::Element::to_json;
22             }
23              
24             sub TO_JSON {
25 18     18   299 return { map { $_ => $_[0]->{$_} } keys %{ $_[0] } };
  12         139  
  18         129  
26             }
27              
28             sub value {
29 110     110   385 my $map = { c => shift };
30 110         392 Pandoc::Document::MetaMap::value( $map, @_ )
31             }
32             }
33              
34             {
35             # metadata element parent class
36             package Pandoc::Document::Meta;
37             our @ISA = ('Pandoc::Document::Element');
38 9     9   437 sub is_meta { 1 }
39 0     0   0 sub value { shift->value(@_) }
40             }
41              
42             # # For Pandoc::Metadata::Error
43             # {
44             # package Pandoc::Metadata::Error;
45             # use overload q[""] => 'shortmess', q[%{}] => 'data', fallback => 1;
46             # use constant { SHORTMESS => 0, LONGMESS => 1, DATA => 2 };
47             # sub new {
48             # my($class, @values) = @_; # CLASS, (MESSAGE, {DATA})
49             # bless \@values => $class;
50             # }
51             # sub shortmess { shift->[SHORTMESS] }
52             # sub longmess { shift->[LONGMESS] }
53             # sub data { shift->[DATA] }
54             # sub rethrow { die shift }
55             # sub throw { shift->new( @_ )->rethrow }
56             # }
57              
58             # helpers
59              
60             my @token_keys = qw(last_pointer ref_token plain_key key empty pointer);
61              
62             sub _pointer_token {
63 161     161   343 state $valid_pointer_re = qr{\A (?: [^/] .* | (?: / [^/]* )* ) \z}msx;
64 161         293 state $token_re = qr{
65             \A
66             (?<_last_pointer>
67             (?<_ref_token>
68             (?<_plain_key>
69             (?<_key> [^/] .* \z ) # plain "key"
70             )
71             | / (?<_key> [^/]* ) # "/key"
72             | (?<_empty> \z ) # "" -- return current element
73             )
74             (?<_pointer> / .* \z | )
75             )
76             \z
77             }msx;
78             # set non-participating keys to undef
79 161         296 state $defaults = { map {; "_$_" => undef } @token_keys };
  18         72  
80 161         532 my %opts = @_;
81 161   0     466 $opts{_pointer} //= $opts{_full_pointer} //= $opts{pointer} //= "";
      0        
      33        
82 161   33     1409 $opts{_pointer} =~ $valid_pointer_re // _bad_pointer( %opts, _error => 'pointer' );
83 161         1047 $opts{_pointer} =~ $token_re; # guaranteed to match since validation matched!
84 31     31   15862 my %match = %+;
  31         12201  
  31         45145  
  161         3418  
85 161 100       926 unless ( grep { defined $_ } @match{qw(_plain_key _empty)} ) {
  322         1101  
86 95         299 $match{_key} =~ s!\~1!/!g;
87 95         241 $match{_key} =~ s!\~0!~!g;
88             }
89 161         1740 return (%opts, %$defaults, %match);
90             }
91              
92             sub _bad_pointer {
93 18     18   40 state $params_for = do {
94 2         43 my %params_map = (
95             default => {
96             msg => 'Invalid or unknown pointer reference "%s"',
97             in => 1,
98             _keys => ['_ref_token'],
99             pointer => '_last_pointer'
100             },
101             pointer => { msg => 'Invalid', in => 0, _keys => [], pointer => '_last_pointer', },
102             container => { msg => 'No list or mapping "%s"', },
103             key => { msg => 'Node "%s" doesn\'t correspond to any key', },
104             range => { msg => 'List index %s out of range', _keys => ['_key'], },
105             index => { msg => 'Node "%s" not a valid list index', },
106             );
107 2         12 for my $key ( keys %params_map ) {
108 12         31 for my $params ( $params_map{$key} ) {
109 12         33 $params = { %{ $params_map{default} }, %$params };
  12         70  
110 12 100       51 $params->{msg} .= ( $params->{in} ? q[ in] : "" );
111             $params->{keys}
112 12         26 = [ @{ $params->{_keys} }, $params->{pointer}, '_full_pointer' ];
  12         45  
113             }
114             }
115 2         10 \%params_map;
116             };
117             # # For Pandoc::Metadata::Error
118             # state $data_keys = {
119             # ( map { ; $_ => $_ } qw[element strict boolean] ),
120             # ( map { ; $_ => "_$_" } @token_keys, qw[error] ),
121             # ( pointer => '_full_pointer', next_pointer => '_pointer' ),
122             # };
123 18         115 my ( %opts ) = @_;
124 18 100       173 return undef unless $opts{strict};
125 5   50     16 $opts{_error} //= 'default';
126 5         14 my $params = $params_for->{ $opts{_error} };
127 5 100       18 if ( $opts{_error} eq 'container' ) {
128 1         8 %opts = _pointer_token( %opts );
129             }
130 5         22 my $msg = sprintf $params->{msg} . q[ (sub)pointer "%s" in pointer "%s"], @opts{ @{ $params->{keys} } };
  5         36  
131             # # For Pandoc::Metadata::Error
132             # my %data;
133             # @data{ keys %$data_keys } = @opts{ values %$data_keys };
134             # Pandoc::Metadata::Error->throw( shortmess($msg), longmess($msg), \%data );
135 5         70 croak $msg;
136             }
137              
138             # methods
139              
140             sub _value_args {
141 309     309   797 my $content = shift->{c};
142 309 100       1534 my ($pointer, %opts) = @_ % 2 ? @_ : (undef, @_);
143              
144 309   100     1432 $opts{_pointer} = $pointer // $opts{_pointer} // $opts{pointer} // '';
      66        
      50        
145 309   100     1208 $opts{_full_pointer} //= $opts{_pointer};
146              
147 309         2137 return ($content, %opts);
148             }
149              
150             sub Pandoc::Document::MetaString::value {
151 98     98   266 my ($content, %opts) = _value_args(@_);
152              
153 98 100       348 if ($opts{_pointer} ne '') {
154 1         8 _bad_pointer(%opts, _error => 'container');
155             } else {
156 97         791 $content;
157             }
158             }
159              
160             sub Pandoc::Document::MetaBool::set_content {
161 15 100 100 15   131 $_[0]->{c} = $_[1] && $_[1] ne 'false' && $_[1] ne 'FALSE' ? 1 : 0;
162             }
163              
164             sub Pandoc::Document::MetaBool::TO_JSON {
165             return {
166             t => 'MetaBool',
167 11 100   11   54 c => $_[0]->{c} ? JSON::true() : JSON::false(),
168             };
169             }
170              
171             sub Pandoc::Document::MetaBool::value {
172 14     14   46 my ($content, %opts) = _value_args(@_);
173              
174 14 50 100     93 if ($opts{_pointer} ne '') {
    100          
175 0         0 _bad_pointer(%opts, _error => 'container');
176             } elsif (($opts{boolean} // '') eq 'JSON::PP') {
177 3 100       18 $content ? JSON::true() : JSON::false();
178             } else {
179 11 100       58 $content ? 1 : 0;
180             }
181             }
182              
183             sub Pandoc::Document::MetaMap::value {
184 119     119   349 my ($map, %opts) = _value_args(@_);
185 119         488 %opts = _pointer_token(%opts);
186              
187 119 100       689 if (defined $opts{_empty}) {
    100          
188 12         50 return { map { $_ => $map->{$_}->value(%opts) } keys %$map };
  56         344  
189             } elsif (exists($map->{$opts{_key}})) {
190 92         451 return $map->{$opts{_key}}->value(%opts);
191             } else {
192 15         66 _bad_pointer( %opts, _error => 'key');
193             }
194             }
195              
196             sub Pandoc::Document::MetaList::value {
197 41     41   123 my ($content, %opts) = _value_args(@_);
198 41         192 %opts = _pointer_token(%opts);
199 41 100       316 if ( defined $opts{_empty} ) {
    100          
200 12         43 return [ map { $_->value(%opts) } @$content ]
  23         110  
201             } elsif ($opts{_key} =~ /^[1-9][0-9]*$|^0$/) {
202 28 100       131 if ( $opts{_key} > $#$content ) {
203 1         7 return _bad_pointer( %opts, _error => 'range' );
204             }
205 27         82 my $value = $content->[$opts{_key}];
206 27 50       138 return defined($value) ? $value->value(%opts) : undef;
207             } else {
208 1         7 return _bad_pointer( %opts, _error => 'index' );
209             }
210             }
211              
212             sub Pandoc::Document::MetaInlines::value {
213 32     32   96 my ($content, %opts) = _value_args(@_);
214              
215 32 50 50     199 if ($opts{_pointer} ne '') {
    50          
216 0         0 _bad_pointer(%opts, _error => 'container');
217             } elsif ($opts{element} // '' eq 'keep') {
218 0         0 $content;
219             } else {
220 32         82 join '', map { $_->string } @$content;
  32         141  
221             }
222             }
223              
224             sub Pandoc::Document::MetaBlocks::string {
225 4     4   17 join "\n\n", map { $_->string } @{$_[0]->content};
  8         39  
  4         135  
226             }
227              
228             sub Pandoc::Document::MetaBlocks::value {
229 5     5   18 my ($content, %opts) = _value_args(@_);
230              
231 5 50 100     35 if ($opts{_pointer} ne '') {
    100          
232 0         0 _bad_pointer(%opts);
233             } elsif ($opts{element} // '' eq 'keep') {
234 2         23 $content;
235             } else {
236 3         11 $_[0]->string;
237             }
238             }
239              
240             1;
241             __END__