File Coverage

blib/lib/Pandoc/Metadata.pm
Criterion Covered Total %
statement 107 112 95.5
branch 39 44 88.6
condition 20 33 60.6
subroutine 24 25 96.0
pod n/a
total 190 214 88.7


line stmt bran cond sub pod time code
1             package Pandoc::Metadata;
2 31     31   209 use strict;
  31         71  
  31         1081  
3 31     31   157 use warnings;
  31         59  
  31         861  
4 31     31   624 use 5.010001;
  31         115  
5              
6 31     31   170 use Pandoc::Elements;
  31         64  
  31         7466  
7 31     31   263 use Scalar::Util qw(blessed reftype);
  31         59  
  31         1558  
8 31     31   22583 use JSON::PP;
  31         437090  
  31         3498  
9 31     31   261 use Carp;
  31         64  
  31         2090  
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   187 no warnings 'once';
  31         69  
  31         12765  
21             *to_json = \&Pandoc::Document::Element::to_json;
22             }
23              
24             sub TO_JSON {
25 18     18   250 return { %{ $_[0] } }
  18         156  
26             }
27              
28             sub value {
29 110     110   256 my $map = { c => shift };
30 110         263 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   329 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   260 state $valid_pointer_re = qr{\A (?: [^/] .* | (?: / [^/]* )* ) \z}msx;
64 161         201 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         208 state $defaults = { map {; "_$_" => undef } @token_keys };
  18         53  
80 161         352 my %opts = @_;
81 161   0     304 $opts{_pointer} //= $opts{_full_pointer} //= $opts{pointer} //= "";
      0        
      33        
82 161   33     1061 $opts{_pointer} =~ $valid_pointer_re // _bad_pointer( %opts, _error => 'pointer' );
83 161         703 $opts{_pointer} =~ $token_re; # guaranteed to match since validation matched!
84 31     31   15157 my %match = %+;
  31         13121  
  31         39034  
  161         2095  
85 161 100       613 unless ( grep { defined $_ } @match{qw(_plain_key _empty)} ) {
  322         773  
86 95         210 $match{_key} =~ s!\~1!/!g;
87 95         176 $match{_key} =~ s!\~0!~!g;
88             }
89 161         1124 return (%opts, %$defaults, %match);
90             }
91              
92             sub _bad_pointer {
93 18     18   23 state $params_for = do {
94 2         31 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         11 for my $key ( keys %params_map ) {
108 12         17 for my $params ( $params_map{$key} ) {
109 12         15 $params = { %{ $params_map{default} }, %$params };
  12         42  
110 12 100       35 $params->{msg} .= ( $params->{in} ? q[ in] : "" );
111             $params->{keys}
112 12         15 = [ @{ $params->{_keys} }, $params->{pointer}, '_full_pointer' ];
  12         30  
113             }
114             }
115 2         6 \%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         64 my ( %opts ) = @_;
124 18 100       99 return undef unless $opts{strict};
125 5   50     13 $opts{_error} //= 'default';
126 5         12 my $params = $params_for->{ $opts{_error} };
127 5 100       15 if ( $opts{_error} eq 'container' ) {
128 1         7 %opts = _pointer_token( %opts );
129             }
130 5         15 my $msg = sprintf $params->{msg} . q[ (sub)pointer "%s" in pointer "%s"], @opts{ @{ $params->{keys} } };
  5         28  
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         62 croak $msg;
136             }
137              
138             # methods
139              
140             sub _value_args {
141 309     309   502 my $content = shift->{c};
142 309 100       1039 my ($pointer, %opts) = @_ % 2 ? @_ : (undef, @_);
143              
144 309   100     941 $opts{_pointer} = $pointer // $opts{_pointer} // $opts{pointer} // '';
      66        
      50        
145 309   100     768 $opts{_full_pointer} //= $opts{_pointer};
146              
147 309         1392 return ($content, %opts);
148             }
149              
150             sub Pandoc::Document::MetaString::value {
151 98     98   238 my ($content, %opts) = _value_args(@_);
152              
153 98 100       243 if ($opts{_pointer} ne '') {
154 1         9 _bad_pointer(%opts, _error => 'container');
155             } else {
156 97         561 $content;
157             }
158             }
159              
160             sub Pandoc::Document::MetaBool::set_content {
161 15 100 100 15   92 $_[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   38 c => $_[0]->{c} ? JSON::true() : JSON::false(),
168             };
169             }
170              
171             sub Pandoc::Document::MetaBool::value {
172 14     14   22 my ($content, %opts) = _value_args(@_);
173              
174 14 50 100     51 if ($opts{_pointer} ne '') {
    100          
175 0         0 _bad_pointer(%opts, _error => 'container');
176             } elsif (($opts{boolean} // '') eq 'JSON::PP') {
177 3 100       11 $content ? JSON::true() : JSON::false();
178             } else {
179 11 100       35 $content ? 1 : 0;
180             }
181             }
182              
183             sub Pandoc::Document::MetaMap::value {
184 119     119   251 my ($map, %opts) = _value_args(@_);
185 119         317 %opts = _pointer_token(%opts);
186              
187 119 100       440 if (defined $opts{_empty}) {
    100          
188 12         33 return { map { $_ => $map->{$_}->value(%opts) } keys %$map };
  56         208  
189             } elsif (exists($map->{$opts{_key}})) {
190 92         316 return $map->{$opts{_key}}->value(%opts);
191             } else {
192 15         45 _bad_pointer( %opts, _error => 'key');
193             }
194             }
195              
196             sub Pandoc::Document::MetaList::value {
197 41     41   75 my ($content, %opts) = _value_args(@_);
198 41         156 %opts = _pointer_token(%opts);
199 41 100       206 if ( defined $opts{_empty} ) {
    100          
200 12         22 return [ map { $_->value(%opts) } @$content ]
  23         71  
201             } elsif ($opts{_key} =~ /^[1-9][0-9]*$|^0$/) {
202 28 100       91 if ( $opts{_key} > $#$content ) {
203 1         6 return _bad_pointer( %opts, _error => 'range' );
204             }
205 27         48 my $value = $content->[$opts{_key}];
206 27 50       94 return defined($value) ? $value->value(%opts) : undef;
207             } else {
208 1         6 return _bad_pointer( %opts, _error => 'index' );
209             }
210             }
211              
212             sub Pandoc::Document::MetaInlines::value {
213 32     32   58 my ($content, %opts) = _value_args(@_);
214              
215 32 50 50     130 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         58 join '', map { $_->string } @$content;
  32         84  
221             }
222             }
223              
224             sub Pandoc::Document::MetaBlocks::string {
225 4     4   8 join "\n\n", map { $_->string } @{$_[0]->content};
  8         21  
  4         89  
226             }
227              
228             sub Pandoc::Document::MetaBlocks::value {
229 5     5   10 my ($content, %opts) = _value_args(@_);
230              
231 5 50 100     21 if ($opts{_pointer} ne '') {
    100          
232 0         0 _bad_pointer(%opts);
233             } elsif ($opts{element} // '' eq 'keep') {
234 2         13 $content;
235             } else {
236 3         6 $_[0]->string;
237             }
238             }
239              
240             1;
241             __END__