App-Dex
view release on metacpan or search on metacpan
scripts/dex view on Meta::CPAN
=head1 NAME
YAML::PP - YAML 1.2 processor
=head1 SYNOPSIS
WARNING: Most of the inner API is not stable yet.
Here are a few examples of the basic load and dump methods:
use YAML::PP;
my $ypp = YAML::PP->new;
my $yaml = <<'EOM';
--- # Document one is a mapping
name: Tina
age: 29
favourite language: Perl
--- # Document two is a sequence
- plain string
- 'in single quotes'
- "in double quotes we have escapes! like \t and \n"
- | # a literal block scalar
line1
line2
- > # a folded block scalar
this is all one
single line because the
linebreaks will be folded
EOM
my @documents = $ypp->load_string($yaml);
my @documents = $ypp->load_file($filename);
my $yaml = $ypp->dump_string($data1, $data2);
$ypp->dump_file($filename, $data1, $data2);
# The loader offers JSON::PP::Boolean, boolean.pm or
# perl 1/'' (currently default) for booleans
my $ypp = YAML::PP->new(boolean => 'JSON::PP');
my $ypp = YAML::PP->new(boolean => 'boolean');
my $ypp = YAML::PP->new(boolean => 'perl');
# Enable perl data types and objects
my $ypp = YAML::PP->new(schema => [qw/ + Perl /]);
my $yaml = $yp->dump_string($data_with_perl_objects);
# Legacy interface
use YAML::PP qw/ Load Dump LoadFile DumpFile /;
my @documents = Load($yaml);
my @documents = LoadFile($filename);
my @documents = LoadFile($filehandle);
my $yaml = = Dump(@documents);
DumpFile($filename, @documents);
DumpFile($filenhandle @documents);
Some utility scripts, mostly useful for debugging:
# Load YAML into a data structure and dump with Data::Dumper
yamlpp-load < file.yaml
# Load and Dump
yamlpp-load-dump < file.yaml
# Print the events from the parser in yaml-test-suite format
yamlpp-events < file.yaml
# Parse and emit events directly without loading
yamlpp-parse-emit < file.yaml
# Create ANSI colored YAML. Can also be useful for invalid YAML, showing
# you the exact location of the error
yamlpp-highlight < file.yaml
=head1 DESCRIPTION
YAML::PP is a modular YAML processor.
It aims to support C<YAML 1.2> and C<YAML 1.1>. See L<https://yaml.org/>.
Some (rare) syntax elements are not yet supported and documented below.
YAML is a serialization language. The YAML input is called "YAML Stream".
A stream consists of one or more "Documents", separated by a line with a
document start marker C<--->. A document optionally ends with the document
end marker C<...>.
This allows one to process continuous streams additionally to a fixed input
file or string.
The YAML::PP frontend will currently load all documents, and return only
the first if called with scalar context.
The YAML backend is implemented in a modular way that allows one to add
custom handling of YAML tags, perl objects and data types. The inner API
is not yet stable. Suggestions welcome.
You can check out all current parse and load results from the
yaml-test-suite here:
L<https://perlpunk.github.io/YAML-PP-p5/test-suite.html>
=head1 METHODS
=head2 new
my $ypp = YAML::PP->new;
# load booleans via boolean.pm
my $ypp = YAML::PP->new( boolean => 'boolean' );
# load booleans via JSON::PP::true/false
my $ypp = YAML::PP->new( boolean => 'JSON::PP' );
# use YAML 1.2 Failsafe Schema
my $ypp = YAML::PP->new( schema => ['Failsafe'] );
# use YAML 1.2 JSON Schema
my $ypp = YAML::PP->new( schema => ['JSON'] );
# use YAML 1.2 Core Schema
my $ypp = YAML::PP->new( schema => ['Core'] );
scripts/dex view on Meta::CPAN
=item Line and Column Numbers
You will see line and column numbers in the error message. The column numbers
might still be wrong in some cases.
=item Error Messages
The error messages need to be improved.
=item Unicode Surrogate Pairs
Currently loaded as single characters without validating
=item Possibly more
=back
=head2 YAML::PP::Constructor
The Constructor now supports all three YAML 1.2 Schemas, Failsafe, JSON and
Core. Additionally you can choose the schema for YAML 1.1 as C<YAML1_1>.
Too see what strings are resolved as booleans, numbers, null etc. look at
L<https://perlpunk.github.io/YAML-PP-p5/schema-examples.html>.
You can choose the Schema like this:
my $ypp = YAML::PP->new(schema => ['JSON']); # default is 'Core'
The Tags C<!!seq> and C<!!map> are still ignored for now.
It supports:
=over 4
=item Handling of Anchors/Aliases
Like in modules like L<YAML>, the Constructor will use references for mappings and
sequences, but obviously not for scalars.
L<YAML::XS> uses real aliases, which allows also aliasing scalars. I might add
an option for that since aliasing is now available in pure perl.
=item Boolean Handling
You can choose between C<'perl'> (1/'', currently default), C<'JSON::PP'> and
C<'boolean'>.pm for handling boolean types. That allows you to dump the data
structure with one of the JSON modules without losing information about
booleans.
=item Numbers
Numbers are created as real numbers instead of strings, so that they are
dumped correctly by modules like L<JSON::PP> or L<JSON::XS>, for example.
=item Complex Keys
Mapping Keys in YAML can be more than just scalars. Of course, you can't load
that into a native perl structure. The Constructor will stringify those keys
with L<Data::Dumper> instead of just returning something like
C<HASH(0x55dc1b5d0178)>.
Example:
use YAML::PP;
use JSON::PP;
my $ypp = YAML::PP->new;
my $coder = JSON::PP->new->ascii->pretty->allow_nonref->canonical;
my $yaml = <<'EOM';
complex:
?
?
a: 1
c: 2
: 23
: 42
EOM
my $data = $yppl->load_string($yaml);
say $coder->encode($data);
__END__
{
"complex" : {
"{'{a => 1,c => 2}' => 23}" : 42
}
}
=back
TODO:
=over 4
=item Parse Tree
I would like to generate a complete parse tree, that allows you to manipulate
the data structure and also dump it, including all whitespaces and comments.
The spec says that this is throwaway content, but I read that many people
wish to be able to keep the comments.
=back
=head2 YAML::PP::Dumper, YAML::PP::Emitter
The Dumper should be able to dump strings correctly, adding quotes
whenever a plain scalar would look like a special string, like C<true>,
or when it contains or starts with characters that are not allowed.
Most strings will be dumped as plain scalars without quotes. If they
contain special characters or have a special meaning, they will be dumped
with single quotes. If they contain control characters, including <"\n">,
they will be dumped with double quotes.
It will recognize JSON::PP::Boolean and boolean.pm objects and dump them
correctly.
Numbers which also have a C<PV> flag will be recognized as numbers and not
as strings:
my $int = 23;
say "int: $int"; # $int will now also have a PV flag
scripts/dex view on Meta::CPAN
if (($preserve_style or $preserve_alias) and not ref $value) {
my %args = (
value => $value,
tag => $event->{tag},
);
if ($preserve_style) {
$args{style} = $event->{style};
}
if ($preserve_alias and defined $event->{anchor}) {
my $anchor = $event->{anchor};
unless (exists $self->anchors->{ $anchor }) {
# Repeated anchors cannot be preserved
$args{alias} = $event->{anchor};
}
}
$value = YAML::PP::Preserve::Scalar->new( %args );
}
if (defined (my $name = $event->{anchor})) {
$self->anchors->{ $name } = { data => \$value, finished => 1 };
}
push @{ $last->{ref} }, $value;
}
sub alias_event {
my ($self, $event) = @_;
my $value;
my $name = $event->{value};
if (my $anchor = $self->anchors->{ $name }) {
# We know this is a cyclic ref since the node hasn't
# been constructed completely yet
unless ($anchor->{finished} ) {
my $cyclic_refs = $self->cyclic_refs;
if ($cyclic_refs ne 'allow') {
if ($cyclic_refs eq 'fatal') {
die "Found cyclic ref for alias '$name'";
}
if ($cyclic_refs eq 'warn') {
$anchor = { data => \undef };
warn "Found cyclic ref for alias '$name'";
}
elsif ($cyclic_refs eq 'ignore') {
$anchor = { data => \undef };
}
}
}
$value = $anchor->{data};
}
else {
croak "No anchor defined for alias '$name'";
}
my $last = $self->stack->[-1];
push @{ $last->{ref} }, $$value;
}
sub stringify_complex {
my ($self, $data) = @_;
return $data if (
ref $data eq 'YAML::PP::Preserve::Scalar'
and ($self->preserve_scalar_style or $self->preserve_alias)
);
require Data::Dumper;
local $Data::Dumper::Quotekeys = 0;
local $Data::Dumper::Terse = 1;
local $Data::Dumper::Indent = 0;
local $Data::Dumper::Useqq = 0;
local $Data::Dumper::Sortkeys = 1;
my $string = Data::Dumper->Dump([$data], ['data']);
$string =~ s/^\$data = //;
return $string;
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Constructor - Constructing data structure from parsing events
=head1 METHODS
=over
=item new
The Constructor constructor
my $constructor = YAML::PP::Constructor->new(
schema => $schema,
cyclic_refs => $cyclic_refs,
);
=item init
Resets any data being used during construction.
$constructor->init;
=item document_start_event, document_end_event, mapping_start_event, mapping_end_event, sequence_start_event, sequence_end_event, scalar_event, alias_event, stream_start_event, stream_end_event
These methods are called from L<YAML::PP::Parser>:
$constructor->document_start_event($event);
=item anchors, set_anchors
Helper for storing anchors during construction
=item docs, set_docs
Helper for storing resulting documents during construction
=item stack, set_stack
Helper for storing data during construction
=item cyclic_refs, set_cyclic_refs
Option for controlling the behaviour when finding circular references
=item schema, set_schema
Holds a L<YAML::PP::Schema> object
=item stringify_complex
When constructing a hash and getting a non-scalar key, this method is
used to stringify the key.
It uses a terse Data::Dumper output. Other modules, like L<YAML::XS>, use
the default stringification, C<ARRAY(0x55617c0c7398)> for example.
=back
=cut
YAML_PP_CONSTRUCTOR
$fatpacked{"YAML/PP/Dumper.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_DUMPER';
use strict;
use warnings;
package YAML::PP::Dumper;
our $VERSION = '0.027'; # VERSION
use Scalar::Util qw/ blessed refaddr reftype /;
use YAML::PP;
use YAML::PP::Emitter;
use YAML::PP::Representer;
use YAML::PP::Writer;
use YAML::PP::Writer::File;
use YAML::PP::Common qw/
YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE
YAML_DOUBLE_QUOTED_SCALAR_STYLE
YAML_ANY_SCALAR_STYLE
YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE
YAML_FLOW_SEQUENCE_STYLE YAML_FLOW_MAPPING_STYLE
YAML_BLOCK_MAPPING_STYLE YAML_BLOCK_SEQUENCE_STYLE
/;
sub new {
my ($class, %args) = @_;
my $header = delete $args{header};
$header = 1 unless defined $header;
my $footer = delete $args{footer};
$footer = 0 unless defined $footer;
my $version_directive = delete $args{version_directive};
my $preserve = delete $args{preserve};
my $schema = delete $args{schema} || YAML::PP->default_schema(
boolean => 'perl',
);
my $emitter = delete $args{emitter} || YAML::PP::Emitter->new;
unless (blessed($emitter)) {
$emitter = YAML::PP::Emitter->new(
%$emitter
);
}
if (keys %args) {
die "Unexpected arguments: " . join ', ', sort keys %args;
}
my $self = bless {
representer => YAML::PP::Representer->new(
schema => $schema,
preserve => $preserve,
),
version_directive => $version_directive,
emitter => $emitter,
scripts/dex view on Meta::CPAN
sub dump_file {
my ($self, $file, @docs) = @_;
my $writer = YAML::PP::Writer::File->new(output => $file);
$self->emitter->set_writer($writer);
my $output = $self->dump(@docs);
return $output;
}
my %_reftypes = (
HASH => 1,
ARRAY => 1,
Regexp => 1,
REGEXP => 1,
CODE => 1,
SCALAR => 1,
REF => 1,
GLOB => 1,
);
sub check_references {
my ($self, $doc) = @_;
my $reftype = reftype $doc or return;
my $seen = $self->{seen};
# check which references are used more than once
if ($reftype eq 'SCALAR' and ref $doc eq $self->representer->schema->bool_class) {
# JSON::PP and boolean.pm always return the same reference for booleans
# Avoid printing *aliases in those case
if (ref $doc eq 'boolean' or ref $doc eq 'JSON::PP::Boolean') {
return;
}
}
if (++$seen->{ refaddr $doc } > 1) {
# seen already
return;
}
unless ($_reftypes{ $reftype }) {
die sprintf "Reference %s not implemented",
$reftype;
}
if ($reftype eq 'HASH') {
$self->check_references($doc->{ $_ }) for keys %$doc;
}
elsif ($reftype eq 'ARRAY') {
$self->check_references($_) for @$doc;
}
elsif ($reftype eq 'REF') {
$self->check_references($$doc);
}
}
1;
YAML_PP_DUMPER
$fatpacked{"YAML/PP/Emitter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_EMITTER';
use strict;
use warnings;
package YAML::PP::Emitter;
our $VERSION = '0.027'; # VERSION
use Data::Dumper;
use YAML::PP::Common qw/
YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE
YAML_DOUBLE_QUOTED_SCALAR_STYLE
YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE
YAML_FLOW_SEQUENCE_STYLE YAML_FLOW_MAPPING_STYLE
/;
use constant DEBUG => $ENV{YAML_PP_EMIT_DEBUG} ? 1 : 0;
use constant DEFAULT_WIDTH => 80;
sub new {
my ($class, %args) = @_;
my $self = bless {
indent => $args{indent} || 2,
writer => $args{writer},
width => $args{width} || DEFAULT_WIDTH,
}, $class;
$self->init;
return $self;
}
sub clone {
my ($self) = @_;
my $clone = {
indent => $self->indent,
};
return bless $clone, ref $self;
}
sub event_stack { return $_[0]->{event_stack} }
sub set_event_stack { $_[0]->{event_stack} = $_[1] }
sub indent { return $_[0]->{indent} }
sub width { return $_[0]->{width} }
sub line { return $_[0]->{line} }
sub column { return $_[0]->{column} }
sub set_indent { $_[0]->{indent} = $_[1] }
sub writer { $_[0]->{writer} }
sub set_writer { $_[0]->{writer} = $_[1] }
sub tagmap { return $_[0]->{tagmap} }
sub set_tagmap { $_[0]->{tagmap} = $_[1] }
sub init {
my ($self) = @_;
unless ($self->writer) {
$self->set_writer(YAML::PP::Writer->new);
}
$self->set_tagmap({
'tag:yaml.org,2002:' => '!!',
});
$self->{open_ended} = 0;
$self->{line} = 0;
$self->{column} = 0;
$self->writer->init;
}
sub mapping_start_event {
DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ mapping_start_event\n";
my ($self, $info) = @_;
my $stack = $self->event_stack;
scripts/dex view on Meta::CPAN
"\x8c" => '\x8c',
"\x8d" => '\x8d',
"\x8e" => '\x8e',
"\x8f" => '\x8f',
"\x90" => '\x90',
"\x91" => '\x91',
"\x92" => '\x92',
"\x93" => '\x93',
"\x94" => '\x94',
"\x95" => '\x95',
"\x96" => '\x96',
"\x97" => '\x97',
"\x98" => '\x98',
"\x99" => '\x99',
"\x9a" => '\x9a',
"\x9b" => '\x9b',
"\x9c" => '\x9c',
"\x9d" => '\x9d',
"\x9e" => '\x9e',
"\x9f" => '\x9f',
"\x{2029}" => '\P',
"\x{2028}" => '\L',
"\x85" => '\N',
"\xa0" => '\_',
);
my $control_re = '\x00-\x08\x0b\x0c\x0e-\x1f\x7f-\x84\x86-\x9f\x{d800}-\x{dfff}\x{fffe}\x{ffff}\x{2028}\x{2029}\x85\xa0';
my %to_escape = (
"\n" => '\n',
"\t" => '\t',
"\r" => '\r',
'\\' => '\\\\',
'"' => '\\"',
%control,
);
my $escape_re = $control_re . '\n\t\r';
my $escape_re_without_lb = $control_re . '\t\r';
sub scalar_event {
DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ scalar_event\n";
my ($self, $info) = @_;
my $stack = $self->event_stack;
my $last = $stack->[-1];
my $indent = $last->{indent};
my $value = $info->{value};
my $flow = $last->{flow};
my $props = '';
my $anchor = $info->{anchor};
my $tag = $info->{tag};
if (defined $anchor) {
$anchor = "&$anchor";
}
if (defined $tag) {
$tag = $self->emit_tag('scalar', $tag);
}
$props = join ' ', grep defined, ($anchor, $tag);
my $style = $info->{style};
DEBUG and local $Data::Dumper::Useqq = 1;
$value = '' unless defined $value;
my $first = substr($value, 0, 1);
if ($value eq '') {
if ($flow and $last->{type} ne 'MAPVALUE' and $last->{type} ne 'MAP') {
$style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
}
elsif (not $style) {
$style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
}
}
# no control characters anywhere
elsif ($value =~ m/[$control_re]/) {
$style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
}
$style ||= YAML_PLAIN_SCALAR_STYLE;
if ($style == YAML_SINGLE_QUOTED_SCALAR_STYLE) {
if ($value =~ m/ \n/ or $value =~ m/\n / or $value =~ m/^\n/ or $value =~ m/\n$/) {
$style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
}
elsif ($value eq "\n") {
$style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
}
}
elsif ($style == YAML_LITERAL_SCALAR_STYLE or $style == YAML_FOLDED_SCALAR_STYLE) {
if ($value eq '') {
$style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
}
elsif ($flow) {
# no block scalars in flow
if ($value =~ tr/\n//) {
$style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
}
else {
$style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
}
}
}
elsif ($style == YAML_PLAIN_SCALAR_STYLE) {
if (not length $value) {
}
elsif ($value =~ m/[$escape_re_without_lb]/) {
$style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
}
elsif ($value eq "\n") {
$style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
}
elsif ($value !~ tr/ //c) {
$style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
}
elsif ($value !~ tr/ \n//c) {
$style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
}
elsif ($value =~ tr/\n//) {
$style = $flow ? YAML_DOUBLE_QUOTED_SCALAR_STYLE : YAML_LITERAL_SCALAR_STYLE;
}
elsif ($forbidden_first{ $first }) {
$style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
}
elsif ($flow and $value =~ tr/,[]{}//) {
$style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
}
elsif (substr($value, 0, 3) =~ m/^(?:---|\.\.\.)/) {
$style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
}
elsif ($value =~ m/: /) {
$style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
}
elsif ($value =~ m/ #/) {
$style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
}
elsif ($value =~ m/[: \t]\z/) {
$style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
}
elsif ($value =~ m/[^\x20-\x3A\x3B-\x7E\x85\xA0-\x{D7FF}\x{E000}-\x{FEFE}\x{FF00}-\x{FFFD}\x{10000}-\x{10FFFF}]/) {
$style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
}
elsif ($forbidden_first_plus_space{ $first }) {
if (length ($value) == 1 or substr($value, 1, 1) =~ m/^\s/) {
$style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
}
}
}
if ($style == YAML_SINGLE_QUOTED_SCALAR_STYLE and not $info->{style}) {
if ($value =~ tr/'// and $value !~ tr/"//) {
$style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
}
}
my $open_ended = 0;
if ($style == YAML_PLAIN_SCALAR_STYLE) {
$value =~ s/\n/\n\n/g;
}
elsif ($style == YAML_SINGLE_QUOTED_SCALAR_STYLE) {
my $new_indent = $last->{indent} . (' ' x $self->indent);
$value =~ s/(\n+)/"\n" x (1 + (length $1))/eg;
my @lines = split m/\n/, $value, -1;
if (@lines > 1) {
for my $line (@lines[1 .. $#lines]) {
$line = $new_indent . $line
if length $line;
}
}
$value = join "\n", @lines;
$value =~ s/'/''/g;
$value = "'" . $value . "'";
}
elsif ($style == YAML_LITERAL_SCALAR_STYLE) {
DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$value], ['value']);
my $indicators = '';
if ($value =~ m/\A\n* +/) {
$indicators .= $self->indent;
}
my $indent = $indent . ' ' x $self->indent;
if ($value !~ m/\n\z/) {
$indicators .= '-';
$value .= "\n";
}
elsif ($value =~ m/(\n|\A)\n\z/) {
$indicators .= '+';
$open_ended = 1;
}
$value =~ s/^(?=.)/$indent/gm;
$value = "|$indicators\n$value";
}
elsif ($style == YAML_FOLDED_SCALAR_STYLE) {
DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$value], ['value']);
my @lines = split /\n/, $value, -1;
DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\@lines], ['lines']);
my $eol = 0;
my $indicators = '';
if ($value =~ m/\A\n* +/) {
$indicators .= $self->indent;
}
my $indent = $indent . ' ' x $self->indent;
if ($lines[-1] eq '') {
pop @lines;
$eol = 1;
}
else {
$indicators .= '-';
}
$value = ">$indicators\n";
for my $i (0 .. $#lines) {
my $line = $lines[ $i ];
if (length $line) {
$value .= "$indent$line\n";
}
if ($i != $#lines) {
$value .= "\n";
}
}
}
else {
$value =~ s/([$escape_re"\\])/$to_escape{ $1 } || sprintf '\\u%04x', ord($1)/eg;
$value = '"' . $value . '"';
}
DEBUG and warn __PACKAGE__.':'.__LINE__.": (@$stack)\n";
my $yaml = '';
my $pvalue = $props;
if ($props and length $value) {
$pvalue .= " $value";
}
elsif (length $value) {
$pvalue .= $value;
}
my $multiline = ($style == YAML_LITERAL_SCALAR_STYLE or $style == YAML_FOLDED_SCALAR_STYLE);
my $newline = 0;
if ($flow) {
$indent = 0;
if ($props and not length $value) {
$pvalue .= ' ';
}
if ($last->{type} eq 'SEQ') {
if ($last->{index} == 0) {
if ($self->column) {
$yaml .= ' ';
}
$yaml .= "[";
}
else {
$yaml .= ", ";
}
}
elsif ($last->{type} eq 'MAP') {
if ($last->{index} == 0) {
if ($self->column) {
$yaml .= ' ';
scripts/dex view on Meta::CPAN
TODO: Currently sequences are always zero-indented.
=item writer, set_writer
Getter/setter for the writer object. By default L<YAML::PP::Writer>.
You can pass your own writer if you want to output the resulting YAML yourself.
=item init
Initialize
=item finish
=back
=cut
YAML_PP_EMITTER
$fatpacked{"YAML/PP/Exception.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_EXCEPTION';
use strict;
use warnings;
package YAML::PP::Exception;
our $VERSION = '0.027'; # VERSION
use overload '""' => \&to_string;
sub new {
my ($class, %args) = @_;
my $self = bless {
line => $args{line},
msg => $args{msg},
next => $args{next},
where => $args{where},
yaml => $args{yaml},
got => $args{got},
expected => $args{expected},
column => $args{column},
}, $class;
return $self;
}
sub to_string {
my ($self) = @_;
my $next = $self->{next};
my $line = $self->{line};
my $column = $self->{column};
my $yaml = '';
for my $token (@$next) {
last if $token->{name} eq 'EOL';
$yaml .= $token->{value};
}
$column = '???' unless defined $column;
my $remaining_yaml = $self->{yaml};
$remaining_yaml = '' unless defined $remaining_yaml;
$yaml .= $remaining_yaml;
{
local $@; # avoid bug in old Data::Dumper
require Data::Dumper;
local $Data::Dumper::Useqq = 1;
local $Data::Dumper::Terse = 1;
$yaml = Data::Dumper->Dump([$yaml], ['yaml']);
chomp $yaml;
}
my $lines = 5;
my @fields;
if ($self->{got} and $self->{expected}) {
$lines = 6;
$line = $self->{got}->{line};
$column = $self->{got}->{column} + 1;
@fields = (
"Line" => $line,
"Column" => $column,
"Expected", join(" ", @{ $self->{expected} }),
"Got", $self->{got}->{name},
"Where", $self->{where},
"YAML", $yaml,
);
}
else {
@fields = (
"Line" => $line,
"Column" => $column,
"Message", $self->{msg},
"Where", $self->{where},
"YAML", $yaml,
);
}
my $fmt = join "\n", ("%-10s: %s") x $lines;
my $string = sprintf $fmt, @fields;
return $string;
}
1;
YAML_PP_EXCEPTION
$fatpacked{"YAML/PP/Grammar.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_GRAMMAR';
use strict;
use warnings;
package YAML::PP::Grammar;
our $VERSION = '0.027'; # VERSION
use base 'Exporter';
our @EXPORT_OK = qw/ $GRAMMAR /;
our $GRAMMAR = {};
# START OF GRAMMAR INLINE
# DO NOT CHANGE THIS
# This grammar is automatically generated from etc/grammar.yaml
$GRAMMAR = {
'DIRECTIVE' => {
'DOC_START' => {
'EOL' => {
'new' => 'FULLNODE'
},
scripts/dex view on Meta::CPAN
else {
if ($space < $indent) {
$self->remove_nodes($space);
}
}
my $exp = $self->events->[-1];
if ($exp eq 'SEQ0' and $next->{name} ne 'DASH') {
TRACE and $self->info("In unindented sequence");
$self->end_sequence;
$exp = $self->events->[-1];
}
if ($self->offset->[-1] != $space) {
$self->exception("Expected " . $self->events->[-1]);
}
return 1;
}
my %next_event = (
MAP => 'MAPVALUE',
MAPVALUE => 'MAP',
SEQ => 'SEQ',
SEQ0 => 'SEQ0',
DOC => 'DOC_END',
STR => 'STR',
FLOWSEQ => 'FLOWSEQ_NEXT',
FLOWSEQ_NEXT => 'FLOWSEQ',
FLOWMAP => 'FLOWMAPVALUE',
FLOWMAPVALUE => 'FLOWMAP',
);
my %event_to_method = (
MAP => 'mapping',
FLOWMAP => 'mapping',
SEQ => 'sequence',
SEQ0 => 'sequence',
FLOWSEQ => 'sequence',
DOC => 'document',
STR => 'stream',
VAL => 'scalar',
ALI => 'alias',
MAPVALUE => 'mapping',
);
#sub process_events {
# my ($self, $res) = @_;
#
# my $event_stack = $self->event_stack;
# return unless @$event_stack;
#
# if (@$event_stack == 1 and $event_stack->[0]->[0] eq 'properties') {
# return;
# }
#
# my $event_types = $self->events;
# my $properties;
# my @send_events;
# for my $event (@$event_stack) {
# TRACE and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$event], ['event']);
# my ($type, $info) = @$event;
# if ($type eq 'properties') {
# $properties = $info;
# }
# elsif ($type eq 'scalar') {
# $info->{name} = 'scalar_event';
# $event_types->[-1] = $next_event{ $event_types->[-1] };
# push @send_events, $info;
# }
# elsif ($type eq 'begin') {
# my $name = $info->{name};
# $info->{name} = $event_to_method{ $name } . '_start_event';
# push @{ $event_types }, $name;
# push @{ $self->offset }, $info->{offset};
# push @send_events, $info;
# }
# elsif ($type eq 'end') {
# my $name = $info->{name};
# $info->{name} = $event_to_method{ $name } . '_end_event';
# $self->$type($name, $info);
# push @send_events, $info;
# if (@$event_types) {
# $event_types->[-1] = $next_event{ $event_types->[-1] };
# }
# }
# elsif ($type eq 'alias') {
# if ($properties) {
# $self->exception("Parse error: Alias not allowed in this context");
# }
# $info->{name} = 'alias_event';
# $event_types->[-1] = $next_event{ $event_types->[-1] };
# push @send_events, $info;
# }
# }
# @$event_stack = ();
# for my $info (@send_events) {
# DEBUG and $self->debug_event( $info );
# $self->callback->($self, $info->{name}, $info);
# }
#}
my %fetch_method = (
'"' => 'fetch_quoted',
"'" => 'fetch_quoted',
'|' => 'fetch_block',
'>' => 'fetch_block',
'' => 'fetch_plain',
);
sub parse_tokens {
my ($self) = @_;
my $event_types = $self->events;
my $offsets = $self->offset;
my $tokens = $self->tokens;
my $next_tokens = $self->lexer->next_tokens;
unless ($self->lex_next_tokens) {
$self->end_document(1);
return 0;
}
unless ($self->new_node) {
if ($self->level > 0) {
my $new_rule = $nodetypes{ $event_types->[-1] }
or die "Did not find '$event_types->[-1]'";
$self->set_rule( $new_rule );
}
}
my $rule_name = $self->rule;
DEBUG and $self->info("----------------> parse_tokens($rule_name)");
my $rule = $GRAMMAR->{ $rule_name }
or die "Could not find rule $rule_name";
TRACE and $self->debug_rules($rule);
TRACE and $self->debug_yaml;
DEBUG and $self->debug_next_line;
RULE: while ($rule_name) {
DEBUG and $self->info("RULE: $rule_name");
TRACE and $self->debug_tokens($next_tokens);
unless (@$next_tokens) {
$self->exception("No more tokens");
}
TRACE and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$next_tokens->[0]], ['next_token']);
my $got = $next_tokens->[0]->{name};
if ($got eq 'CONTEXT') {
my $context = shift @$next_tokens;
my $indent = $offsets->[-1];
$indent++ unless $self->lexer->flowcontext;
my $method = $fetch_method{ $context->{value} };
my $partial = $self->lexer->$method($indent, $context->{value});
next RULE;
}
my $def = $rule->{ $got };
if ($def) {
push @$tokens, shift @$next_tokens;
}
elsif ($def = $rule->{DEFAULT}) {
$got = 'DEFAULT';
}
else {
$self->expected(
expected => [keys %$rule],
got => $next_tokens->[0],
);
}
DEBUG and $self->got("---got $got");
if (my $sub = $def->{match}) {
DEBUG and $self->info("CALLBACK $sub");
$self->$sub(@$tokens ? $tokens->[-1] : ());
}
my $eol = $got eq 'EOL';
my $new = $def->{new};
if ($new) {
DEBUG and $self->got("NEW: $new");
$rule_name = $new;
$self->set_rule($rule_name);
}
elsif ($eol) {
}
elsif ($def->{return}) {
$rule_name = $nodetypes{ $event_types->[-1] }
or die "Unexpected event type $event_types->[-1]";
$self->set_rule($rule_name);
}
else {
$rule_name .= " - $got"; # for debugging
$rule = $def;
next RULE;
}
if ($eol) {
unless ($self->lex_next_tokens) {
$self->end_document(1);
return 0;
}
unless ($self->new_node) {
if ($self->level > 0) {
$rule_name = $nodetypes{ $event_types->[-1] }
or die "Did not find '$event_types->[-1]'";
$self->set_rule( $rule_name );
}
}
$rule_name = $self->rule;
scripts/dex view on Meta::CPAN
sub debug_offset {
my ($self) = @_;
$self->note(
qq{OFFSET: (}
. join (' | ', map { defined $_ ? sprintf "%-3d", $_ : '?' } @{ $_[0]->offset })
. qq/) level=@{[ $_[0]->level ]}]}/
);
}
sub debug_yaml {
my ($self) = @_;
my $line = $self->lexer->line;
$self->note("LINE NUMBER: $line");
my $next_tokens = $self->lexer->next_tokens;
if (@$next_tokens) {
$self->debug_tokens($next_tokens);
}
}
sub debug_next_line {
my ($self) = @_;
my $next_line = $self->lexer->next_line || [];
my $line = $next_line->[0];
$line = '' unless defined $line;
$line =~ s/( +)$/'·' x length $1/e;
$line =~ s/\t/â–¸/g;
$self->note("NEXT LINE: >>$line<<");
}
sub note {
my ($self, $msg) = @_;
$self->_colorize_warn(["yellow"], "============ $msg");
}
sub info {
my ($self, $msg) = @_;
$self->_colorize_warn(["cyan"], "============ $msg");
}
sub got {
my ($self, $msg) = @_;
$self->_colorize_warn(["green"], "============ $msg");
}
sub _colorize_warn {
my ($self, $colors, $text) = @_;
require Term::ANSIColor;
warn Term::ANSIColor::colored($colors, $text), "\n";
}
sub debug_event {
my ($self, $event) = @_;
my $str = YAML::PP::Common::event_to_test_suite($event);
require Term::ANSIColor;
warn Term::ANSIColor::colored(["magenta"], "============ $str"), "\n";
}
sub debug_rules {
my ($self, $rules) = @_;
local $Data::Dumper::Maxdepth = 2;
$self->note("RULES:");
for my $rule ($rules) {
if (ref $rule eq 'ARRAY') {
my $first = $rule->[0];
if (ref $first eq 'SCALAR') {
$self->info("-> $$first");
}
else {
if (ref $first eq 'ARRAY') {
$first = $first->[0];
}
$self->info("TYPE $first");
}
}
else {
eval {
my @keys = sort keys %$rule;
$self->info("@keys");
};
}
}
}
sub debug_tokens {
my ($self, $tokens) = @_;
$tokens ||= $self->tokens;
require Term::ANSIColor;
for my $token (@$tokens) {
my $type = Term::ANSIColor::colored(["green"],
sprintf "%-22s L %2d C %2d ",
$token->{name}, $token->{line}, $token->{column} + 1
);
local $Data::Dumper::Useqq = 1;
local $Data::Dumper::Terse = 1;
require Data::Dumper;
my $str = Data::Dumper->Dump([$token->{value}], ['str']);
chomp $str;
$str =~ s/(^.|.$)/Term::ANSIColor::colored(['blue'], $1)/ge;
warn "$type$str\n";
}
}
sub highlight_yaml {
my ($self) = @_;
require YAML::PP::Highlight;
my $tokens = $self->tokens;
my $highlighted = YAML::PP::Highlight->ansicolored($tokens);
warn $highlighted;
}
sub exception {
my ($self, $msg, %args) = @_;
my $next = $self->lexer->next_tokens;
my $line = @$next ? $next->[0]->{line} : $self->lexer->line;
my $offset = @$next ? $next->[0]->{column} : $self->lexer->offset;
$offset++;
my $next_line = $self->lexer->next_line;
my $remaining = '';
if ($next_line) {
if ($self->lexer->offset > 0) {
$remaining = $next_line->[1] . $next_line->[2];
}
else {
$remaining = join '', @$next_line;
}
}
my $caller = $args{caller} || [ caller(0) ];
my $e = YAML::PP::Exception->new(
got => $args{got},
expected => $args{expected},
line => $line,
column => $offset,
msg => $msg,
next => $next,
where => $caller->[1] . ' line ' . $caller->[2],
yaml => $remaining,
);
croak $e;
}
sub expected {
my ($self, %args) = @_;
my $expected = $args{expected};
@$expected = sort grep { m/^[A-Z_]+$/ } @$expected;
my $got = $args{got}->{name};
my @caller = caller(0);
$self->exception("Expected (@$expected), but got $got",
caller => \@caller,
expected => $expected,
got => $args{got},
);
}
sub cb_tag {
my ($self, $token) = @_;
scripts/dex view on Meta::CPAN
}
elsif ($chomp eq '-') {
$trim = 1;
}
my $string = '';
if (not $keep) {
# remove trailing empty lines
while (@$lines) {
last if $lines->[-1] ne '';
pop @$lines;
}
}
if ($folded) {
my $prev = 'START';
for my $i (0 .. $#$lines) {
my $line = $lines->[ $i ];
my $type = $line eq ''
? 'EMPTY'
: $line =~ m/\A[ \t]/
? 'MORE'
: 'CONTENT';
if ($prev eq 'MORE' and $type eq 'EMPTY') {
$type = 'MORE';
}
elsif ($prev eq 'CONTENT') {
if ($type ne 'CONTENT') {
$string .= "\n";
}
elsif ($type eq 'CONTENT') {
$string .= ' ';
}
}
elsif ($prev eq 'START' and $type eq 'EMPTY') {
$string .= "\n";
$type = 'START';
}
elsif ($prev eq 'EMPTY' and $type ne 'CONTENT') {
$string .= "\n";
}
$string .= $line;
if ($type eq 'MORE' and $i < $#$lines) {
$string .= "\n";
}
$prev = $type;
}
$string .= "\n" if @$lines and not $trim;
}
else {
for my $i (0 .. $#$lines) {
$string .= $lines->[ $i ];
$string .= "\n" if ($i != $#$lines or not $trim);
}
}
TRACE and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$string], ['string']);
return $string;
}
sub render_multi_val {
my ($self, $multi) = @_;
my $string = '';
my $start = 1;
for my $line (@$multi) {
if (not $start) {
if ($line eq '') {
$string .= "\n";
$start = 1;
}
else {
$string .= " $line";
}
}
else {
$string .= $line;
$start = 0;
}
}
return $string;
}
1;
YAML_PP_RENDER
$fatpacked{"YAML/PP/Representer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_REPRESENTER';
use strict;
use warnings;
package YAML::PP::Representer;
our $VERSION = '0.027'; # VERSION
use Scalar::Util qw/ reftype blessed refaddr /;
use YAML::PP::Common qw/
YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE
YAML_DOUBLE_QUOTED_SCALAR_STYLE
YAML_ANY_SCALAR_STYLE
YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE
YAML_FLOW_SEQUENCE_STYLE YAML_FLOW_MAPPING_STYLE
YAML_BLOCK_MAPPING_STYLE YAML_BLOCK_SEQUENCE_STYLE
PRESERVE_ORDER PRESERVE_SCALAR_STYLE PRESERVE_FLOW_STYLE PRESERVE_ALIAS
/;
use B;
sub new {
my ($class, %args) = @_;
my $preserve = delete $args{preserve} || 0;
if ($preserve == 1) {
$preserve = PRESERVE_ORDER | PRESERVE_SCALAR_STYLE | PRESERVE_FLOW_STYLE | PRESERVE_ALIAS;
}
my $self = bless {
schema => delete $args{schema},
preserve => $preserve,
}, $class;
if (keys %args) {
( run in 2.101 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )