lib/Pandoc/Metadata.pm
package Pandoc::Metadata;
use strict;
use warnings;
use 5.010001;
use Pandoc::Elements;
use Scalar::Util qw(blessed reftype);
use JSON::PP;
use Carp;
# # For Pandoc::Metadata::Error
# use Carp qw(shortmess longmess);
# packages and methods
{
# key-value map of metadata fields
package Pandoc::Document::Metadata;
{
no warnings 'once';
*to_json = \&Pandoc::Document::Element::to_json;
}
sub TO_JSON {
return { %{ $_[0] } }
}
sub value {
my $map = { c => shift };
Pandoc::Document::MetaMap::value( $map, @_ )
}
}
{
# metadata element parent class
package Pandoc::Document::Meta;
our @ISA = ('Pandoc::Document::Element');
sub is_meta { 1 }
sub value { shift->value(@_) }
}
# # For Pandoc::Metadata::Error
# {
# package Pandoc::Metadata::Error;
# use overload q[""] => 'shortmess', q[%{}] => 'data', fallback => 1;
# use constant { SHORTMESS => 0, LONGMESS => 1, DATA => 2 };
# sub new {
# my($class, @values) = @_; # CLASS, (MESSAGE, {DATA})
# bless \@values => $class;
# }
# sub shortmess { shift->[SHORTMESS] }
# sub longmess { shift->[LONGMESS] }
# sub data { shift->[DATA] }
# sub rethrow { die shift }
# sub throw { shift->new( @_ )->rethrow }
# }
# helpers
my @token_keys = qw(last_pointer ref_token plain_key key empty pointer);
sub _pointer_token {
state $valid_pointer_re = qr{\A (?: [^/] .* | (?: / [^/]* )* ) \z}msx;
state $token_re = qr{
\A
(?<_last_pointer>
(?<_ref_token>
(?<_plain_key>
(?<_key> [^/] .* \z ) # plain "key"
)
| / (?<_key> [^/]* ) # "/key"
| (?<_empty> \z ) # "" -- return current element
)
(?<_pointer> / .* \z | )
)
\z
}msx;
# set non-participating keys to undef
state $defaults = { map {; "_$_" => undef } @token_keys };
my %opts = @_;
$opts{_pointer} //= $opts{_full_pointer} //= $opts{pointer} //= "";
$opts{_pointer} =~ $valid_pointer_re // _bad_pointer( %opts, _error => 'pointer' );
$opts{_pointer} =~ $token_re; # guaranteed to match since validation matched!
my %match = %+;
unless ( grep { defined $_ } @match{qw(_plain_key _empty)} ) {
$match{_key} =~ s!\~1!/!g;
$match{_key} =~ s!\~0!~!g;
}
return (%opts, %$defaults, %match);
}
sub _bad_pointer {
state $params_for = do {
my %params_map = (
default => {
msg => 'Invalid or unknown pointer reference "%s"',
in => 1,
_keys => ['_ref_token'],
pointer => '_last_pointer'
},
pointer => { msg => 'Invalid', in => 0, _keys => [], pointer => '_last_pointer', },
container => { msg => 'No list or mapping "%s"', },
key => { msg => 'Node "%s" doesn\'t correspond to any key', },
range => { msg => 'List index %s out of range', _keys => ['_key'], },
index => { msg => 'Node "%s" not a valid list index', },
);
for my $key ( keys %params_map ) {
for my $params ( $params_map{$key} ) {
$params = { %{ $params_map{default} }, %$params };
$params->{msg} .= ( $params->{in} ? q[ in] : "" );
$params->{keys}
= [ @{ $params->{_keys} }, $params->{pointer}, '_full_pointer' ];
}
}
\%params_map;
};
# # For Pandoc::Metadata::Error
# state $data_keys = {
# ( map { ; $_ => $_ } qw[element strict boolean] ),
# ( map { ; $_ => "_$_" } @token_keys, qw[error] ),
# ( pointer => '_full_pointer', next_pointer => '_pointer' ),
# };
my ( %opts ) = @_;
return undef unless $opts{strict};
$opts{_error} //= 'default';
my $params = $params_for->{ $opts{_error} };
if ( $opts{_error} eq 'container' ) {
%opts = _pointer_token( %opts );
}
my $msg = sprintf $params->{msg} . q[ (sub)pointer "%s" in pointer "%s"], @opts{ @{ $params->{keys} } };
# # For Pandoc::Metadata::Error
# my %data;
# @data{ keys %$data_keys } = @opts{ values %$data_keys };
# Pandoc::Metadata::Error->throw( shortmess($msg), longmess($msg), \%data );
croak $msg;
}
# methods
sub _value_args {
my $content = shift->{c};
my ($pointer, %opts) = @_ % 2 ? @_ : (undef, @_);
$opts{_pointer} = $pointer // $opts{_pointer} // $opts{pointer} // '';
$opts{_full_pointer} //= $opts{_pointer};
return ($content, %opts);
}
sub Pandoc::Document::MetaString::value {
my ($content, %opts) = _value_args(@_);
if ($opts{_pointer} ne '') {
_bad_pointer(%opts, _error => 'container');
} else {
$content;
}
}
sub Pandoc::Document::MetaBool::set_content {
$_[0]->{c} = $_[1] && $_[1] ne 'false' && $_[1] ne 'FALSE' ? 1 : 0;
}
sub Pandoc::Document::MetaBool::TO_JSON {
return {
t => 'MetaBool',
c => $_[0]->{c} ? JSON::true() : JSON::false(),
};
}
sub Pandoc::Document::MetaBool::value {
my ($content, %opts) = _value_args(@_);
if ($opts{_pointer} ne '') {
_bad_pointer(%opts, _error => 'container');
} elsif (($opts{boolean} // '') eq 'JSON::PP') {
$content ? JSON::true() : JSON::false();
} else {
$content ? 1 : 0;
}
}
sub Pandoc::Document::MetaMap::value {
my ($map, %opts) = _value_args(@_);
%opts = _pointer_token(%opts);
if (defined $opts{_empty}) {
return { map { $_ => $map->{$_}->value(%opts) } keys %$map };
} elsif (exists($map->{$opts{_key}})) {
return $map->{$opts{_key}}->value(%opts);
} else {
_bad_pointer( %opts, _error => 'key');
}
}
sub Pandoc::Document::MetaList::value {
my ($content, %opts) = _value_args(@_);
%opts = _pointer_token(%opts);
if ( defined $opts{_empty} ) {
return [ map { $_->value(%opts) } @$content ]
} elsif ($opts{_key} =~ /^[1-9][0-9]*$|^0$/) {
if ( $opts{_key} > $#$content ) {
return _bad_pointer( %opts, _error => 'range' );
}
my $value = $content->[$opts{_key}];
return defined($value) ? $value->value(%opts) : undef;
} else {
return _bad_pointer( %opts, _error => 'index' );
}
}
sub Pandoc::Document::MetaInlines::value {
my ($content, %opts) = _value_args(@_);
if ($opts{_pointer} ne '') {
_bad_pointer(%opts, _error => 'container');
} elsif ($opts{element} // '' eq 'keep') {
$content;
} else {
join '', map { $_->string } @$content;
}
}
sub Pandoc::Document::MetaBlocks::string {
join "\n\n", map { $_->string } @{$_[0]->content};
}
sub Pandoc::Document::MetaBlocks::value {
my ($content, %opts) = _value_args(@_);
if ($opts{_pointer} ne '') {
_bad_pointer(%opts);
} elsif ($opts{element} // '' eq 'keep') {
$content;
} else {
$_[0]->string;
}
}
1;
__END__
=head1 NAME
Pandoc::Metadata - pandoc document metadata
=head1 DESCRIPTION
Document metadata such as author, title, and date can be embedded in different
documents formats. Metadata can be provided in Pandoc markdown format with
L<metadata blocks|http://pandoc.org/MANUAL.html#metadata-blocks> at the top of
a markdown file or in YAML format like this:
---
title: a title
author:
- first author
- second author
published: true
...
Pandoc supports document metadata build of strings (L</MetaString>), boolean
values (L</MetaBool>), lists (L</MetaList>), key-value maps (L</MetaMap>),
lists of inline elements (L</MetaInlines>) and lists of block elements
(L</MetaBlocks>). Simple strings and boolean values can also be specified via
pandoc command line option C<-M> or C<--metadata>:
pandoc -M key=string
pandoc -M key=false
pandoc -M key=true
pandoc -M key
Perl module L<Pandoc::Elements> exports functions to construct metadata
elements in the internal document model and the general helper function
C<metadata>.
=head1 COMMON METHODS
All Metadata Elements support L<common element methods|Pandoc::Elements/COMMON
METHODS> (C<name>, C<to_json>, C<string>, ...) and return true for method
C<is_meta>.
=head2 value( [ $key | $pointer ] [ %options ] )
Called without an argument this method returns an unblessed deep copy of the
metadata element. Plain keys at the root level (unless they start with C</>)
and JSON Pointer expressions (L<RFC 6901|http://tools.ietf.org/html/rfc6901>)
can be used to select subfields. Note that JSON Pointer escapes slash as C<~1>
and character C<~> as C<~0>. URI Fragment syntax is not supported.
$doc->value; # full metadata
$doc->value(""); # full metadata, explicitly
$doc->value('/author'); # author field
$doc->value('author'); # author field, plain key
$doc->value('/author/name'); # name subfield of author field
$doc->value('/author/0'); # first author field
$doc->value('/author/0/name'); # name subfield of first author field
$doc->value('/~1~0'); # metadata field '/~'
$doc->value('/'); # field with empty string as key
Returns C<undef> if the selected field does not exist.
As a debugging aid you can set option C<strict> to a true value.
In this case the method will C<croak> if an invalid pointer,
invalid array index, non-existing key or non-existing array index
is encountered.
Instances of MetaInlines and MetaBlocks are stringified by unless option
C<element> is set to C<keep>.
Setting option C<boolean> to C<JSON::PP> will return C<JSON::PP:true>
or C<JSON::PP::false> for L<MetaBool|/MetaBool> instances.
=head1 METADATA ELEMENTS
=head2 MetaString
A plain text string metadata value.
MetaString $string
metadata "$string"
=head2 MetaBool
A Boolean metadata value. The special values C<"false"> and
C<"FALSE"> are recognized as false in addition to normal false values (C<0>,
C<undef>, C<"">, ...).
MetaBool $value
metadata JSON::true()
metadata JSON::false()
=head2 MetaList
A list of other metadata elements.
MetaList [ @values ]
metadata [ @values ]
=head2 MetaMap
A map of keys to other metadata elements.
MetaMap { %map }
metadata { %map }
=head2 MetaInlines
Container for a list of L<inlines|Pandoc::Elements/INLINE ELEMENTS> in
metadata.
MetaInlines [ @inlines ]
=head2 MetaBlocks
Container for a list of L<blocks|Pandoc::Elements/BLOCK ELEMENTS> in metadata.
MetaBlocks [ @blocks ]
The C<string> method concatenates all stringified content blocks separated by
empty lines.
=cut