view release on metacpan or  search on metacpan

lib/Pandoc/Metadata.pm  view on Meta::CPAN

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 };