\n};
for my $i (0 .. $#all) {
my $input = $all[ $i ];
if ($i and $i % 30 == 0) {
$html .= $header;
}
my $schemas = $examples->{ $input };
my $input_escaped = uri_escape($input);
$input =~ s/ / /g;
$html .= qq{
$input};
for my $schema (@keys) {
my $example = $schemas->{ $schema };
my $class = 'type-str';
my ($type, $perl, $out) = @$example;
$class = "type-$type";
for ($out) {
s/ / /g;
}
if (0 and $type eq 'str') {
$html .= qq{
$type
};
}
else {
$html .= qq{
$type
$out
};
}
}
$html .= qq{
\n};
}
$html .= "
";
return $html;
}
sub generate_html {
my ($content) = @_;
my $html = <<'EOM';
YAML Schema DataYAML Test Schema
| Schemas
| Test Data
For each of the four schemas, the first column shows to which type the input
YAML should resolve. The second column shows how the output YAML should
look like.
\n};
for my $i (0 .. $#all) {
my $input = $all[ $i ];
if ($i and $i % 30 == 0) {
$html .= $header;
}
my $schemas = $examples->{ $input };
my $mods = $modules->{ $input };
my $input_escaped = uri_escape($input);
$input =~ s/ / /g;
$html .= qq{
$input};
for my $mod (@mods) {
my $result = $mods->{ $mod };
$schemas->{ $mod } = [ $result->{type}, '', $result->{dump} // '' ];
}
for my $schema (@keys, @mods) {
my $example = $schemas->{ $schema };
my $class = 'type-str';
my ($type, $perl, $out) = @$example;
$class = "type-$type";
for ($out) {
s/ / /g;
}
if ($type eq 'str') {
$html .= qq{
$type
};
}
else {
$html .= qq{
$type
$out
};
}
}
$html .= qq{
\n};
}
$html .= "
";
return $html;
}
#sub format_perl {
# my ($type, $perl) = @_;
# my $perlcode;
# local $Data::Dumper::Terse = 1;
# local $Data::Dumper::Useqq = 1;
# if ($type eq 'null') {
# $perlcode = 'undef';
# }
# elsif ($type eq 'float' or $type eq 'int') {
# $perlcode = $perl;
# }
# elsif ($type eq 'inf') {
# if ($perl eq 'inf-neg()') {
# $perlcode = '- "inf" + 0';
# }
# else {
# $perlcode = '"inf" + 0';
# }
# }
# elsif ($type eq 'nan') {
# $perlcode = '"nan" + 0';
# }
# elsif ($type eq 'bool') {
# $perlcode = $perl;
# }
# else {
# $perlcode = Data::Dumper->Dump([$perl], ['perl']);
# }
# return $perlcode;
#}
sub generate_html {
my ($content) = @_;
my $html = <<'EOM';
YAML Schema examples in YAML::PP and other Perl ModulesYAML Test Suite Test Cases
| Schema examples
| Schema comparison
The Perl Module YAML::PP implements YAML 1.2.
You can choose between several Schemas.
The following table shows which strings result in which native data, depending
on the Schema (or other YAML module) you use.
For each of the Schemas and modules, the first column is the type,
and the second shows how the data is encoded into YAML again.
Note that the YAML 1.2 JSON Schema is not exactly like the official schema,
as all strings would have to be quoted.
EOM
$html .= $content;
$html .= <<'EOM';
EOM
return $html;
}
YAML-PP-v0.41.0/etc/PaxHeaders/generate-examples.pl 0000644 0000000 0000000 00000000130 15214605475 016644 x ustar 00 30 mtime=1781730109.609691802
28 atime=1781730109.6096001
30 ctime=1781730109.609691802
YAML-PP-v0.41.0/etc/generate-examples.pl 0000644 0001750 0001750 00000002627 15214605475 016307 0 ustar 00tina tina #!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
use FindBin '$Bin';
use lib "$Bin/../lib";
use YAML::PP;
my $tests_perl = require "$Bin/../examples/schema-perl.pm";
my $tests_ixhash = require "$Bin/../examples/schema-ixhash.pm";
my $schema_perl_pm_file = "$Bin/../lib/YAML/PP/Schema/Perl.pm";
my $schema_ixhash_pm_file = "$Bin/../lib/YAML/PP/Schema/Tie/IxHash.pm";
my $yp = YAML::PP->new( schema => [qw/ JSON Perl Tie::IxHash /] );
generate(
file => $schema_perl_pm_file,
tests => $tests_perl,
);
generate(
file => $schema_ixhash_pm_file,
tests => $tests_ixhash,
);
sub generate {
my %args = @_;
my $file = $args{file};
my $tests = $args{tests};
open my $fh, '<', $file;
my $text = do { local $/; <$fh> };
close $fh;
my $examples;
for my $name (sort keys %$tests) {
my $test = $tests->{ $name };
my $code = $test->[0];
my $data = eval $code;
if ($@) {
die "Error: $@";
}
my $yaml = $yp->dump_string($data);
$yaml =~ s/^/ /gm;
my $example = <<"EOM";
=item $name
# Code
$code
# YAML
$yaml
EOM
$examples .= $example;
}
my $pod = <<"EOM";
### BEGIN EXAMPLE
=pod
=over 4
$examples
=back
=cut
### END EXAMPLE
EOM
$text =~ s/^### BEGIN EXAMPLE.*^### END EXAMPLE\n/$pod/ms;
open $fh, '>', $file;
print $fh $text;
close $fh;
}
YAML-PP-v0.41.0/etc/PaxHeaders/generate-grammar.pl 0000644 0000000 0000000 00000000130 15214605475 016454 x ustar 00 29 mtime=1781730109.60932646
30 atime=1781730109.609235946
29 ctime=1781730109.60932646
YAML-PP-v0.41.0/etc/generate-grammar.pl 0000755 0001750 0001750 00000003122 15214605475 016111 0 ustar 00tina tina #!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
use FindBin '$Bin';
use Data::Dumper;
use YAML::XS qw/ Load Dump /;
my $grammar_file = "$Bin/grammar.yaml";
open my $fh, '<', $grammar_file or die $!;
my $yaml = do { local $/; <$fh> };
close $fh;
my $module_file = "$Bin/../lib/YAML/PP/Grammar.pm";
my $grammar = Load $yaml;
open $fh, '<', $module_file or die $!;
my $replaced = '';
while (my $line = <$fh>) {
my $state = $line =~ m/^# START OF GRAMMAR INLINE/ ... $line =~ m/^# END OF GRAMMAR INLINE/;
my $state2 = $line =~ m/^ *# START OF YAML INLINE/ ... $line =~ m/^ *# END OF YAML INLINE/;
if ($state) {
if ($state == 1) {
$replaced .= $line;
local $Data::Dumper::Indent = 1;
local $Data::Dumper::Sortkeys = 1;
my $dump = Data::Dumper->Dump([$grammar], ['GRAMMAR']);
$replaced .= <<"EOM";
# DO NOT CHANGE THIS
# This grammar is automatically generated from etc/grammar.yaml
$dump
EOM
}
elsif ($state =~ m/E0$/) {
$replaced .= $line;
}
}
elsif ($state2) {
if ($state2 == 1) {
$replaced .= $line;
my $yaml_formatted = $yaml;
$yaml_formatted =~ s/^/ /mg;
$replaced .= <<"EOM";
# DO NOT CHANGE THIS
# This grammar is automatically generated from etc/grammar.yaml
$yaml_formatted
EOM
}
elsif ($state2 =~ m/E0$/) {
$replaced .= $line;
}
}
else {
$replaced .= $line;
}
}
close $fh;
open $fh, '>', $module_file or die $!;
print $fh $replaced;
close $fh;
YAML-PP-v0.41.0/etc/PaxHeaders/test-suite-html.pl 0000644 0000000 0000000 00000000132 15214605475 016310 x ustar 00 30 mtime=1781730109.607470909
30 atime=1781730109.607367404
30 ctime=1781730109.607470909
YAML-PP-v0.41.0/etc/test-suite-html.pl 0000755 0001750 0001750 00000023333 15214605475 015751 0 ustar 00tina tina #!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
use FindBin '$Bin';
use lib "$Bin/../lib";
use IO::All;
use Data::Dumper;
use YAML::PP;
use YAML::PP::Dumper;
use File::Basename qw/ basename dirname /;
use HTML::Entities qw/ encode_entities /;
use YAML::PP::Highlight;
use JSON::XS ();
use Encode;
chomp(my $version = qx{git describe --dirty});
my $yaml_test_suite = 'test-suite/yaml-test-suite-data/';
my @dirs = grep { m{/[0-9A-Z]{4}$} } map { "$_" } io->dir($yaml_test_suite)->all;
my @subdirs;
for my $dir (@dirs) {
if (-f "$dir/in.yaml") {
push @subdirs, $dir;
}
else {
push @subdirs, grep { m{/[0-9]+$} } map { "$_" } io->dir($dir)->all;
}
}
@subdirs = sort @subdirs;
my @valid = grep { not -f "$_/error" } @subdirs;
my @invalid = grep { -f "$_/error" } @subdirs;
my %tags;
for my $tagdir (io->dir("$yaml_test_suite/tags")->all) {
for my $id (io->dir($tagdir)->all) {
my $tag = basename $tagdir;
push @{ $tags{ basename $id } }, basename $tag;
}
}
my $html = <<"EOM";
YAML Test Suite HighlightedYAML Test Suite Test Cases
| Schema examples
| Schema comparison
Generated with YAML::PP $version Valid (@{[ scalar @valid ]}) Invalid (@{[ scalar @invalid ]})
EOM
my $ypp = YAML::PP->new(
boolean => 'JSON::PP',
schema => [qw/ Core /],
);
my $table;
for my $dir (sort @valid) {
my $test = highlight_test($dir);
$table .= $test;
}
$html .= <<"EOM";
EOM
my $high = YAML::PP::Highlight->htmlcolored($tokens);
my $reload_high = YAML::PP::Highlight->htmlcolored($reload_tokens);
my $emit_high = YAML::PP::Highlight->htmlcolored($emit_tokens);
my $orig = $diff ? qq{
$yaml
} : '';
$html .= <<"EOM";
$high
$error
$orig
$data_dump
$json_dump
$reload_high
$emit_high
EOM
return $html;
}
$html .= <<"EOM";
EOM
binmode STDOUT, ":encoding(utf-8)";
say $html;
YAML-PP-v0.41.0/etc/PaxHeaders/json-numbers.pl 0000644 0000000 0000000 00000000132 15214605475 015662 x ustar 00 30 mtime=1781730109.600497297
30 atime=1781730109.600408179
30 ctime=1781730109.600497297
YAML-PP-v0.41.0/etc/json-numbers.pl 0000644 0001750 0001750 00000002226 15214605475 015316 0 ustar 00tina tina #!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
use JSON ();
use JSON::PP ();
use JSON::XS ();
use Cpanel::JSON::XS ();
require Mojolicious;
use Mojo::JSON ();
use B ();
use Text::Table;
my @classes = qw/ JSON JSON::PP JSON::XS Cpanel::JSON::XS Mojo::JSON /;
my $t = Text::Table->new(
qw/
Class
Version
3 IV NV PV
3.140 IV NV PV
3.00 IV NV PV
0.3e3 IV NV PV
encode
/,
);
my $json = <<'EOM';
[ 3, 3.140, 3.00, 0.3e3 ]
EOM
my @rows;
for my $class (@classes) {
my $version = $class eq 'Mojo::JSON' ? Mojolicious->VERSION : $class->VERSION;
my @row = ( $class, $version );
my $decode = $class->can("decode_json");
my $encode = $class->can("encode_json");
my $data = $decode->($json);
for my $num (@$data) {
my $flags = B::svref_2object(\$num)->FLAGS;
my $int = $flags & B::SVp_IOK ? 1 : 0;
my $float = $flags & B::SVp_NOK ? 1 : 0;
my $str = $flags & B::SVp_POK ? 1 : 0;
push @row, '', $int, $float, $str;
}
my $enc = $encode->($data);
push @row, $enc;
push @rows, \@row;
}
say "Input: $json";
$t->load(@rows);
say $t;
YAML-PP-v0.41.0/etc/PaxHeaders/yaml-numbers.pl 0000644 0000000 0000000 00000000131 15214605475 015652 x ustar 00 30 mtime=1781730109.600408179
29 atime=1781730109.60031515
30 ctime=1781730109.600408179
YAML-PP-v0.41.0/etc/yaml-numbers.pl 0000644 0001750 0001750 00000002167 15214605475 015313 0 ustar 00tina tina #!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
use YAML ();
local $YAML::Numify = 1;
use YAML::PP ();
use YAML::XS ();
use YAML::Syck ();
local $YAML::Syck::ImplicitTyping = 1;
use YAML::Tiny ();
use B ();
use Text::Table;
my @classes = qw/ YAML YAML::PP YAML::XS YAML::Syck YAML::Tiny /;
my $t = Text::Table->new(
qw/
Class
Version
3 IV NV PV
3.140 IV NV PV
3.00 IV NV PV
0.3e3 IV NV PV
Dump
/,
);
my $yaml = <<'EOM';
- 3
- 3.140
- 3.00
- 0.3e3
EOM
my @rows;
for my $class (@classes) {
my $version = $class->VERSION;
my @row = ( $class, $version );
my $decode = $class->can("Load");
my $encode = $class->can("Dump");
my $data = $decode->($yaml);
for my $num (@$data) {
my $flags = B::svref_2object(\$num)->FLAGS;
my $int = $flags & B::SVp_IOK ? 1 : 0;
my $float = $flags & B::SVp_NOK ? 1 : 0;
my $str = $flags & B::SVp_POK ? 1 : 0;
push @row, '', $int, $float, $str;
}
my $enc = $encode->($data);
push @row, $enc;
push @rows, \@row;
}
say "Input:\n$yaml";
$t->load(@rows);
say $t;
YAML-PP-v0.41.0/etc/PaxHeaders/grammar.yaml 0000644 0000000 0000000 00000000132 15214605475 015215 x ustar 00 30 mtime=1781730109.597619893
30 atime=1781730109.597528331
30 ctime=1781730109.597619893
YAML-PP-v0.41.0/etc/grammar.yaml 0000644 0001750 0001750 00000040501 15214605475 014647 0 ustar 00tina tina ---
NODETYPE_NODE:
DASH:
match: cb_seqstart
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
NODETYPE_SCALAR_OR_MAP:
# Flow nodes can follow tabs
WS: { new: FULLMAPVALUE_INLINE }
ALIAS:
match: cb_alias
EOL: { match: cb_send_alias_from_stack }
WS:
COLON:
match: cb_insert_map_alias
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
QUESTION:
match: cb_questionstart
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
QUOTED:
match: cb_take_quoted
EOL: { match: cb_send_scalar }
WS:
COLON:
match: cb_insert_map
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
COLON:
match: cb_insert_map
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
QUOTED_MULTILINE:
match: cb_quoted_multiline
EOL: { }
PLAIN:
match: cb_start_plain
EOL:
match: cb_send_scalar
WS:
COLON:
match: cb_insert_map
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
COLON:
match: cb_insert_map
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
PLAIN_MULTI:
match: cb_send_plain_multi
EOL: { }
COLON:
match: cb_insert_empty_map
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
BLOCK_SCALAR:
match: cb_send_block_scalar
EOL: { }
FLOWSEQ_START:
match: cb_start_flowseq
new: NEWFLOWSEQ
FLOWMAP_START:
match: cb_start_flowmap
new: NEWFLOWMAP
DOC_END:
match: cb_end_document
EOL: { }
DOC_START:
match: cb_end_doc_start_document
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
EOL:
new: NODETYPE_SCALAR_OR_MAP
NODETYPE_COMPLEX:
COLON:
match: cb_complexcolon
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
DEFAULT:
match: cb_empty_complexvalue
new: NODETYPE_MAP
EOL:
new: NODETYPE_COMPLEX
RULE_FULLFLOWSCALAR:
ANCHOR:
match: cb_anchor
EOL: { new: RULE_FULLFLOWSCALAR_ANCHOR }
DEFAULT: { new: RULE_FULLFLOWSCALAR_ANCHOR }
TAG:
match: cb_tag
EOL: { new: RULE_FULLFLOWSCALAR_TAG }
DEFAULT: { new: RULE_FULLFLOWSCALAR_TAG }
DEFAULT: { new: RULE_FLOWSCALAR }
RULE_FULLFLOWSCALAR_ANCHOR:
WS: { new: RULE_FULLFLOWSCALAR_ANCHOR }
TAG:
match: cb_tag
WS: { new: RULE_FLOWSCALAR }
EOL: { new: RULE_FLOWSCALAR }
DEFAULT: { new: RULE_FLOWSCALAR }
RULE_FULLFLOWSCALAR_TAG:
WS: { new: RULE_FULLFLOWSCALAR_TAG }
ANCHOR:
match: cb_anchor
WS: { new: RULE_FLOWSCALAR }
EOL: { new: RULE_FLOWSCALAR }
DEFAULT: { new: RULE_FLOWSCALAR }
RULE_FLOWSCALAR:
FLOWSEQ_START: { match: cb_start_flowseq, new: NEWFLOWSEQ }
FLOWMAP_START: { match: cb_start_flowmap, new: NEWFLOWMAP }
ALIAS: { match: cb_send_alias, return: 1 }
QUOTED:
match: cb_take_quoted
EOL: { match: cb_send_scalar }
WS: { match: cb_send_scalar, return: 1 }
DEFAULT: { match: cb_send_scalar, return: 1 }
QUOTED_MULTILINE: { match: cb_quoted_multiline, return: 1 }
PLAIN:
match: cb_start_plain
EOL: { match: cb_send_scalar }
DEFAULT: { match: cb_send_scalar, return: 1 }
PLAIN_MULTI: { match: cb_send_plain_multi, return: 1 }
FLOW_COMMA: { match: cb_empty_flow_mapkey, return: 1 }
FLOWMAP_END:
match: cb_end_flowmap_empty
return: 1
FLOWSEQ:
FLOWSEQ_START: { match: cb_start_flowseq, new: NEWFLOWSEQ }
FLOWMAP_START: { match: cb_start_flowmap, new: NEWFLOWMAP }
ALIAS: { match: cb_send_flow_alias, new: FLOWSEQ_NEXT }
PLAIN:
match: cb_start_plain
EOL:
match: cb_send_scalar
new: FLOWSEQ_NEXT
DEFAULT:
new: FLOWSEQ_MAYBE_KEY
PLAIN_MULTI: { match: cb_send_plain_multi, new: FLOWSEQ_NEXT }
QUOTED:
match: cb_take_quoted
EOL:
match: cb_send_scalar
new: FLOWSEQ_NEXT
DEFAULT:
new: FLOWSEQ_MAYBE_KEY
QUOTED_MULTILINE: { match: cb_quoted_multiline, new: FLOWSEQ_NEXT }
COLON:
WS:
match: cb_insert_empty_implicit_flowseq_map
new: RULE_FULLFLOWSCALAR
EOL:
match: cb_insert_empty_implicit_flowseq_map
new: RULE_FULLFLOWSCALAR
FLOWSEQ_PROPS:
FLOWSEQ_START: { match: cb_start_flowseq, new: NEWFLOWSEQ }
FLOWMAP_START: { match: cb_start_flowmap, new: NEWFLOWMAP }
PLAIN:
match: cb_start_plain
EOL:
match: cb_send_scalar
new: FLOWSEQ_NEXT
DEFAULT:
new: FLOWSEQ_MAYBE_KEY
PLAIN_MULTI: { match: cb_send_plain_multi, new: FLOWSEQ_NEXT }
QUOTED:
match: cb_take_quoted
EOL:
match: cb_send_scalar
new: FLOWSEQ_NEXT
DEFAULT:
new: FLOWSEQ_MAYBE_KEY
QUOTED_MULTILINE: { match: cb_quoted_multiline, new: FLOWSEQ_NEXT }
FLOW_COMMA:
match: cb_empty_flowseq_comma
return: 1
FLOWSEQ_END:
match: cb_empty_flowseq_end
return: 1
COLON:
WS:
match: cb_insert_empty_implicit_flowseq_map
new: RULE_FULLFLOWSCALAR
EOL:
match: cb_insert_empty_implicit_flowseq_map
new: RULE_FULLFLOWSCALAR
FLOWSEQ_EMPTY:
FLOW_COMMA:
match: cb_empty_flowseq_comma
return: 1
FLOWSEQ_END:
match: cb_empty_flowseq_end
return: 1
FLOWSEQ_NEXT:
WS: { new: FLOWSEQ_NEXT }
EOL: { new: FLOWSEQ_NEXT }
FLOW_COMMA:
match: cb_flow_comma
return: 1
FLOWSEQ_END:
match: cb_end_flowseq
return: 1
FLOWSEQ_MAYBE_KEY:
WS: { new: FLOWSEQ_MAYBE_KEY }
COLON:
WS:
match: cb_insert_implicit_flowseq_map
new: RULE_FULLFLOWSCALAR
EOL:
match: cb_insert_implicit_flowseq_map
new: RULE_FULLFLOWSCALAR
DEFAULT:
match: cb_insert_implicit_flowseq_map
new: RULE_FULLFLOWSCALAR
DEFAULT:
new: FLOWSEQ_NEXT
FLOWMAP_CONTENT:
FLOWSEQ_START: { match: cb_start_flowseq, new: NEWFLOWSEQ }
FLOWMAP_START: { match: cb_start_flowmap, new: NEWFLOWMAP }
ALIAS: { match: cb_send_alias, return: 1 }
PLAIN: { match: cb_flowkey_plain, return: 1 }
PLAIN_MULTI: { match: cb_send_plain_multi, return: 1 }
QUOTED: { match: cb_flowkey_quoted, return: 1 }
QUOTED_MULTILINE: { match: cb_quoted_multiline, return: 1 }
COLON:
WS:
match: cb_empty_flow_mapkey
new: RULE_FULLFLOWSCALAR
EOL:
match: cb_empty_flow_mapkey
new: RULE_FULLFLOWSCALAR
FLOWMAP_PROPS:
FLOWSEQ_START: { match: cb_start_flowseq, new: NEWFLOWSEQ }
FLOWMAP_START: { match: cb_start_flowmap, new: NEWFLOWMAP }
PLAIN: { match: cb_flowkey_plain, return: 1 }
PLAIN_MULTI: { match: cb_send_plain_multi, return: 1 }
QUOTED: { match: cb_flowkey_quoted, return: 1 }
QUOTED_MULTILINE: { match: cb_quoted_multiline, return: 1 }
COLON:
WS:
match: cb_empty_flow_mapkey
new: RULE_FULLFLOWSCALAR
EOL:
match: cb_empty_flow_mapkey
new: RULE_FULLFLOWSCALAR
FLOW_COMMA:
match: cb_empty_flowmap_key_value
return: 1
FLOWMAP_END:
match: cb_end_empty_flowmap_key_value
return: 1
FLOWMAP_EMPTYKEY:
FLOW_COMMA:
match: cb_empty_flowmap_key_value
return: 1
FLOWMAP_END:
match: cb_end_empty_flowmap_key_value
return: 1
NEWFLOWSEQ:
EOL: { new: NEWFLOWSEQ }
WS: { new: NEWFLOWSEQ }
ANCHOR:
match: cb_anchor
WS: { new: NEWFLOWSEQ_ANCHOR_SPC }
EOL: { new: NEWFLOWSEQ_ANCHOR_SPC }
DEFAULT: { new: NEWFLOWSEQ_ANCHOR }
TAG:
match: cb_tag
WS: { new: NEWFLOWSEQ_TAG_SPC }
EOL: { new: NEWFLOWSEQ_TAG_SPC }
DEFAULT: { new: NEWFLOWSEQ_TAG }
FLOWSEQ_END:
match: cb_end_flowseq
return: 1
DEFAULT: { new: FLOWSEQ }
NODETYPE_FLOWSEQ:
EOL: { new: NODETYPE_FLOWSEQ }
WS: { new: NODETYPE_FLOWSEQ }
FLOWSEQ_END:
match: cb_end_flowseq
return: 1
DEFAULT: { new: NEWFLOWSEQ }
NODETYPE_FLOWMAPVALUE:
WS: { new: NODETYPE_FLOWMAPVALUE }
EOL: { new: NODETYPE_FLOWMAPVALUE }
COLON:
match: cb_flow_colon
WS: { new: RULE_FULLFLOWSCALAR }
EOL: { new: RULE_FULLFLOWSCALAR }
DEFAULT: { new: RULE_FULLFLOWSCALAR }
FLOW_COMMA:
match: cb_empty_flowmap_value
return: 1
FLOWMAP_END:
match: cb_end_flowmap_empty
return: 1
NEWFLOWSEQ_ANCHOR:
DEFAULT: { new: FLOWSEQ_EMPTY }
NEWFLOWSEQ_TAG:
DEFAULT: { new: FLOWSEQ_EMPTY }
NEWFLOWSEQ_ANCHOR_SPC:
WS: { new: NEWFLOWSEQ_ANCHOR_SPC }
EOL: { new: NEWFLOWSEQ_ANCHOR_SPC }
TAG:
match: cb_tag
WS: { new: FLOWSEQ_PROPS }
EOL: { new: FLOWSEQ_PROPS }
DEFAULT: { new: FLOWSEQ_EMPTY }
DEFAULT: { new: FLOWSEQ_PROPS }
NEWFLOWSEQ_TAG_SPC:
WS: { new: NEWFLOWSEQ_TAG_SPC }
EOL: { new: NEWFLOWSEQ_TAG_SPC }
ANCHOR:
match: cb_anchor
WS: { new: FLOWSEQ_PROPS }
EOL: { new: FLOWSEQ_PROPS }
DEFAULT: { new: FLOWSEQ_EMPTY }
DEFAULT: { new: FLOWSEQ_PROPS }
NEWFLOWMAP_ANCHOR:
DEFAULT: { new: FLOWMAP_EMPTYKEY }
NEWFLOWMAP_TAG:
DEFAULT: { new: FLOWMAP_EMPTYKEY }
NEWFLOWMAP_ANCHOR_SPC:
WS: { new: NEWFLOWMAP_ANCHOR_SPC }
EOL: { new: NEWFLOWMAP_ANCHOR_SPC }
TAG:
match: cb_tag
WS: { new: FLOWMAP_PROPS }
EOL: { new: FLOWMAP_PROPS }
DEFAULT: { new: FLOWMAP_EMPTYKEY }
DEFAULT: { new: FLOWMAP_PROPS }
NEWFLOWMAP_TAG_SPC:
WS: { new: NEWFLOWMAP_TAG_SPC }
EOL: { new: NEWFLOWMAP_TAG_SPC }
ANCHOR:
match: cb_anchor
WS: { new: FLOWMAP_PROPS }
EOL: { new: FLOWMAP_PROPS }
DEFAULT: { new: FLOWMAP_EMPTYKEY }
DEFAULT: { new: FLOWMAP_PROPS }
NEWFLOWMAP:
EOL: { new: NEWFLOWMAP }
WS: { new: NEWFLOWMAP }
QUESTION: { match: cb_flow_question, new: FLOWMAP_EXPLICIT_KEY }
DEFAULT: { new: FLOWMAP }
FLOWMAP_EXPLICIT_KEY:
WS: { new: FLOWMAP_EXPLICIT_KEY }
EOL: { new: FLOWMAP_EXPLICIT_KEY }
FLOWMAP_END:
match: cb_end_empty_flowmap_key_value
return: 1
FLOW_COMMA:
match: cb_empty_flowmap_key_value
return: 1
DEFAULT: { new: FLOWMAP }
FLOWMAP:
EOL: { new: FLOWMAP }
WS: { new: FLOWMAP }
ANCHOR:
match: cb_anchor
WS: { new: NEWFLOWMAP_ANCHOR_SPC }
EOL: { new: NEWFLOWMAP_ANCHOR_SPC }
DEFAULT: { new: NEWFLOWMAP_ANCHOR }
TAG:
match: cb_tag
WS: { new: NEWFLOWMAP_TAG_SPC }
EOL: { new: NEWFLOWMAP_TAG_SPC }
DEFAULT: { new: NEWFLOWMAP_TAG }
FLOWMAP_END:
match: cb_end_flowmap
return: 1
COLON:
WS:
match: cb_empty_flow_mapkey
new: RULE_FULLFLOWSCALAR
EOL:
match: cb_empty_flow_mapkey
new: RULE_FULLFLOWSCALAR
DEFAULT: { new: FLOWMAP_CONTENT }
NODETYPE_FLOWMAP:
EOL: { new: NODETYPE_FLOWMAP }
WS: { new: NODETYPE_FLOWMAP }
FLOWMAP_END:
match: cb_end_flowmap
return: 1
FLOW_COMMA: { match: cb_flow_comma, new: NEWFLOWMAP }
DEFAULT: { new: NEWFLOWMAP }
END_FLOW:
EOL:
match: cb_end_outer_flow
return: 1
RULE_MAPKEY:
QUESTION:
match: cb_question
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
ALIAS:
match: cb_send_alias_key
WS:
COLON:
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
QUOTED:
match: cb_take_quoted_key
WS:
COLON:
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
COLON:
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
PLAIN:
match: cb_mapkey
WS:
COLON:
match: cb_send_mapkey
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
COLON:
match: cb_send_mapkey
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
COLON:
match: cb_empty_mapkey
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
DOC_END:
match: cb_end_document
EOL: { }
DOC_START:
match: cb_end_doc_start_document
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
EOL:
new: RULE_MAPKEY
NODETYPE_SEQ:
DASH:
match: cb_seqitem
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
DOC_END:
match: cb_end_document
EOL: { }
DOC_START:
match: cb_end_doc_start_document
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
EOL:
new: NODETYPE_SEQ
NODETYPE_MAP:
ANCHOR:
match: cb_anchor
WS:
TAG:
match: cb_tag
WS: { new: RULE_MAPKEY }
DEFAULT: { new: RULE_MAPKEY }
TAG:
match: cb_tag
WS:
ANCHOR:
match: cb_anchor
WS: { new: RULE_MAPKEY }
DEFAULT: { new: RULE_MAPKEY }
DEFAULT: { new: RULE_MAPKEY }
FULLNODE_ANCHOR:
TAG:
match: cb_tag
EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
WS:
ANCHOR:
match: cb_anchor
WS: { new: NODETYPE_SCALAR_OR_MAP }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
ANCHOR:
match: cb_anchor
WS:
TAG:
match: cb_tag
WS: { new: NODETYPE_SCALAR_OR_MAP }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
EOL: { new: FULLNODE_ANCHOR }
DEFAULT: { new: NODETYPE_NODE }
FULLNODE_TAG:
ANCHOR:
match: cb_anchor
EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
WS:
TAG:
match: cb_tag
WS: { new: NODETYPE_SCALAR_OR_MAP }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP, }
TAG:
match: cb_tag
WS:
ANCHOR:
match: cb_anchor
WS: { new: NODETYPE_SCALAR_OR_MAP }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
EOL: { new: FULLNODE_TAG }
DEFAULT: { new: NODETYPE_NODE }
FULLNODE_TAG_ANCHOR:
ANCHOR:
match: cb_anchor
WS:
TAG:
match: cb_tag
WS: { new: NODETYPE_SCALAR_OR_MAP }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
TAG:
match: cb_tag
WS:
ANCHOR:
match: cb_anchor
WS: { new: NODETYPE_SCALAR_OR_MAP }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
EOL: { new: FULLNODE_TAG_ANCHOR }
DEFAULT: { new: NODETYPE_NODE }
FULLNODE:
ANCHOR:
match: cb_anchor
EOL: { match: cb_property_eol, new: FULLNODE_ANCHOR }
WS:
TAG:
match: cb_tag
EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
WS: { new: NODETYPE_SCALAR_OR_MAP }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
TAG:
match: cb_tag
EOL: { match: cb_property_eol, new: FULLNODE_TAG }
WS:
ANCHOR:
match: cb_anchor
EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
WS: { new: NODETYPE_SCALAR_OR_MAP }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
EOL: { new: FULLNODE }
DEFAULT: { new: NODETYPE_NODE }
FULLMAPVALUE_INLINE:
ANCHOR:
match: cb_anchor
EOL: { match: cb_property_eol, new: FULLNODE_ANCHOR }
WS:
TAG:
match: cb_tag
EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
WS: { new: NODETYPE_MAPVALUE_INLINE }
DEFAULT: { new: NODETYPE_MAPVALUE_INLINE }
TAG:
match: cb_tag
EOL: { match: cb_property_eol, new: FULLNODE_TAG }
WS:
ANCHOR:
match: cb_anchor
EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
WS: { new: NODETYPE_MAPVALUE_INLINE }
DEFAULT: { new: NODETYPE_MAPVALUE_INLINE }
DEFAULT: { new: NODETYPE_MAPVALUE_INLINE }
NODETYPE_MAPVALUE_INLINE:
ALIAS:
match: cb_send_alias
EOL: { }
QUOTED:
match: cb_take_quoted
EOL: { match: cb_send_scalar }
QUOTED_MULTILINE:
match: cb_quoted_multiline
EOL: { }
PLAIN:
match: cb_start_plain
EOL:
match: cb_send_scalar
PLAIN_MULTI:
match: cb_send_plain_multi
EOL: { }
BLOCK_SCALAR:
match: cb_send_block_scalar
EOL: { }
FLOWSEQ_START:
match: cb_start_flowseq
new: NEWFLOWSEQ
FLOWMAP_START:
match: cb_start_flowmap
new: NEWFLOWMAP
DOC_END:
match: cb_end_document
EOL: { }
DOCUMENT_END:
DOC_END:
match: cb_end_document
EOL: { }
DOC_START:
match: cb_end_doc_start_document
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
EOL:
new: DOCUMENT_END
STREAM:
DOC_END:
match: cb_end_document_empty
EOL: { }
DOC_START:
match: cb_doc_start_explicit
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
YAML_DIRECTIVE:
match: cb_set_yaml_version_directive
EOL: { new: DIRECTIVE }
WS: { new: DIRECTIVE }
RESERVED_DIRECTIVE:
match: cb_reserved_directive
EOL: { new: DIRECTIVE }
WS: { new: DIRECTIVE }
TAG_DIRECTIVE:
match: cb_tag_directive
EOL: { new: DIRECTIVE }
WS: { new: DIRECTIVE }
EOL:
new: STREAM
DEFAULT:
match: cb_doc_start_implicit
new: FULLNODE
DIRECTIVE:
DOC_START:
match: cb_doc_start_explicit
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
YAML_DIRECTIVE:
match: cb_set_yaml_version_directive
EOL: { new: DIRECTIVE }
WS: { new: DIRECTIVE }
RESERVED_DIRECTIVE:
match: cb_reserved_directive
EOL: { new: DIRECTIVE }
WS: { new: DIRECTIVE }
TAG_DIRECTIVE:
match: cb_tag_directive
EOL: { new: DIRECTIVE }
WS: { new: DIRECTIVE }
EOL:
new: DIRECTIVE
YAML-PP-v0.41.0/etc/PaxHeaders/get-tags.pl 0000644 0000000 0000000 00000000132 15214605475 014753 x ustar 00 30 mtime=1781730109.594200938
30 atime=1781730109.594056855
30 ctime=1781730109.594200938
YAML-PP-v0.41.0/etc/get-tags.pl 0000644 0001750 0001750 00000001174 15214605475 014410 0 ustar 00tina tina #!/usr/bin/perl
use strict;
use warnings;
use FindBin '$Bin';
use YAML::PP qw/ DumpFile /;
sub get_tags {
my ($dir) = @_;
my %tag_id;
opendir my $dh, $dir or die $!;
my @tags = grep { not m/^\./ } readdir $dh;
for my $tag (sort @tags) {
next unless -d "$dir/$tag";
opendir my $dh, "$dir/$tag" or die $!;
my @ids = grep { -l "$dir/$tag/$_" } readdir $dh;
$tag_id{ $tag }->{ $_ } = 1 for @ids;
closedir $dh;
}
closedir $dh;
return \%tag_id;
}
my $data = get_tags("$Bin/../test-suite/yaml-test-suite-data/tags");
DumpFile("$Bin/../test-suite/tag_id.yaml", $data);
YAML-PP-v0.41.0/PaxHeaders/bin 0000644 0000000 0000000 00000000132 15214605475 012623 x ustar 00 30 mtime=1781730109.605273623
30 atime=1781730109.593909489
30 ctime=1781730109.605273623
YAML-PP-v0.41.0/bin/ 0000755 0001750 0001750 00000000000 15214605475 012332 5 ustar 00tina tina YAML-PP-v0.41.0/bin/PaxHeaders/yamlpp-parse-emit 0000644 0000000 0000000 00000000132 15214605475 016171 x ustar 00 30 mtime=1781730109.605375173
30 atime=1781730109.605273623
30 ctime=1781730109.605375173
YAML-PP-v0.41.0/bin/yamlpp-parse-emit 0000755 0001750 0001750 00000006262 15214605475 015634 0 ustar 00tina tina #!/usr/bin/perl
use strict;
use warnings;
use YAML::PP;
use YAML::PP::Common qw/ YAML_FLOW_SEQUENCE_STYLE YAML_FLOW_MAPPING_STYLE /;
use YAML::PP::Parser;
use YAML::PP::Emitter;
use YAML::PP::Writer;
use Data::Dumper;
use Encode;
use Getopt::Long;
Getopt::Long::Configure('bundling');
GetOptions(
'help|h' => \my $help,
'indent=i' => \my $indent,
'module|M=s' => \my $module,
'dump|D=s' => \my $emit,
'verbose' => \my $verbose,
'flow=s' => \my $flow,
'width=i' => \my $width,
) or usage(1);
usage(0) if $help;
$module ||= 'YAML::PP';
$emit ||= $module;
$flow ||= 'no';
my ($file) = @ARGV;
my $yaml;
if ($file) {
open my $fh, '<', $file or die $!;
$yaml = do { local $/; <$fh> };
close $fh;
}
else {
$yaml = do { local $/; };
}
$yaml = decode_utf8($yaml);
if ($emit eq 'YAML::PP::Ref') {
$emit = 'YAML::PP';
}
my $parserclass = 'YAML::PP::Parser';
my $emitterclass = 'YAML::PP::Emitter';
if ($module eq 'YAML::PP::LibYAML') {
eval { require YAML::PP::LibYAML } or die "Module $module not supported: $@";
$parserclass = 'YAML::PP::LibYAML::Parser';
$emitterclass = 'YAML::PP::LibYAML::Emitter';
}
elsif ($module eq 'YAML::PP::Ref') {
eval { require YAML::PP::Ref } or die "Module $module not supported: $@";
$parserclass = 'YAML::PP::Ref::Parser';
}
if ($emit eq 'YAML::PP::LibYAML') {
eval { require YAML::PP::LibYAML } or die "Module $emit not supported: $@";
$emitterclass = 'YAML::PP::LibYAML::Emitter';
}
my @events;
my $parser = $parserclass->new(
receiver => sub {
my ($self, undef, $event) = @_;
push @events, $event;
},
);
eval {
$parser->parse_string($yaml);
};
if ($@) {
for (@events) {
print YAML::PP::Common::event_to_test_suite($_) ."\n";
}
warn "Error parsing: $@";
exit 1;
}
my $writer = YAML::PP::Writer->new;
my $emitter = $emitterclass->new( indent => $indent, width => $width );
$emitter->set_writer($writer);
for my $event (@events) {
my $type = $event->{name};
my $str = YAML::PP::Common::event_to_test_suite($event);
print "$str\n" if $verbose;
if ($type eq 'sequence_start_event' or $type eq 'mapping_start_event') {
if ($flow eq 'no') {
delete $event->{style};
}
elsif ($flow eq 'yes') {
if ($type eq 'sequence_start_event') {
$event->{style} = YAML_FLOW_SEQUENCE_STYLE;
}
else {
$event->{style} = YAML_FLOW_MAPPING_STYLE;
}
}
}
$emitter->$type($event);
}
my $out_yaml = $emitter->writer->output;
print encode_utf8 $out_yaml;
sub usage {
my ($rc) = @_;
print <<"EOM";
Usage:
$0 [options] < file
$0 [options] file
Options:
--indent= Number of spaces for indentation
--width= Maximum column width (only used in flow style for now)
--module, -M YAML::PP, YAML::PP::LibYAML or YAML::PP::Ref
--dump, -D YAML::PP, YAML::PP::LibYAML
--flow 'no' (default, always output block style), 'yes'
(always output flow style), 'keep' (output flow
style like in the original input)
EOM
exit $rc;
}
YAML-PP-v0.41.0/bin/PaxHeaders/yamlpp-load-dump 0000644 0000000 0000000 00000000132 15214605475 016005 x ustar 00 30 mtime=1781730109.603216369
30 atime=1781730109.603126273
30 ctime=1781730109.603216369
YAML-PP-v0.41.0/bin/yamlpp-load-dump 0000755 0001750 0001750 00000021273 15214605475 015447 0 ustar 00tina tina #!/usr/bin/perl
use strict;
use warnings;
use YAML::PP;
use YAML::PP::Dumper;
use YAML::PP::Common qw/
:PRESERVE
/;
use Encode;
use Getopt::Long;
Getopt::Long::Configure('bundling');
GetOptions(
'help|h' => \my $help,
'boolean=s' => \my $boolean,
'cyclic' => \my $cyclic,
'duplicate-keys' => \my $duplicate_keys,
'indent=i' => \my $indent,
'width=i' => \my $width,
'header!' => \my $header,
'footer!' => \my $footer,
'merge' => \my $merge,
#'catchall' => \my $catchall,
'require-footer' => \my $require_footer,
'perl' => \my $perl,
'preserve|P=s' => \my $preserve,
'module|M=s' => \my $module,
'dump-module|D=s' => \my $dump_module,
'include' => \my $include,
'include-absolute' => \my $include_absolute,
'yaml-version=s' => \my $yaml_version,
'version-directive' => \my $version_directive,
) or usage(1);
usage(0) if $help;
$module ||= 'YAML::PP';
$boolean ||= 'JSON::PP';
$footer ||= 0;
$indent ||= 2;
$yaml_version ||= 1.2;
$dump_module ||= $module;
if ($dump_module eq 'YAML::PP::Ref') {
$dump_module = 'YAML::PP';
}
my @yaml_versions = split m/,/, $yaml_version;
my @schema = ('+');
if ($merge) {
push @schema, 'Merge';
}
if ($perl) {
push @schema, 'Perl';
}
#if ($catchall) {
# push @schema, 'Catchall';
#}
my $preserve_order = 1;
if (defined $preserve) {
$preserve_order = 0;
my @split = split m/,/, $preserve;
$preserve = 0;
for my $split (@split) {
$preserve |= PRESERVE_ORDER if $split eq 'order';
$preserve_order = 1 if $split eq 'order';
$preserve |= PRESERVE_SCALAR_STYLE if $split eq 'scalar';
$preserve |= PRESERVE_FLOW_STYLE if $split eq 'flow';
$preserve |= PRESERVE_ALIAS if $split eq 'alias';
}
}
elsif ($dump_module =~ m/JSON/) {
$preserve = PRESERVE_ORDER;
}
else {
$preserve = 1;
}
$header = 1 unless defined $header;
my ($file) = @ARGV;
my $yaml;
my $decode = 1;
if ($module eq 'YAML::XS') {
$decode = 0;
}
if ($file) {
open my $fh, '<', $file or die "Can not open '$file'";
$yaml = do { local $/; <$fh> };
close $fh;
}
else {
$yaml = do { local $/; };
}
$yaml = decode_utf8($yaml) if $decode;
my %load_modules = (
'YAML::PP' => \&yamlpp,
'YAML::PP::LibYAML' => \&yamlpplibyaml,
'YAML::PP::Ref' => \&yamlppref,
'YAML::XS' => \&yamlxs,
'YAML::Tiny' => \&yamltiny,
'YAML::Syck' => \&yamlsyck,
'YAML' => \&yaml,
);
my %dump_modules = (
'YAML::PP' => \&yamlpp_dump,
'YAML::PP::LibYAML' => \&yamlpplibyaml_dump,
'YAML::XS' => \&yamlxs_dump,
'YAML::Tiny' => \&yamltiny_dump,
'YAML::Syck' => \&yamlsyck_dump,
'YAML' => \&yaml_dump,
'Data::Dumper' => \&data_dumper,
'JSON::PP' => \&json_pp_dump,
'JSON::XS' => \&json_xs_dump,
'Cpanel::JSON::XS' => \&cpanel_json_xs_dump,
);
my $code = $load_modules{ $module } or die "Module '$module' not supported for loading";
my $dump_code = $dump_modules{ $dump_module } or die "Module '$dump_module' not supported for dumping";
my $docs = $code->($yaml, $file);
my $out_yaml = $dump_code->($docs);
sub _yamlpp {
my ($class, $yaml, $file) = @_;
my %args;
my $inc;
if ($include) {
require YAML::PP::Schema::Include;
$inc = YAML::PP::Schema::Include->new(
$include_absolute ? (allow_absolute => 1) : (),
);
push @schema, $inc;
}
my $ypp = $class->new(
schema => \@schema,
boolean => $boolean,
cyclic_refs => $cyclic ? 'allow' : 'fatal',
duplicate_keys => $duplicate_keys ? 1 : 0,
preserve => $preserve,
indent => $indent,
width => $width,
header => $header ? 1 : 0,
footer => $footer ? 1 : 0,
yaml_version => \@yaml_versions,
version_directive => $version_directive || 0,
require_footer => $require_footer,
);
if ($inc) {
$inc->yp($ypp);
}
my @docs = $file ? $ypp->load_file($file) : $ypp->load_string($yaml);
return \@docs;
}
sub yamlpp {
_yamlpp('YAML::PP' => @_);
}
sub yamlpp_dump {
_yamlpp_dump('YAML::PP' => @_);
}
sub yamlpplibyaml {
eval { require YAML::PP::LibYAML };
_yamlpp('YAML::PP::LibYAML' => @_);
}
sub yamlppref {
eval { require YAML::PP::Ref };
_yamlpp('YAML::PP::Ref' => @_);
}
sub yamlpplibyaml_dump {
eval { require YAML::PP::LibYAML };
_yamlpp_dump('YAML::PP::LibYAML' => @_);
}
sub _yamlpp_dump {
my ($class, $docs) = @_;
my $ypp = $class->new(
schema => \@schema,
boolean => $boolean,
preserve => $preserve,
indent => $indent,
width => $width,
header => $header ? 1 : 0,
footer => $footer ? 1 : 0,
yaml_version => \@yaml_versions,
version_directive => $version_directive || 0,
);
return $ypp->dump_string(@$docs);
}
sub yamlxs {
eval { require YAML::XS };
my ($yaml) = @_;
no warnings 'once';
local $YAML::XS::LoadBlessed = $perl;
my @docs = YAML::XS::Load($yaml);
return \@docs;
}
sub yamlxs_dump {
my ($docs) = @_;
eval { require YAML::XS };
no warnings 'once';
local $YAML::XS::Indent = $indent;
return YAML::XS::Dump(@$docs);
}
sub yamlsyck {
eval { require YAML::Syck };
my ($yaml) = @_;
no warnings 'once';
local $YAML::Syck::LoadBlessed = $perl;
local $YAML::Syck::ImplicitTyping = 1;
local $YAML::Syck::ImplicitUnicode = 1;
my @docs = YAML::Syck::Load($yaml);
return \@docs;
}
sub yamlsyck_dump {
eval { require YAML::Syck };
my ($docs) = @_;
no warnings 'once';
local $YAML::Syck::Headless = 1 unless $header;
local $YAML::Syck::ImplicitTyping = 1;
local $YAML::Syck::ImplicitUnicode = 1;
return YAML::Syck::Dump(@$docs);
}
sub yaml {
eval { require YAML };
no warnings 'once';
local $YAML::LoadBlessed = $perl;
my ($yaml) = @_;
my @docs = YAML::Load($yaml);
return \@docs;
}
sub yaml_dump {
my ($docs) = @_;
eval { require YAML };
no warnings 'once';
local $YAML::UseHeader = $header ? 1 : 0;
local $YAML::Indent = $indent;
return YAML::Dump(@$docs);
}
sub yamltiny {
eval { require YAML::Tiny };
my ($yaml) = @_;
my @docs = YAML::Tiny::Load($yaml);
return \@docs;
}
sub yamltiny_dump {
eval { require YAML::Tiny };
my ($docs) = @_;
return YAML::Tiny::Dump(@$docs);
}
sub data_dumper {
my ($docs) = @_;
local $Data::Dumper::Useqq = 1;
local $Data::Dumper::Sortkeys = 1 unless $preserve_order;
my $out = '';
$out .= Data::Dumper->Dump([$docs->[ $_ ]], ["doc$_"]) for 0 ..$#$docs;
return $out;
}
sub json_pp_dump { require JSON::PP; _json_dump('JSON::PP', @_) }
sub json_xs_dump { require JSON::XS; _json_dump('JSON::XS', @_) }
sub cpanel_json_xs_dump { require Cpanel::JSON::XS; _json_dump('Cpanel::JSON::XS', @_) }
sub _json_dump {
my ($class, $docs) = @_;
my $coder = $class->new->ascii->pretty->allow_nonref->space_before(0);
$coder = $coder->indent_length($indent) if $coder->can('indent_length');
$coder = $coder->canonical unless $preserve_order;
my $out = '';
$out .= $coder->encode($docs->[ $_ ]) for 0 ..$#$docs;
return $out;
}
if ($decode) {
print encode_utf8 $out_yaml;
}
else {
print $out_yaml;
}
sub usage {
my ($rc) = @_;
print <<"EOM";
Usage:
$0 [options] < file
$0 [options] file
Options:
--boolean= 'perl', 'JSON::PP', 'boolean'
--cyclic Allow cyclic references
--duplicate-keys Allow duplicate keys
--indent= Number of spaces for indentation
--width= Maximum column width (only used in flow style for now)
--[no-]header Print '---' (default)
--[no-]footer Print '...'
--merge Enable loading merge keys '<<'
--require-footer Require '...' and the end of each document
--perl Enable loading perl types and objects (use only
on trusted input!)
--preserve, -P Comma separated: 'order', 'scalar', 'flow', 'alias'.
Set to 0 to preserve nothing.
By default all things are preserved
--module -M YAML::PP (default), YAML, YAML::PP::LibYAML,
YAML::Syck, YAML::Tiny, YAML::XS, YAML::PP::Ref
--dump-module -D All of the above plus Data::Dumper, JSON::PP,
JSON::XS, Cpanel::JSON::XS
--yaml-version= '1.2' (default), '1.1', '1.2,1.1', '1.1,1.2'
--version-directive Print '%YAML '
--include Enable Include Schema
--include-absolute Allow absolute paths and ../../../ in includes (use
only on trusted input!)
EOM
# --catchall Ignore any unknown tags
exit $rc;
}
YAML-PP-v0.41.0/bin/PaxHeaders/yamlpp-highlight 0000644 0000000 0000000 00000000132 15214605475 016072 x ustar 00 30 mtime=1781730109.603126273
30 atime=1781730109.603037086
30 ctime=1781730109.603126273
YAML-PP-v0.41.0/bin/yamlpp-highlight 0000755 0001750 0001750 00000001757 15214605475 015541 0 ustar 00tina tina #!/usr/bin/perl
use strict;
use warnings;
use YAML::PP::Highlight;
use Encode;
use Getopt::Long;
GetOptions(
'help|h' => \my $help,
'expand-tabs|et!' => \my $expand_tabs,
) or usage(1);
$expand_tabs = 1 unless defined $expand_tabs;
usage(0) if $help;
my ($file) = @ARGV;
my $yaml;
unless ($file) {
$yaml = do { local $/; };
$yaml = decode_utf8($yaml);
}
my $error;
my $tokens;
if (defined $file) {
($error, $tokens) = YAML::PP::Parser->yaml_to_tokens( file => $file );
}
else {
($error, $tokens) = YAML::PP::Parser->yaml_to_tokens( string => $yaml );
}
my $highlighted = YAML::PP::Highlight->ansicolored($tokens, expand_tabs => $expand_tabs);
print encode_utf8 $highlighted;
if ($error) {
die $error;
}
sub usage {
my ($rc) = @_;
print <<"EOM";
Usage:
$0 [options] < file
$0 [options] file
Options:
--expand-tabs --et Expand tabs to 8 spaces (default true)
--no-expand-tabs --no-et Don't expand tabs
EOM
exit $rc;
}
YAML-PP-v0.41.0/bin/PaxHeaders/yamlpp-events 0000644 0000000 0000000 00000000131 15214605475 015426 x ustar 00 30 mtime=1781730109.598059406
29 atime=1781730109.59796931
30 ctime=1781730109.598059406
YAML-PP-v0.41.0/bin/yamlpp-events 0000755 0001750 0001750 00000002374 15214605475 015072 0 ustar 00tina tina #!/usr/bin/perl
use strict;
use warnings;
use Encode;
use YAML::PP::Parser;
use YAML::PP::Common;
use Getopt::Long;
Getopt::Long::Configure('bundling');
GetOptions(
'help|h' => \my $help,
'module|M=s' => \my $module,
) or usage(1);
usage(0) if $help;
$module ||= 'YAML::PP';
if ($module eq 'YAML::PP') {
$module = 'YAML::PP::Parser';
}
elsif ($module eq 'YAML::PP::LibYAML') {
require YAML::PP::LibYAML::Parser;
$module = 'YAML::PP::LibYAML::Parser';
}
elsif ($module eq 'YAML::PP::Ref') {
require YAML::PP::Ref;
$module = 'YAML::PP::Ref::Parser';
}
my ($file) = @ARGV;
my $parser = $module->new(
receiver => sub {
my ($self, undef, $event) = @_;
print encode_utf8(YAML::PP::Common::event_to_test_suite($event, { flow => 1 })), "\n";
},
$file ? (reader => YAML::PP::Reader::File->new) : (),
);
if ($file) {
$parser->parse_file($file);
}
else {
my $yaml;
$yaml = do { local $/; };
$yaml = decode_utf8($yaml);
$parser->parse_string($yaml);
}
sub usage {
my ($rc) = @_;
print <<"EOM";
Usage:
$0 [options] < file
$0 [options] file
Options:
--module -M Module to use for parsing. YAML::PP (default),
YAML::PP::LibYAML or YAML::PP::Ref
EOM
exit $rc;
}
YAML-PP-v0.41.0/bin/PaxHeaders/yamlpp-load 0000644 0000000 0000000 00000000132 15214605475 015042 x ustar 00 30 mtime=1781730109.594056855
30 atime=1781730109.593909489
30 ctime=1781730109.594056855
YAML-PP-v0.41.0/bin/yamlpp-load 0000755 0001750 0001750 00000007314 15214605475 014504 0 ustar 00tina tina #!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use YAML::PP;
use YAML::PP::Common qw/ PRESERVE_ORDER /;
use Encode;
use Getopt::Long;
Getopt::Long::Configure('bundling');
GetOptions(
'help|h' => \my $help,
'boolean=s' => \my $boolean,
'cyclic' => \my $cyclic,
'duplicate-keys' => \my $duplicate_keys,
'merge' => \my $merge,
#'catchall' => \my $catchall,
'require-footer' => \my $require_footer,
'perl' => \my $perl,
'module|M=s' => \my $module,
'yaml-version=s' => \my $yaml_version,
) or usage(1);
usage(0) if $help;
$module ||= 'YAML::PP';
$boolean ||= 'JSON::PP';
$yaml_version ||= 1.2;
my @yaml_versions = split m/,/, $yaml_version;
my @schema = ('+');
if ($merge) {
push @schema, 'Merge';
}
if ($perl) {
push @schema, 'Perl';
}
#if ($catchall) {
# push @schema, 'Catchall';
#}
my ($file) = @ARGV;
my $yaml;
my $decode = 1;
if ($module eq 'YAML::XS') {
$decode = 0;
}
if ($file) {
open my $fh, '<', $file or die "Can not open '$file'";
$yaml = do { local $/; <$fh> };
close $fh;
}
else {
$yaml = do { local $/; };
}
$yaml = decode_utf8($yaml) if $decode;
my %codes = (
'YAML::PP' => \&yamlpp,
'YAML::PP::LibYAML' => \&yamlpplibyaml,
'YAML::PP::Ref' => \&yamlppref,
'YAML::XS' => \&yamlxs,
'YAML::Tiny' => \&yamltiny,
'YAML::Syck' => \&yamlsyck,
'YAML' => \&yaml,
);
my $code = $codes{ $module } or die "Module '$module' not supported";
my @docs = $code->($yaml);
sub _yamlpp {
my ($class, $yaml) = @_;
my $ypp = $class->new(
schema => \@schema,
boolean => $boolean,
cyclic_refs => $cyclic ? 'allow' : 'fatal',
duplicate_keys => $duplicate_keys ? 1 : 0,
preserve => PRESERVE_ORDER,
yaml_version => \@yaml_versions,
require_footer => $require_footer,
);
my @docs = $ypp->load_string($yaml);
return @docs;
}
sub yamlpp {
_yamlpp('YAML::PP' => $_[0]);
}
sub yamlpplibyaml {
eval { require YAML::PP::LibYAML };
_yamlpp('YAML::PP::LibYAML' => $_[0]);
}
sub yamlppref {
eval { require YAML::PP::Ref };
_yamlpp('YAML::PP::Ref' => $_[0]);
}
sub yamlxs {
eval { require YAML::XS };
my ($yaml) = @_;
no warnings 'once';
local $YAML::XS::LoadBlessed = $perl;
return YAML::XS::Load($yaml);
}
sub yamlsyck {
eval { require YAML::Syck };
my ($yaml) = @_;
no warnings 'once';
local $YAML::Syck::LoadBlessed = $perl;
local $YAML::Syck::ImplicitTyping = 1;
local $YAML::Syck::ImplicitUnicode = 1;
return YAML::Syck::Load($yaml);
}
sub yaml {
eval { require YAML };
my ($yaml) = @_;
no warnings 'once';
local $YAML::LoadBlessed = $perl;
return YAML::Load($yaml);
}
sub yamltiny {
eval { require YAML::Tiny };
my ($yaml) = @_;
return YAML::Tiny::Load($yaml);
}
local $Data::Dumper::Useqq = 1;
local $Data::Dumper::Sortkeys = 1;
print Data::Dumper->Dump([$docs[ $_ ]], ["doc$_"]) for 0 ..$#docs;
sub usage {
my ($rc) = @_;
print <<"EOM";
Usage:
$0 [options] < file
$0 [options] file
Options:
--boolean= 'perl', 'JSON::PP', 'boolean'
--cyclic Allow cyclic references
--duplicate-keys Allow duplicate keys
--merge Enable loading merge keys '<<'
--require-footer Require '...' and the end of each document
--perl Enable loading perl types and objects (use only
on trusted input!)
--module -M YAML::PP (default), YAML, YAML::PP::LibYAML,
YAML::Syck, YAML::Tiny, YAML::XS, YAML::PP::Ref
--yaml-version= '1.2' (default), '1.1', '1.2,1.1', '1.1,1.2'
EOM
#--catchall Ignore any unknown tags
exit $rc;
}
YAML-PP-v0.41.0/PaxHeaders/CONTRIBUTING.md 0000644 0000000 0000000 00000000132 15214605475 014361 x ustar 00 30 mtime=1781730109.593717704
30 atime=1781730109.593613081
30 ctime=1781730109.593717704
YAML-PP-v0.41.0/CONTRIBUTING.md 0000644 0001750 0001750 00000002636 15214605475 014022 0 ustar 00tina tina # How to contribute
This module uses Dist::Zilla for creating releases, but you should
be able to develop and test it without Dist::Zilla.
## Commits
I try to follow these guidelines:
* Git commits
* Short commit message headline (if possible, up to 60 characters)
* Blank line before message body
* Message should be like: "Add foo ...", "Fix ..."
* If you need to do formatting changes like indentation, put them
into their own commit
* Git workflow
* Rebase every branch before merging it with --no-ff. Rebasing your
pull request to current master helps me merging it.
* No merging master into branches - try to rebase always
* User branches might be heavily rebased/reordered/squashed because
I like a clean history
## Code
* No Tabs please
* No trailing whitespace please
* 4 spaces indentation
* Look at existing code for formatting ;-)
## Testing
prove -lr t
To include the tests from the yaml-test-suite, checkout the test-suite
branch like this:
git branch test-suite --track origin/test-suite
git worktree add test-suite test-suite
There is also a Makefile.dev and a utility script dev.sh
source dev.sh
dmake testp # parallel testing
You can check test coverage with
make -f Makefile.dev cover
# or
dmake cover
## Contact
Email: tinita at cpan.org
IRC: tinita on freenode and irc.perl.org
Chances are good that contacting me on IRC is the fastest way.
YAML-PP-v0.41.0/PaxHeaders/lib 0000644 0000000 0000000 00000000132 15214605475 012621 x ustar 00 30 mtime=1781730109.593554484
30 atime=1781730109.593369683
30 ctime=1781730109.593554484
YAML-PP-v0.41.0/lib/ 0000755 0001750 0001750 00000000000 15214605475 012330 5 ustar 00tina tina YAML-PP-v0.41.0/lib/PaxHeaders/YAML 0000644 0000000 0000000 00000000132 15214605475 013363 x ustar 00 30 mtime=1781730109.600170997
30 atime=1781730109.593369683
30 ctime=1781730109.600170997
YAML-PP-v0.41.0/lib/YAML/ 0000755 0001750 0001750 00000000000 15214605475 013072 5 ustar 00tina tina YAML-PP-v0.41.0/lib/YAML/PaxHeaders/PP 0000644 0000000 0000000 00000000132 15214605475 013702 x ustar 00 30 mtime=1781730109.611841945
30 atime=1781730109.600170997
30 ctime=1781730109.611841945
YAML-PP-v0.41.0/lib/YAML/PP/ 0000755 0001750 0001750 00000000000 15214605475 013411 5 ustar 00tina tina YAML-PP-v0.41.0/lib/YAML/PP/PaxHeaders/Type 0000644 0000000 0000000 00000000132 15214605475 014623 x ustar 00 30 mtime=1781730109.611841945
30 atime=1781730109.611841945
30 ctime=1781730109.611841945
YAML-PP-v0.41.0/lib/YAML/PP/Type/ 0000755 0001750 0001750 00000000000 15214605475 014332 5 ustar 00tina tina YAML-PP-v0.41.0/lib/YAML/PP/Type/PaxHeaders/MergeKey.pm 0000644 0000000 0000000 00000000132 15214605475 016746 x ustar 00 30 mtime=1781730109.612011311
30 atime=1781730109.611841945
30 ctime=1781730109.612011311
YAML-PP-v0.41.0/lib/YAML/PP/Type/MergeKey.pm 0000644 0001750 0001750 00000000603 15214605475 016377 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Type::MergeKey;
our $VERSION = 'v0.41.0'; # VERSION
sub new {
my ($class) = @_;
return bless {}, $class;
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Type::MergeKey - A special node type for merge keys
=head1 DESCRIPTION
See L
=head1 METHODS
=over
=item new
Constructor
=back
=cut
YAML-PP-v0.41.0/lib/YAML/PP/PaxHeaders/Schema 0000644 0000000 0000000 00000000132 15214605475 015102 x ustar 00 30 mtime=1781730109.613081214
30 atime=1781730109.610868982
30 ctime=1781730109.613081214
YAML-PP-v0.41.0/lib/YAML/PP/Schema/ 0000755 0001750 0001750 00000000000 15214605475 014611 5 ustar 00tina tina YAML-PP-v0.41.0/lib/YAML/PP/Schema/PaxHeaders/Tie 0000644 0000000 0000000 00000000132 15214605475 015623 x ustar 00 30 mtime=1781730109.613081214
30 atime=1781730109.613081214
30 ctime=1781730109.613081214
YAML-PP-v0.41.0/lib/YAML/PP/Schema/Tie/ 0000755 0001750 0001750 00000000000 15214605475 015332 5 ustar 00tina tina YAML-PP-v0.41.0/lib/YAML/PP/Schema/Tie/PaxHeaders/IxHash.pm 0000644 0000000 0000000 00000000132 15214605475 017422 x ustar 00 30 mtime=1781730109.613230884
30 atime=1781730109.613081214
30 ctime=1781730109.613230884
YAML-PP-v0.41.0/lib/YAML/PP/Schema/Tie/IxHash.pm 0000644 0001750 0001750 00000004632 15214605475 017061 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::Tie::IxHash;
our $VERSION = 'v0.41.0'; # VERSION
use base 'YAML::PP::Schema';
use Scalar::Util qw/ blessed reftype /;
my $ixhash = eval { require Tie::IxHash };
sub register {
my ($self, %args) = @_;
my $schema = $args{schema};
unless ($ixhash) {
die "You need to install Tie::IxHash in order to use this module";
}
$schema->add_representer(
tied_equals => 'Tie::IxHash',
code => sub {
my ($rep, $node) = @_;
$node->{items} = [ %{ $node->{data} } ];
return 1;
},
);
return;
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Schema::Tie::IxHash - (Deprecated) Schema for serializing ordered hashes
=head1 SYNOPSIS
use YAML::PP;
use Tie::IxHash;
my $yp = YAML::PP->new( schema => [qw/ + Tie::IxHash /] );
tie(my %ordered, 'Tie::IxHash');
%ordered = (
U => 2,
B => 52,
);
my $yaml = $yp->dump_string(\%ordered);
# Output:
---
U: 2
B: 52
=head1 DESCRIPTION
This is deprecated. See the new option C in L.
This schema allows you to dump ordered hashes which are tied to
L.
This code is pretty new and experimental.
It is not yet implemented for loading yet, so for now you have to tie
the hashes yourself.
Examples:
=cut
### BEGIN EXAMPLE
=pod
=over 4
=item order
# Code
tie(my %order, 'Tie::IxHash');
%order = (
U => 2,
B => 52,
c => 64,
19 => 84,
Disco => 2000,
Year => 2525,
days_on_earth => 20_000,
);
\%order;
# YAML
---
U: 2
B: 52
c: 64
19: 84
Disco: 2000
Year: 2525
days_on_earth: 20000
=item order_blessed
# Code
tie(my %order, 'Tie::IxHash');
%order = (
U => 2,
B => 52,
c => 64,
19 => 84,
Disco => 2000,
Year => 2525,
days_on_earth => 20_000,
);
bless \%order, 'Order';
# YAML
--- !perl/hash:Order
U: 2
B: 52
c: 64
19: 84
Disco: 2000
Year: 2525
days_on_earth: 20000
=back
=cut
### END EXAMPLE
=head1 METHODS
=over
=item register
Called by YAML::PP::Schema
=back
=cut
YAML-PP-v0.41.0/lib/YAML/PP/Schema/PaxHeaders/Catchall.pm 0000644 0000000 0000000 00000000132 15214605475 017230 x ustar 00 30 mtime=1781730109.612986229
30 atime=1781730109.612886076
30 ctime=1781730109.612986229
YAML-PP-v0.41.0/lib/YAML/PP/Schema/Catchall.pm 0000644 0001750 0001750 00000003155 15214605475 016666 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::Catchall;
our $VERSION = 'v0.41.0'; # VERSION
use Carp qw/ croak /;
use YAML::PP::Common qw/ YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE /;
sub register {
my ($self, %args) = @_;
my $schema = $args{schema};
my $options = $args{options};
my $empty_null = 0;
for my $opt (@$options) {
if ($opt eq 'empty=str') {
}
elsif ($opt eq 'empty=null') {
$empty_null = 1;
}
else {
croak "Invalid option for JSON Schema: '$opt'";
}
}
$schema->add_resolver(
tag => qr{^(?:!|tag:)},
match => [ all => sub {
my ($constructor, $event) = @_;
my $value = $event->{value};
return $value;
}],
implicit => 0,
);
$schema->add_sequence_resolver(
tag => qr{^(?:!|tag:)},
on_data => sub {
my ($constructor, $ref, $list) = @_;
push @$$ref, @$list;
},
);
$schema->add_mapping_resolver(
tag => qr{^(?:!|tag:)},
on_data => sub {
my ($constructor, $ref, $list) = @_;
for (my $i = 0; $i < @$list; $i += 2) {
$$ref->{ $list->[ $i ] } = $list->[ $i + 1 ];
}
},
);
return;
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Schema::JSON - YAML 1.2 JSON Schema
=head1 SYNOPSIS
my $yp = YAML::PP->new( schema => ['JSON'] );
my $yp = YAML::PP->new( schema => [qw/ JSON empty=str /] );
my $yp = YAML::PP->new( schema => [qw/ JSON empty=null /] );
=head1 DESCRIPTION
=cut
YAML-PP-v0.41.0/lib/YAML/PP/Schema/PaxHeaders/Failsafe.pm 0000644 0000000 0000000 00000000132 15214605475 017227 x ustar 00 30 mtime=1781730109.612886076
30 atime=1781730109.612778939
30 ctime=1781730109.612886076
YAML-PP-v0.41.0/lib/YAML/PP/Schema/Failsafe.pm 0000644 0001750 0001750 00000002566 15214605475 016672 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::Failsafe;
our $VERSION = 'v0.41.0'; # VERSION
sub register {
my ($self, %args) = @_;
my $schema = $args{schema};
$schema->add_resolver(
tag => 'tag:yaml.org,2002:str',
match => [ all => sub { $_[1]->{value} } ],
);
$schema->add_sequence_resolver(
tag => 'tag:yaml.org,2002:seq',
on_data => sub {
my ($constructor, $ref, $list) = @_;
push @$$ref, @$list;
},
);
$schema->add_mapping_resolver(
tag => 'tag:yaml.org,2002:map',
on_data => sub {
my ($constructor, $ref, $list) = @_;
for (my $i = 0; $i < @$list; $i += 2) {
$$ref->{ $list->[ $i ] } = $list->[ $i + 1 ];
}
},
);
return;
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Schema::Failsafe - YAML 1.2 Failsafe Schema
=head1 SYNOPSIS
my $yp = YAML::PP->new( schema => ['Failsafe'] );
=head1 DESCRIPTION
With this schema, everything will be treated as a string. There are no booleans,
integers, floats or undefined values.
Here you can see all Schemas and examples implemented by YAML::PP:
L
Official Schema: L
=head1 METHODS
=over
=item register
Called by YAML::PP::Schema
=back
=cut
YAML-PP-v0.41.0/lib/YAML/PP/Schema/PaxHeaders/Include.pm 0000644 0000000 0000000 00000000132 15214605475 017100 x ustar 00 30 mtime=1781730109.612683676
30 atime=1781730109.612586386
30 ctime=1781730109.612683676
YAML-PP-v0.41.0/lib/YAML/PP/Schema/Include.pm 0000644 0001750 0001750 00000014536 15214605475 016543 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::Include;
our $VERSION = 'v0.41.0'; # VERSION
use Carp qw/ croak /;
use Scalar::Util qw/ weaken /;
use File::Basename qw/ dirname /;
sub new {
my ($class, %args) = @_;
my $paths = delete $args{paths};
if (defined $paths) {
unless (ref $paths eq 'ARRAY') {
$paths = [$paths];
}
}
else {
$paths = [];
}
my $allow_absolute = $args{allow_absolute} || 0;
my $loader = $args{loader} || \&default_loader;
my $self = bless {
paths => $paths,
allow_absolute => $allow_absolute,
last_includes => [],
cached => {},
loader => $loader,
}, $class;
return $self;
}
sub init {
my ($self) = @_;
$self->{last_includes} = [];
$self->{cached} = [];
}
sub paths { $_[0]->{paths} }
sub allow_absolute { $_[0]->{allow_absolute} }
sub yp {
my ($self, $yp) = @_;
if (@_ == 2) {
$self->{yp} = $yp;
weaken $self->{yp};
return $yp;
}
return $self->{yp};
}
sub register {
my ($self, %args) = @_;
my $schema = $args{schema};
$schema->add_resolver(
tag => '!include',
match => [ all => sub { $self->include(@_) } ],
implicit => 0,
);
}
sub include {
my ($self, $constructor, $event) = @_;
my $yp = $self->yp;
my $search_paths = $self->paths;
my $allow_absolute = $self->allow_absolute;
my $relative = not @$search_paths;
if ($relative) {
my $last_includes = $self->{last_includes};
if (@$last_includes) {
$search_paths = [ $last_includes->[-1] ];
}
else {
# we are in the top-level file and need to look into
# the original YAML::PP instance
my $filename = $yp->loader->filename;
$search_paths = [dirname $filename];
}
}
my $filename = $event->{value};
my $fullpath;
if (File::Spec->file_name_is_absolute($filename)) {
unless ($allow_absolute) {
croak "Absolute filenames not allowed";
}
$fullpath = $filename;
}
else {
my @paths = File::Spec->splitdir($filename);
unless ($allow_absolute) {
# if absolute paths are not allowed, we also may not use upwards ..
@paths = File::Spec->no_upwards(@paths);
}
for my $candidate (@$search_paths) {
my $test = File::Spec->catfile( $candidate, @paths );
if (-e $test) {
$fullpath = $test;
last;
}
}
croak "File '$filename' not found" unless defined $fullpath;
}
if ($self->{cached}->{ $fullpath }++) {
croak "Circular include '$fullpath'";
}
if ($relative) {
push @{ $self->{last_includes} }, dirname $fullpath;
}
# We need a new object because we are still in the parsing and
# constructing process
my $clone = $yp->clone;
my ($data) = $self->loader->($clone, $fullpath);
if ($relative) {
pop @{ $self->{last_includes} };
}
unless (--$self->{cached}->{ $fullpath }) {
delete $self->{cached}->{ $fullpath };
}
return $data;
}
sub loader {
my ($self, $code) = @_;
if (@_ == 2) {
$self->{loader} = $code;
return $code;
}
return $self->{loader};
}
sub default_loader {
my ($yp, $filename) = @_;
$yp->load_file($filename);
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Schema::Include - Include YAML files
=head1 SYNOPSIS
# /path/to/file.yaml
# ---
# included: !include include/file2.yaml
# /path/to/include/file2.yaml
# ---
# a: b
my $include = YAML::PP::Schema::Include->new;
my $yp = YAML::PP->new( schema => ['+', $include] );
# we need the original YAML::PP object for getting the current filename
# and for loading another file
$include->yp($yp);
my ($data) = $yp->load_file("/path/to/file.yaml");
# The result will be:
$data = {
included => { a => 'b' }
};
Allow absolute filenames and upwards C<'..'>:
my $include = YAML::PP::Schema::Include->new(
allow_absolute => 1, # default: 0
);
Specify paths to search for includes:
my @include_paths = ("/path/to/include/yaml/1", "/path/to/include/yaml/2");
my $include = YAML::PP::Schema::Include->new(
paths => \@include_paths,
);
my $yp = YAML::PP->new( schema => ['+', $include] );
$include->yp($yp);
# /path/to/include/yaml/1/file1.yaml
# ---
# a: b
my $yaml = <<'EOM';
- included: !include file1.yaml
EOM
my ($data) = $yp->load_string($yaml);
=head1 DESCRIPTION
This plugin allows you to split a large YAML file into smaller ones.
You can then include these files with the C tag.
It will search for the specified filename relative to the currently processed
filename.
You can also specify the paths where to search for files to include. It iterates
through the paths and returns the first filename that exists.
By default, only relative paths are allowed. Any C<../> in the path will be
removed. You can change that behaviour by setting the option C
to true.
If the included file contains more than one document, only the first one
will be included.
I will probably add a possibility to return all documents as an arrayref.
The included YAML file will be loaded by creating a new L object
with the schema from the existing object. This way you can recursively include
files.
You can even reuse the same include via an alias:
---
invoice:
shipping address: &address !include address.yaml
billing address: *address
Circular includes will be detected, and will be fatal.
It's possible to specify what to do with the included file:
my $include = YAML::PP::Schema::Include->new(
loader => sub {
my ($yp, $filename);
if ($filename =~ m/\.txt$/) {
# open file and just return text
}
else {
# default behaviour
return $yp->load_file($filename);
}
},
);
For example, RAML defines an C tag which depends on the file
content. If it contains a special RAML directive, it will be loaded as
YAML, otherwise the content of the file will be included as a string.
So with this plugin you are able to read RAML specifications.
=cut
YAML-PP-v0.41.0/lib/YAML/PP/Schema/PaxHeaders/YAML1_1.pm 0000644 0000000 0000000 00000000130 15214605475 016556 x ustar 00 30 mtime=1781730109.612586386
28 atime=1781730109.6124921
30 ctime=1781730109.612586386
YAML-PP-v0.41.0/lib/YAML/PP/Schema/YAML1_1.pm 0000644 0001750 0001750 00000015225 15214605475 016217 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::YAML1_1;
our $VERSION = 'v0.41.0'; # VERSION
use YAML::PP::Schema::JSON qw/
represent_int represent_float represent_literal represent_bool
represent_undef
/;
use YAML::PP::Common qw/ YAML_PLAIN_SCALAR_STYLE /;
#https://yaml.org/type/bool.html
# y|Y|yes|Yes|YES|n|N|no|No|NO
# |true|True|TRUE|false|False|FALSE
# |on|On|ON|off|Off|OFF
# https://yaml.org/type/float.html
# [-+]?([0-9][0-9_]*)?\.[0-9.]*([eE][-+][0-9]+)? (base 10)
# |[-+]?[0-9][0-9_]*(:[0-5]?[0-9])+\.[0-9_]* (base 60)
# |[-+]?\.(inf|Inf|INF) # (infinity)
# |\.(nan|NaN|NAN) # (not a number)
# https://yaml.org/type/int.html
# [-+]?0b[0-1_]+ # (base 2)
# |[-+]?0[0-7_]+ # (base 8)
# |[-+]?(0|[1-9][0-9_]*) # (base 10)
# |[-+]?0x[0-9a-fA-F_]+ # (base 16)
# |[-+]?[1-9][0-9_]*(:[0-5]?[0-9])+ # (base 60)
# https://yaml.org/type/null.html
# ~ # (canonical)
# |null|Null|NULL # (English)
# | # (Empty)
my $RE_INT_1_1 = qr{^([+-]?(?:0|[1-9][0-9_]*))$};
#my $RE_FLOAT_1_1 = qr{^([+-]?([0-9][0-9_]*)?\.[0-9.]*([eE][+-][0-9]+)?)$};
# https://yaml.org/type/float.html has a bug. The regex says \.[0-9.], but
# probably means \.[0-9_]
my $RE_FLOAT_1_1 = qr{^([+-]?(?:[0-9][0-9_]*)?\.[0-9_]*(?:[eE][+-][0-9]+)?)$};
my $RE_SEXAGESIMAL = qr{^([+-]?[0-9][0-9_]*(:[0-5]?[0-9])+\.[0-9_]*)$};
my $RE_SEXAGESIMAL_INT = qr{^([-+]?[1-9][0-9_]*(:[0-5]?[0-9])+)$};
my $RE_INT_OCTAL_1_1 = qr{^([+-]?)0([0-7_]+)$};
my $RE_INT_HEX_1_1 = qr{^([+-]?)(0x[0-9a-fA-F_]+)$};
my $RE_INT_BIN_1_1 = qr{^([-+]?)(0b[0-1_]+)$};
sub _from_oct {
my ($constructor, $event, $matches) = @_;
my ($sign, $oct) = @$matches;
$oct =~ tr/_//d;
my $result = oct $oct;
$result = -$result if $sign eq '-';
return $result;
}
sub _from_hex {
my ($constructor, $event, $matches) = @_;
my ($sign, $hex) = @$matches;
my $result = hex $hex;
$result = -$result if $sign eq '-';
return $result;
}
sub _sexa_to_float {
my ($constructor, $event, $matches) = @_;
my ($float) = @$matches;
my $result = 0;
my $i = 0;
my $sign = 1;
$float =~ s/^-// and $sign = -1;
for my $part (reverse split m/:/, $float) {
$result += $part * ( 60 ** $i );
$i++;
}
$result = unpack F => pack F => $result;
return $result * $sign;
}
sub _to_float {
my ($constructor, $event, $matches) = @_;
my ($float) = @$matches;
$float =~ tr/_//d;
$float = unpack F => pack F => $float;
return $float;
}
sub _to_int {
my ($constructor, $event, $matches) = @_;
my ($int) = @$matches;
$int =~ tr/_//d;
0 + $int;
}
sub register {
my ($self, %args) = @_;
my $schema = $args{schema};
$schema->add_resolver(
tag => 'tag:yaml.org,2002:null',
match => [ equals => $_ => undef ],
) for (qw/ null NULL Null ~ /, '');
$schema->add_resolver(
tag => 'tag:yaml.org,2002:bool',
match => [ equals => $_ => $schema->true ],
) for (qw/ true TRUE True y Y yes Yes YES on On ON /);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:bool',
match => [ equals => $_ => $schema->false ],
) for (qw/ false FALSE False n N no No NO off Off OFF /);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:int',
match => [ regex => $RE_INT_OCTAL_1_1 => \&_from_oct ],
);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:int',
match => [ regex => $RE_INT_1_1 => \&_to_int ],
);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:int',
match => [ regex => $RE_INT_HEX_1_1 => \&_from_hex ],
);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:float',
match => [ regex => $RE_FLOAT_1_1 => \&_to_float ],
);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:int',
match => [ regex => $RE_INT_BIN_1_1 => \&_from_oct ],
);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:int',
match => [ regex => $RE_SEXAGESIMAL_INT => \&_sexa_to_float ],
);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:float',
match => [ regex => $RE_SEXAGESIMAL => \&_sexa_to_float ],
);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:float',
match => [ equals => $_ => 0 + "inf" ],
) for (qw/ .inf .Inf .INF +.inf +.Inf +.INF /);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:float',
match => [ equals => $_ => 0 - "inf" ],
) for (qw/ -.inf -.Inf -.INF /);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:float',
match => [ equals => $_ => 0 + "nan" ],
) for (qw/ .nan .NaN .NAN /);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:str',
match => [ all => sub { $_[1]->{value} } ],
implicit => 0,
);
my $int_flags = B::SVp_IOK;
my $float_flags = B::SVp_NOK;
$schema->add_representer(
flags => $int_flags,
code => \&represent_int,
);
$schema->add_representer(
flags => $float_flags,
code => \&represent_float,
);
$schema->add_representer(
undefined => \&represent_undef,
);
$schema->add_representer(
equals => $_,
code => \&represent_literal,
) for ("", qw/
true TRUE True y Y yes Yes YES on On ON
false FALSE False n N n no No NO off Off OFF
null NULL Null ~
.inf .Inf .INF -.inf -.Inf -.INF +.inf +.Inf +.INF .nan .NaN .NAN
/);
$schema->add_representer(
regex => qr{$RE_INT_1_1|$RE_FLOAT_1_1|$RE_INT_OCTAL_1_1|$RE_INT_HEX_1_1|$RE_INT_BIN_1_1|$RE_SEXAGESIMAL_INT|$RE_SEXAGESIMAL},
code => \&represent_literal,
);
if ($schema->bool_class) {
for my $class (@{ $schema->bool_class }) {
if ($class eq 'perl') {
$schema->add_representer(
bool => 1,
code => \&represent_bool,
);
next;
}
$schema->add_representer(
class_equals => $class,
code => \&represent_bool,
);
}
}
return;
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Schema::YAML1_1 - YAML 1.1 Schema for YAML::PP
=head1 SYNOPSIS
use YAML::PP;
my $yp = YAML::PP->new( schema => ['YAML1_1'] );
my $yaml = <<'EOM';
---
booltrue: [ true, True, TRUE, y, Y, yes, Yes, YES, on, On, ON ]
EOM
my $data = $yp->load_string($yaml);
=head1 DESCRIPTION
This schema allows you to load the common YAML Types from YAML 1.1.
=head1 METHODS
=over
=item register
Called by YAML::PP::Schema
=back
=head1 SEE ALSO
=over
=item L
=item L
=item L
=item L
=back
YAML-PP-v0.41.0/lib/YAML/PP/Schema/PaxHeaders/Binary.pm 0000644 0000000 0000000 00000000132 15214605475 016741 x ustar 00 30 mtime=1781730109.612109019
30 atime=1781730109.612011311
30 ctime=1781730109.612109019
YAML-PP-v0.41.0/lib/YAML/PP/Schema/Binary.pm 0000644 0001750 0001750 00000005036 15214605475 016377 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::Binary;
our $VERSION = 'v0.41.0'; # VERSION
use MIME::Base64 qw/ decode_base64 encode_base64 /;
use YAML::PP::Common qw/ YAML_ANY_SCALAR_STYLE /;
sub register {
my ($self, %args) = @_;
my $schema = $args{schema};
$schema->add_resolver(
tag => 'tag:yaml.org,2002:binary',
match => [ all => sub {
my ($constructor, $event) = @_;
my $base64 = $event->{value};
my $binary = decode_base64($base64);
return $binary;
}],
implicit => 0,
);
$schema->add_representer(
regex => qr{.*},
code => sub {
my ($rep, $node) = @_;
my $binary = $node->{value};
unless ($binary =~ m/[\x{7F}-\x{10FFFF}]/) {
# ASCII
return;
}
if (utf8::is_utf8($binary)) {
# utf8
return;
}
# everything else must be base64 encoded
my $base64 = encode_base64($binary);
$node->{style} = YAML_ANY_SCALAR_STYLE;
$node->{data} = $base64;
$node->{tag} = "tag:yaml.org,2002:binary";
return 1;
},
);
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Schema::Binary - Schema for loading and binary data
=head1 SYNOPSIS
use YAML::PP;
my $yp = YAML::PP->new( schema => [qw/ + Binary /] );
# or
my ($binary, $same_binary) = $yp->load_string(<<'EOM');
--- !!binary "\
R0lGODlhDAAMAIQAAP//9/X17unp5WZmZgAAAOfn515eXvPz7Y6OjuDg4J+fn5\
OTk6enp56enmlpaWNjY6Ojo4SEhP/++f/++f/++f/++f/++f/++f/++f/++f/+\
+f/++f/++f/++f/++f/++SH+Dk1hZGUgd2l0aCBHSU1QACwAAAAADAAMAAAFLC\
AgjoEwnuNAFOhpEMTRiggcz4BNJHrv/zCFcLiwMWYNG84BwwEeECcgggoBADs="
--- !!binary |
R0lGODlhDAAMAIQAAP//9/X17unp5WZmZgAAAOfn515eXvPz7Y6OjuDg4J+fn5
OTk6enp56enmlpaWNjY6Ojo4SEhP/++f/++f/++f/++f/++f/++f/++f/++f/+
+f/++f/++f/++f/++f/++SH+Dk1hZGUgd2l0aCBHSU1QACwAAAAADAAMAAAFLC
AgjoEwnuNAFOhpEMTRiggcz4BNJHrv/zCFcLiwMWYNG84BwwEeECcgggoBADs=
# The binary value above is a tiny arrow encoded as a gif image.
EOM
=head1 DESCRIPTION
See
By prepending a base64 encoded binary string with the C tag, it can
be automatically decoded when loading.
Note that the logic for dumping is probably broken, see
L.
Suggestions welcome.
=head1 METHODS
=over
=item register
Called by L
=back
=cut
YAML-PP-v0.41.0/lib/YAML/PP/Schema/PaxHeaders/Merge.pm 0000644 0000000 0000000 00000000132 15214605475 016554 x ustar 00 30 mtime=1781730109.611453835
30 atime=1781730109.611368838
30 ctime=1781730109.611453835
YAML-PP-v0.41.0/lib/YAML/PP/Schema/Merge.pm 0000644 0001750 0001750 00000004674 15214605475 016221 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::Merge;
our $VERSION = 'v0.41.0'; # VERSION
use YAML::PP::Type::MergeKey;
sub register {
my ($self, %args) = @_;
my $schema = $args{schema};
$schema->add_resolver(
tag => 'tag:yaml.org,2002:merge',
match => [ equals => '<<' => YAML::PP::Type::MergeKey->new ],
);
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Schema::Merge - Enabling YAML merge keys for mappings
=head1 SYNOPSIS
use YAML::PP;
my $yp = YAML::PP->new( schema => [qw/ + Merge /] );
my $yaml = <<'EOM';
---
- &CENTER { x: 1, y: 2 }
- &LEFT { x: 0, y: 2 }
- &BIG { r: 10 }
- &SMALL { r: 1 }
# All the following maps are equal:
- # Explicit keys
x: 1
y: 2
r: 10
label: center/big
- # Merge one map
<< : *CENTER
r: 10
label: center/big
- # Merge multiple maps
<< : [ *CENTER, *BIG ]
label: center/big
- # Override
<< : [ *BIG, *LEFT, *SMALL ]
x: 1
label: center/big
EOM
my $data = $yp->load_string($yaml);
# $data->[4] == $data->[5] == $data->[6] == $data->[7]
=head1 DESCRIPTION
See L for the specification.
Quote:
"Specify one or more mappings to be merged with the current one.
The C<< << >> merge key is used to indicate that all the keys of one or more
specified maps should be inserted into the current map. If the value associated
with the key is a single mapping node, each of its key/value pairs is inserted
into the current mapping, unless the key already exists in it. If the value
associated with the merge key is a sequence, then this sequence is expected to
contain mapping nodes and each of these nodes is merged in turn according to its
order in the sequence. Keys in mapping nodes earlier in the sequence override
keys specified in later mapping nodes."
The implementation of this in a generic way is not trivial, because we also
have to handle duplicate keys, and YAML::PP allows you to write your own
handler for processing mappings.
So the inner API of that is not stable at this point.
Note that if you enable this schema, a plain scalar `<<` will be seen as
special anywhere in your document, so if you want a literal `<<`, you have
to put it in quotes.
Note that the performed merge is not a "deep merge". Only top-level keys are
merged.
=head1 METHODS
=over
=item register
Called by YAML::PP::Schema
=back
=cut
YAML-PP-v0.41.0/lib/YAML/PP/Schema/PaxHeaders/Core.pm 0000644 0000000 0000000 00000000132 15214605475 016405 x ustar 00 30 mtime=1781730109.611232088
30 atime=1781730109.611128513
30 ctime=1781730109.611232088
YAML-PP-v0.41.0/lib/YAML/PP/Schema/Core.pm 0000644 0001750 0001750 00000010027 15214605475 016037 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::Core;
our $VERSION = 'v0.41.0'; # VERSION
use YAML::PP::Schema::JSON qw/
represent_int represent_float represent_literal represent_bool
represent_undef
/;
use B;
use YAML::PP::Common qw/ YAML_PLAIN_SCALAR_STYLE /;
my $RE_INT_CORE = qr{^([+-]?(?:[0-9]+))$};
my $RE_FLOAT_CORE = qr{^([+-]?(?:\.[0-9]+|[0-9]+(?:\.[0-9]*)?)(?:[eE][+-]?[0-9]+)?)$};
my $RE_INT_OCTAL = qr{^0o([0-7]+)$};
my $RE_INT_HEX = qr{^0x([0-9a-fA-F]+)$};
sub _from_oct { oct $_[2]->[0] }
sub _from_hex { hex $_[2]->[0] }
sub register {
my ($self, %args) = @_;
my $schema = $args{schema};
$schema->add_resolver(
tag => 'tag:yaml.org,2002:null',
match => [ equals => $_ => undef ],
) for (qw/ null NULL Null ~ /, '');
$schema->add_resolver(
tag => 'tag:yaml.org,2002:bool',
match => [ equals => $_ => $schema->true ],
) for (qw/ true TRUE True /);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:bool',
match => [ equals => $_ => $schema->false ],
) for (qw/ false FALSE False /);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:int',
match => [ regex => $RE_INT_CORE => \&YAML::PP::Schema::JSON::_to_int ],
);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:int',
match => [ regex => $RE_INT_OCTAL => \&_from_oct ],
);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:int',
match => [ regex => $RE_INT_HEX => \&_from_hex ],
);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:float',
match => [ regex => $RE_FLOAT_CORE => \&YAML::PP::Schema::JSON::_to_float ],
);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:float',
match => [ equals => $_ => 0 + "inf" ],
) for (qw/ .inf .Inf .INF +.inf +.Inf +.INF /);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:float',
match => [ equals => $_ => 0 - "inf" ],
) for (qw/ -.inf -.Inf -.INF /);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:float',
match => [ equals => $_ => 0 + "nan" ],
) for (qw/ .nan .NaN .NAN /);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:str',
match => [ all => sub { $_[1]->{value} } ],
);
my $int_flags = B::SVp_IOK;
my $float_flags = B::SVp_NOK;
$schema->add_representer(
flags => $int_flags,
code => \&represent_int,
);
$schema->add_representer(
flags => $float_flags,
code => \&represent_float,
);
$schema->add_representer(
undefined => \&represent_undef,
);
$schema->add_representer(
equals => $_,
code => \&represent_literal,
) for ("", qw/
true TRUE True false FALSE False null NULL Null ~
.inf .Inf .INF +.inf +.Inf +.INF -.inf -.Inf -.INF .nan .NaN .NAN
/);
$schema->add_representer(
regex => qr{$RE_INT_CORE|$RE_FLOAT_CORE|$RE_INT_OCTAL|$RE_INT_HEX},
code => \&represent_literal,
);
if ($schema->bool_class) {
for my $class (@{ $schema->bool_class }) {
if ($class eq 'perl') {
$schema->add_representer(
bool => 1,
code => \&represent_bool,
);
next;
}
$schema->add_representer(
class_equals => $class,
code => \&represent_bool,
);
}
}
return;
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Schema::Core - YAML 1.2 Core Schema
=head1 SYNOPSIS
my $yp = YAML::PP->new( schema => ['Core'] );
=head1 DESCRIPTION
This schema is the official recommended Core Schema for YAML 1.2.
It loads additional values to the JSON schema as special types, for
example C and C additional to C.
Official Schema:
L
Here you can see all Schemas and examples implemented by YAML::PP:
L
=head1 METHODS
=over
=item register
Called by YAML::PP::Schema
=back
=cut
YAML-PP-v0.41.0/lib/YAML/PP/Schema/PaxHeaders/Perl.pm 0000644 0000000 0000000 00000000132 15214605475 016417 x ustar 00 30 mtime=1781730109.611128513
30 atime=1781730109.611027312
30 ctime=1781730109.611128513
YAML-PP-v0.41.0/lib/YAML/PP/Schema/Perl.pm 0000644 0001750 0001750 00000060042 15214605475 016053 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::Perl;
our $VERSION = 'v0.41.0'; # VERSION
use Scalar::Util qw/ blessed reftype /;
my $qr_prefix;
# workaround to avoid growing regexes when repeatedly loading and dumping
# e.g. (?^:(?^:regex))
{
$qr_prefix = qr{\(\?-xism\:};
if ($] >= 5.014) {
$qr_prefix = qr{\(\?\^(?:[uadl])?\:};
}
}
sub new {
my ($class, %args) = @_;
my $tags = $args{tags} || [];
my $loadcode = $args{loadcode} || 0;
my $dumpcode = $args{dumpcode};
$dumpcode = 1 unless defined $dumpcode;
my $classes = $args{classes};
my $self = bless {
tags => $tags,
loadcode => $loadcode,
dumpcode => $dumpcode,
classes => $classes,
}, $class;
}
sub register {
my ($self, %args) = @_;
my $schema = $args{schema};
my $tags;
my $loadcode = 0;
my $dumpcode = 1;
my $classes;
if (blessed($self)) {
$tags = $self->{tags};
@$tags = ('!perl') unless @$tags;
$loadcode = $self->{loadcode};
$dumpcode = $self->{dumpcode};
$classes = $self->{classes};
}
else {
my $options = $args{options};
my $tagtype = '!perl';
for my $option (@$options) {
if ($option =~ m/^tags?=(.+)$/) {
$tagtype = $1;
}
elsif ($option eq '+loadcode') {
$loadcode = 1;
}
elsif ($option eq '-dumpcode') {
$dumpcode = 0;
}
}
$tags = [split m/\+/, $tagtype];
}
my $perl_tag;
my %tagtypes;
my @perl_tags;
for my $type (@$tags) {
if ($type eq '!perl') {
$perl_tag ||= $type;
push @perl_tags, '!perl';
}
elsif ($type eq '!!perl') {
$perl_tag ||= 'tag:yaml.org,2002:perl';
push @perl_tags, 'tag:yaml.org,2002:perl';
}
else {
die "Invalid tagtype '$type'";
}
$tagtypes{ $type } = 1;
}
my $perl_regex = '!perl';
if ($tagtypes{'!perl'} and $tagtypes{'!!perl'}) {
$perl_regex = '(?:tag:yaml\\.org,2002:|!)perl';
}
elsif ($tagtypes{'!perl'}) {
$perl_regex = '!perl';
}
elsif ($tagtypes{'!!perl'}) {
$perl_regex = 'tag:yaml\\.org,2002:perl';
}
my $class_regex = qr{.+};
my $no_objects = 0;
if ($classes) {
if (@$classes) {
$class_regex = '(' . join( '|', map "\Q$_\E", @$classes ) . ')';
}
else {
$no_objects = 1;
$class_regex = '';
}
}
# Code
if ($loadcode) {
my $load_code = sub {
my ($constructor, $event) = @_;
return $self->evaluate_code($event->{value});
};
my $load_code_blessed = sub {
my ($constructor, $event) = @_;
my $class = $event->{tag};
$class =~ s{^$perl_regex/code:}{};
my $sub = $self->evaluate_code($event->{value});
return $self->object($sub, $class);
};
$schema->add_resolver(
tag => "$_/code",
match => [ all => $load_code],
implicit => 0,
) for @perl_tags;
$schema->add_resolver(
tag => qr{^$perl_regex/code:$class_regex$},
match => [ all => $load_code_blessed ],
implicit => 0,
);
$schema->add_resolver(
tag => qr{^$perl_regex/code:.+},
match => [ all => $load_code ],
implicit => 0,
) if $no_objects;
}
else {
my $loadcode_dummy = sub { return sub {} };
my $loadcode_blessed_dummy = sub {
my ($constructor, $event) = @_;
my $class = $event->{tag};
$class =~ s{^$perl_regex/code:}{};
return $self->object(sub {}, $class);
};
$schema->add_resolver(
tag => "$_/code",
match => [ all => $loadcode_dummy ],
implicit => 0,
) for @perl_tags;
$schema->add_resolver(
tag => qr{^$perl_regex/code:$class_regex$},
match => [ all => $loadcode_blessed_dummy ],
implicit => 0,
);
$schema->add_resolver(
tag => qr{^$perl_regex/code:.+},
match => [ all => $loadcode_dummy ],
implicit => 0,
);
}
# Glob
my $load_glob = sub {
my $value = undef;
return \$value;
};
my $load_glob_blessed = sub {
my ($constructor, $event) = @_;
my $class = $event->{tag};
$class =~ s{^$perl_regex/glob:}{};
my $value = undef;
return $self->object(\$value, $class);
};
$schema->add_mapping_resolver(
tag => "$_/glob",
on_create => $load_glob,
on_data => sub {
my ($constructor, $ref, $list) = @_;
$$ref = $self->construct_glob($list);
},
) for @perl_tags;
if ($no_objects) {
$schema->add_mapping_resolver(
tag => qr{^$perl_regex/glob:.+$},
on_create => $load_glob,
on_data => sub {
my ($constructor, $ref, $list) = @_;
$$ref = $self->construct_glob($list);
},
);
}
else {
$schema->add_mapping_resolver(
tag => qr{^$perl_regex/glob:$class_regex$},
on_create => $load_glob_blessed,
on_data => sub {
my ($constructor, $ref, $list) = @_;
$$$ref = $self->construct_glob($list);
},
);
}
# Regex
my $load_regex = sub {
my ($constructor, $event) = @_;
return $self->construct_regex($event->{value});
};
my $load_regex_dummy = sub {
my ($constructor, $event) = @_;
return $event->{value};
};
my $load_regex_blessed = sub {
my ($constructor, $event) = @_;
my $class = $event->{tag};
$class =~ s{^$perl_regex/regexp:}{};
my $qr = $self->construct_regex($event->{value});
return $self->object($qr, $class);
};
$schema->add_resolver(
tag => "$_/regexp",
match => [ all => $load_regex ],
implicit => 0,
) for @perl_tags;
$schema->add_resolver(
tag => qr{^$perl_regex/regexp:$class_regex$},
match => [ all => $load_regex_blessed ],
implicit => 0,
);
$schema->add_resolver(
tag => qr{^$perl_regex/regexp:.*$},
match => [ all => $load_regex_dummy ],
implicit => 0,
);
my $load_sequence = sub { return [] };
my $load_sequence_blessed = sub {
my ($constructor, $event) = @_;
my $class = $event->{tag};
$class =~ s{^$perl_regex/array:}{};
return $self->object([], $class);
};
$schema->add_sequence_resolver(
tag => "$_/array",
on_create => $load_sequence,
) for @perl_tags;
$schema->add_sequence_resolver(
tag => qr{^$perl_regex/array:$class_regex$},
on_create => $load_sequence_blessed,
);
$schema->add_sequence_resolver(
tag => qr{^$perl_regex/array:.+$},
on_create => $load_sequence,
);# if $no_objects;
my $load_mapping = sub { return {} };
my $load_mapping_blessed = sub {
my ($constructor, $event) = @_;
my $class = $event->{tag};
$class =~ s{^$perl_regex/hash:}{};
return $self->object({}, $class);
};
$schema->add_mapping_resolver(
tag => "$_/hash",
on_create => $load_mapping,
) for @perl_tags;
$schema->add_mapping_resolver(
tag => qr{^$perl_regex/hash:$class_regex$},
on_create => $load_mapping_blessed,
);
$schema->add_mapping_resolver(
tag => qr{^$perl_regex/hash:.+$},
on_create => $load_mapping,
); # if $no_objects;
# Ref
my $load_ref = sub {
my $value = undef;
return \$value;
};
my $load_ref_blessed = sub {
my ($constructor, $event) = @_;
my $class = $event->{tag};
$class =~ s{^$perl_regex/ref:}{};
my $value = undef;
return $self->object(\$value, $class);
};
$schema->add_mapping_resolver(
tag => "$_/ref",
on_create => $load_ref,
on_data => sub {
my ($constructor, $ref, $list) = @_;
$$$ref = $self->construct_ref($list);
},
) for @perl_tags;
$schema->add_mapping_resolver(
tag => qr{^$perl_regex/ref:$class_regex$},
on_create => $load_ref_blessed,
on_data => sub {
my ($constructor, $ref, $list) = @_;
$$$ref = $self->construct_ref($list);
},
);
$schema->add_mapping_resolver(
tag => qr{^$perl_regex/ref:.+$},
on_create => $load_ref,
on_data => sub {
my ($constructor, $ref, $list) = @_;
$$$ref = $self->construct_ref($list);
},
); # if $no_objects;
# Scalar ref
my $load_scalar_ref = sub {
my $value = undef;
return \$value;
};
my $load_scalar_ref_blessed = sub {
my ($constructor, $event) = @_;
my $class = $event->{tag};
$class =~ s{^$perl_regex/scalar:}{};
my $value = undef;
return $self->object(\$value, $class);
};
$schema->add_mapping_resolver(
tag => "$_/scalar",
on_create => $load_scalar_ref,
on_data => sub {
my ($constructor, $ref, $list) = @_;
$$$ref = $self->construct_scalar($list);
},
) for @perl_tags;
$schema->add_mapping_resolver(
tag => qr{^$perl_regex/scalar:$class_regex$},
on_create => $load_scalar_ref_blessed,
on_data => sub {
my ($constructor, $ref, $list) = @_;
$$$ref = $self->construct_scalar($list);
},
);
$schema->add_mapping_resolver(
tag => qr{^$perl_regex/scalar:.+$},
on_create => $load_scalar_ref,
on_data => sub {
my ($constructor, $ref, $list) = @_;
$$$ref = $self->construct_scalar($list);
},
); # if $no_objects;
$schema->add_representer(
scalarref => 1,
code => sub {
my ($rep, $node) = @_;
$node->{tag} = $perl_tag . "/scalar";
$node->{data} = $self->represent_scalar($node->{value});
},
);
$schema->add_representer(
refref => 1,
code => sub {
my ($rep, $node) = @_;
$node->{tag} = $perl_tag . "/ref";
$node->{data} = $self->represent_ref($node->{value});
},
);
$schema->add_representer(
coderef => 1,
code => sub {
my ($rep, $node) = @_;
$node->{tag} = $perl_tag . "/code";
$node->{data} = $dumpcode ? $self->represent_code($node->{value}) : '{ "DUMMY" }';
},
);
$schema->add_representer(
glob => 1,
code => sub {
my ($rep, $node) = @_;
$node->{tag} = $perl_tag . "/glob";
$node->{data} = $self->represent_glob($node->{value});
},
);
$schema->add_representer(
class_matches => 1,
code => sub {
my ($rep, $node) = @_;
my $blessed = blessed $node->{value};
my $tag_blessed = ":$blessed";
if ($blessed !~ m/^$class_regex$/) {
$tag_blessed = '';
}
$node->{tag} = sprintf "$perl_tag/%s%s",
lc($node->{reftype}), $tag_blessed;
if ($node->{reftype} eq 'HASH') {
$node->{data} = $node->{value};
}
elsif ($node->{reftype} eq 'ARRAY') {
$node->{data} = $node->{value};
}
# Fun with regexes in perl versions!
elsif ($node->{reftype} eq 'REGEXP') {
if ($blessed eq 'Regexp') {
$node->{tag} = $perl_tag . "/regexp";
}
$node->{data} = $self->represent_regex($node->{value});
}
elsif ($node->{reftype} eq 'SCALAR') {
# in perl <= 5.10 regex reftype(regex) was SCALAR
if ($blessed eq 'Regexp') {
$node->{tag} = $perl_tag . '/regexp';
$node->{data} = $self->represent_regex($node->{value});
}
# In perl <= 5.10 there seemed to be no better pure perl
# way to detect a blessed regex?
elsif (
$] <= 5.010001
and not defined ${ $node->{value} }
and $node->{value} =~ m/^\(\?/
) {
$node->{tag} = $perl_tag . '/regexp' . $tag_blessed;
$node->{data} = $self->represent_regex($node->{value});
}
else {
# phew, just a simple scalarref
$node->{data} = $self->represent_scalar($node->{value});
}
}
elsif ($node->{reftype} eq 'REF') {
$node->{data} = $self->represent_ref($node->{value});
}
elsif ($node->{reftype} eq 'CODE') {
$node->{data} = $dumpcode ? $self->represent_code($node->{value}) : '{ "DUMMY" }';
}
elsif ($node->{reftype} eq 'GLOB') {
$node->{data} = $self->represent_glob($node->{value});
}
else {
die "Reftype '$node->{reftype}' not implemented";
}
return 1;
},
);
return;
}
sub evaluate_code {
my ($self, $code) = @_;
unless ($code =~ m/^ \s* \{ .* \} \s* \z/xs) {
die "Malformed code";
}
$code = "sub $code";
my $sub = eval $code;
if ($@) {
die "Couldn't eval code: $@>>$code<<";
}
return $sub;
}
sub construct_regex {
my ($self, $regex) = @_;
if ($regex =~ m/^$qr_prefix(.*)\)\z/s) {
$regex = $1;
}
my $qr = qr{$regex};
return $qr;
}
sub construct_glob {
my ($self, $list) = @_;
if (@$list % 2) {
die "Unexpected data in perl/glob construction";
}
my %globdata = @$list;
my $name = delete $globdata{NAME} or die "Missing NAME in perl/glob";
my $pkg = delete $globdata{PACKAGE};
$pkg = 'main' unless defined $pkg;
my @allowed = qw(SCALAR ARRAY HASH CODE IO);
delete @globdata{ @allowed };
if (my @keys = keys %globdata) {
die "Unexpected keys in perl/glob: @keys";
}
no strict 'refs';
return *{"${pkg}::$name"};
}
sub construct_scalar {
my ($self, $list) = @_;
if (@$list != 2) {
die "Unexpected data in perl/scalar construction";
}
my ($key, $value) = @$list;
unless ($key eq '=') {
die "Unexpected data in perl/scalar construction";
}
return $value;
}
sub construct_ref {
&construct_scalar;
}
sub represent_scalar {
my ($self, $value) = @_;
return { '=' => $$value };
}
sub represent_ref {
&represent_scalar;
}
sub represent_code {
my ($self, $code) = @_;
require B::Deparse;
my $deparse = B::Deparse->new("-p", "-sC");
return $deparse->coderef2text($code);
}
my @stats = qw/ device inode mode links uid gid rdev size
atime mtime ctime blksize blocks /;
sub represent_glob {
my ($self, $glob) = @_;
my %glob;
for my $type (qw/ PACKAGE NAME SCALAR ARRAY HASH CODE IO /) {
my $value = *{ $glob }{ $type };
if ($type eq 'SCALAR') {
$value = $$value;
}
elsif ($type eq 'IO') {
if (defined $value) {
undef $value;
$value->{stat} = {};
if ($value->{fileno} = fileno(*{ $glob })) {
@{ $value->{stat} }{ @stats } = stat(*{ $glob });
$value->{tell} = tell *{ $glob };
}
}
}
$glob{ $type } = $value if defined $value;
}
return \%glob;
}
sub represent_regex {
my ($self, $regex) = @_;
$regex = "$regex";
if ($regex =~ m/^$qr_prefix(.*)\)\z/s) {
$regex = $1;
}
return $regex;
}
sub object {
my ($self, $data, $class) = @_;
return bless $data, $class;
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Schema::Perl - Schema for serializing perl objects and special types
=head1 SYNOPSIS
use YAML::PP;
# This can be dangerous when loading untrusted YAML!
my $yp = YAML::PP->new( schema => [qw/ + Perl /] );
# or
my $yp = YAML::PP->new( schema => [qw/ Core Perl /] );
my $yaml = $yp->dump_string(sub { return 23 });
# loading code references
# This is very dangerous when loading untrusted YAML!!
my $yp = YAML::PP->new( schema => [qw/ + Perl +loadcode /] );
my $code = $yp->load_string(<<'EOM');
--- !perl/code |
{
use 5.010;
my ($name) = @_;
say "Hello $name!";
}
EOM
$code->("Ingy");
=head1 DESCRIPTION
This schema allows you to load and dump perl objects and special types.
Please note that loading objects of arbitrary classes can be dangerous
in Perl. You have to load the modules yourself, but if an exploitable module
is loaded and an object is created, its C method will be called
when the object falls out of scope. L is an example that can
be exploitable and might remove arbitrary files.
Dumping code references is on by default, but not loading (because that is
easily exploitable since it's using string C).
=head2 Tag Styles
You can define the style of tags you want to support:
my $yp_perl_two_one = YAML::PP->new(
schema => [qw/ + Perl tags=!!perl+!perl /],
);
=over
=item C (default)
Only C tags are supported.
=item C
Only C tags are supported.
=item C
Both C and C are supported when loading. When dumping,
C is used.
=item C
Both C and C are supported when loading. When dumping,
C is used.
=back
L.pm, L and L are using C when dumping.
L.pm and L are supporting both C and
C when loading. L currently only supports the latter.
=head2 Allow only certain classes
Since v0.017
Blessing arbitrary objects can be dangerous. Maybe you want to allow blessing
only specific classes and ignore others. For this you have to instantiate
a Perl Schema object first and use the C option.
Currently it only allows a list of strings:
my $perl = YAML::PP::Schema::Perl->new(
classes => ['Foo', 'Bar'],
);
my $yp = YAML::PP::Perl->new(
schema => [qw/ + /, $perl],
);
Allowed classes will be loaded and dumped as usual. The others will be ignored.
If you want to allow no objects at all, pass an empty array ref.
=cut
=head2 EXAMPLES
This is a list of the currently supported types and how they are dumped into
YAML:
=cut
### BEGIN EXAMPLE
=pod
=over 4
=item array
# Code
[
qw/ one two three four /
]
# YAML
---
- one
- two
- three
- four
=item array_blessed
# Code
bless [
qw/ one two three four /
], "Just::An::Arrayref"
# YAML
--- !perl/array:Just::An::Arrayref
- one
- two
- three
- four
=item circular
# Code
my $circle = bless [ 1, 2 ], 'Circle';
push @$circle, $circle;
$circle;
# YAML
--- &1 !perl/array:Circle
- 1
- 2
- *1
=item coderef
# Code
sub {
my (%args) = @_;
return $args{x} + $args{y};
}
# YAML
--- !perl/code |-
{
use warnings;
use strict;
(my(%args) = @_);
(return ($args{'x'} + $args{'y'}));
}
=item coderef_blessed
# Code
bless sub {
my (%args) = @_;
return $args{x} - $args{y};
}, "I::Am::Code"
# YAML
--- !perl/code:I::Am::Code |-
{
use warnings;
use strict;
(my(%args) = @_);
(return ($args{'x'} - $args{'y'}));
}
=item hash
# Code
{
U => 2,
B => 52,
}
# YAML
---
B: 52
U: 2
=item hash_blessed
# Code
bless {
U => 2,
B => 52,
}, 'A::Very::Exclusive::Class'
# YAML
--- !perl/hash:A::Very::Exclusive::Class
B: 52
U: 2
=item refref
# Code
my $ref = { a => 'hash' };
my $refref = \$ref;
$refref;
# YAML
--- !perl/ref
=:
a: hash
=item refref_blessed
# Code
my $ref = { a => 'hash' };
my $refref = bless \$ref, 'Foo';
$refref;
# YAML
--- !perl/ref:Foo
=:
a: hash
=item regexp
# Code
my $string = 'unblessed';
qr{$string}
# YAML
--- !perl/regexp unblessed
=item regexp_blessed
# Code
my $string = 'blessed';
bless qr{$string}, "Foo"
# YAML
--- !perl/regexp:Foo blessed
=item scalarref
# Code
my $scalar = "some string";
my $scalarref = \$scalar;
$scalarref;
# YAML
--- !perl/scalar
=: some string
=item scalarref_blessed
# Code
my $scalar = "some other string";
my $scalarref = bless \$scalar, 'Foo';
$scalarref;
# YAML
--- !perl/scalar:Foo
=: some other string
=back
=cut
### END EXAMPLE
=head2 METHODS
=over
=item new
my $perl = YAML::PP::Schema::Perl->new(
tags => "!perl",
classes => ['MyClass'],
loadcode => 1,
dumpcode => 1,
);
The constructor recognizes the following options:
=over
=item tags
Default: 'C'
See L<"Tag Styles">
=item classes
Default: C
Since: v0.017
Accepts an array ref of class names
=item loadcode
Default: 0
=item dumpcode
Default: 1
my $yp = YAML::PP->new( schema => [qw/ + Perl -dumpcode /] );
=back
=item register
A class method called by L
=item construct_ref, represent_ref
Perl variables of the type C are represented in yaml like this:
--- !perl/ref
=:
a: 1
C returns the perl data:
my $data = YAML::PP::Schema::Perl->construct_ref([ '=', { some => 'data' } );
my $data = \{ a => 1 };
C turns a C variable into a YAML mapping:
my $data = YAML::PP::Schema::Perl->represent_ref(\{ a => 1 });
my $data = { '=' => { a => 1 } };
=item construct_scalar, represent_scalar
Perl variables of the type C are represented in yaml like this:
--- !perl/scalar
=: string
C returns the perl data:
my $data = YAML::PP::Schema::Perl->construct_ref([ '=', 'string' );
my $data = \'string';
C turns a C variable into a YAML mapping:
my $data = YAML::PP::Schema::Perl->represent_scalar(\'string');
my $data = { '=' => 'string' };
=item construct_regex, represent_regex
C returns a C object from the YAML string:
my $qr = YAML::PP::Schema::Perl->construct_regex('foo.*');
C returns a string representing the regex object:
my $string = YAML::PP::Schema::Perl->represent_regex(qr{...});
=item evaluate_code, represent_code
C returns a code reference from a string. The string must
start with a C<{> and end with a C<}>.
my $code = YAML::PP::Schema::Perl->evaluate_code('{ return 23 }');
C returns a string representation of the code reference
with the help of B::Deparse:
my $string = YAML::PP::Schema::Perl->represent_code(sub { return 23 });
=item construct_glob, represent_glob
C returns a glob from a hash.
my $glob = YAML::PP::Schema::Perl->construct_glob($hash);
C returns a hash representation of the glob.
my $hash = YAML::PP::Schema::Perl->represent_glob($glob);
=item object
Does the same as C:
my $object = YAML::PP::Schema::Perl->object($data, $class);
=back
=cut
YAML-PP-v0.41.0/lib/YAML/PP/Schema/PaxHeaders/JSON.pm 0000644 0000000 0000000 00000000132 15214605475 016266 x ustar 00 30 mtime=1781730109.611027312
30 atime=1781730109.610868982
30 ctime=1781730109.611027312
YAML-PP-v0.41.0/lib/YAML/PP/Schema/JSON.pm 0000644 0001750 0001750 00000014230 15214605475 015720 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::JSON;
our $VERSION = 'v0.41.0'; # VERSION
use base 'Exporter';
our @EXPORT_OK = qw/
represent_int represent_float represent_literal represent_bool
represent_undef
/;
use B;
use Carp qw/ croak /;
use YAML::PP::Common qw/ YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE /;
my $RE_INT = qr{^(-?(?:0|[1-9][0-9]*))$};
my $RE_FLOAT = qr{^(-?(?:0|[1-9][0-9]*)(?:\.[0-9]*)?(?:[eE][+-]?[0-9]+)?)$};
sub _to_int { 0 + $_[2]->[0] }
# DaTa++ && shmem++
sub _to_float { unpack F => pack F => $_[2]->[0] }
sub register {
my ($self, %args) = @_;
my $schema = $args{schema};
my $options = $args{options};
my $empty_null = 0;
for my $opt (@$options) {
if ($opt eq 'empty=str') {
}
elsif ($opt eq 'empty=null') {
$empty_null = 1;
}
else {
croak "Invalid option for JSON Schema: '$opt'";
}
}
$schema->add_resolver(
tag => 'tag:yaml.org,2002:null',
match => [ equals => null => undef ],
);
if ($empty_null) {
$schema->add_resolver(
tag => 'tag:yaml.org,2002:null',
match => [ equals => '' => undef ],
implicit => 1,
);
}
else {
$schema->add_resolver(
tag => 'tag:yaml.org,2002:str',
match => [ equals => '' => '' ],
implicit => 1,
);
}
$schema->add_resolver(
tag => 'tag:yaml.org,2002:bool',
match => [ equals => true => $schema->true ],
);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:bool',
match => [ equals => false => $schema->false ],
);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:int',
match => [ regex => $RE_INT => \&_to_int ],
);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:float',
match => [ regex => $RE_FLOAT => \&_to_float ],
);
$schema->add_resolver(
tag => 'tag:yaml.org,2002:str',
match => [ all => sub { $_[1]->{value} } ],
);
$schema->add_representer(
undefined => \&represent_undef,
);
my $int_flags = B::SVp_IOK;
my $float_flags = B::SVp_NOK;
$schema->add_representer(
flags => $int_flags,
code => \&represent_int,
);
my %special = ( (0+'nan').'' => '.nan', (0+'inf').'' => '.inf', (0-'inf').'' => '-.inf' );
$schema->add_representer(
flags => $float_flags,
code => \&represent_float,
);
$schema->add_representer(
equals => $_,
code => \&represent_literal,
) for ("", qw/ true false null /);
$schema->add_representer(
regex => qr{$RE_INT|$RE_FLOAT},
code => \&represent_literal,
);
if ($schema->bool_class) {
for my $class (@{ $schema->bool_class }) {
if ($class eq 'perl') {
$schema->add_representer(
bool => 1,
code => \&represent_bool,
);
next;
}
$schema->add_representer(
class_equals => $class,
code => \&represent_bool,
);
}
}
return;
}
sub represent_undef {
my ($rep, $node) = @_;
$node->{style} = YAML_PLAIN_SCALAR_STYLE;
$node->{data} = 'null';
return 1;
}
sub represent_literal {
my ($rep, $node) = @_;
$node->{style} ||= YAML_SINGLE_QUOTED_SCALAR_STYLE;
$node->{data} = "$node->{value}";
return 1;
}
sub represent_int {
my ($rep, $node) = @_;
if (int($node->{value}) ne $node->{value}) {
return 0;
}
$node->{style} = YAML_PLAIN_SCALAR_STYLE;
$node->{data} = "$node->{value}";
return 1;
}
my %special = (
(0+'nan').'' => '.nan',
(0+'inf').'' => '.inf',
(0-'inf').'' => '-.inf'
);
sub represent_float {
my ($rep, $node) = @_;
if (exists $special{ $node->{value} }) {
$node->{style} = YAML_PLAIN_SCALAR_STYLE;
$node->{data} = $special{ $node->{value} };
return 1;
}
if (0.0 + $node->{value} ne $node->{value}) {
return 0;
}
if (int($node->{value}) eq $node->{value} and not $node->{value} =~ m/\./) {
$node->{value} .= '.0';
}
$node->{style} = YAML_PLAIN_SCALAR_STYLE;
$node->{data} = "$node->{value}";
return 1;
}
sub represent_bool {
my ($rep, $node) = @_;
my $string = $node->{value} ? 'true' : 'false';
$node->{style} = YAML_PLAIN_SCALAR_STYLE;
@{ $node->{items} } = $string;
$node->{data} = $string;
return 1;
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Schema::JSON - YAML 1.2 JSON Schema
=head1 SYNOPSIS
my $yp = YAML::PP->new( schema => ['JSON'] );
my $yp = YAML::PP->new( schema => [qw/ JSON empty=str /] );
my $yp = YAML::PP->new( schema => [qw/ JSON empty=null /] );
=head1 DESCRIPTION
With this schema, the resolution of plain values will work like in JSON.
Everything that matches a special value will be loaded as such, other plain
scalars will be loaded as strings.
Note that this is different from the official YAML 1.2 JSON Schema, where all
strings have to be quoted.
Here you can see all Schemas and examples implemented by YAML::PP:
L
Official Schema: L
=head1 CONFIGURATION
The official YAML 1.2 JSON Schema wants all strings to be quoted.
YAML::PP currently does not require that (it might do this optionally in
the future).
That means, there are no empty nodes allowed in the official schema. Example:
---
key:
The default behaviour of YAML::PP::Schema::JSON is to return an empty string,
so it would be equivalent to:
---
key: ''
You can configure it to resolve this as C:
my $yp = YAML::PP->new( schema => [qw/ JSON empty=null /] );
This way it is equivalent to:
---
key: null
The default is:
my $yp = YAML::PP->new( schema => [qw/ JSON empty=str /] );
=head1 METHODS
=over
=item register
Called by YAML::PP::Schema
=item represent_bool, represent_float, represent_int, represent_literal, represent_undef
Functions to represent the several node types.
represent_bool($representer, $node);
=back
=cut
YAML-PP-v0.41.0/lib/YAML/PP/PaxHeaders/Writer 0000644 0000000 0000000 00000000132 15214605475 015156 x ustar 00 30 mtime=1781730109.610707717
30 atime=1781730109.610707717
30 ctime=1781730109.610707717
YAML-PP-v0.41.0/lib/YAML/PP/Writer/ 0000755 0001750 0001750 00000000000 15214605475 014665 5 ustar 00tina tina YAML-PP-v0.41.0/lib/YAML/PP/Writer/PaxHeaders/File.pm 0000644 0000000 0000000 00000000132 15214605475 016450 x ustar 00 30 mtime=1781730109.610868982
30 atime=1781730109.610707717
30 ctime=1781730109.610868982
YAML-PP-v0.41.0/lib/YAML/PP/Writer/File.pm 0000644 0001750 0001750 00000003461 15214605475 016106 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Writer::File;
our $VERSION = 'v0.41.0'; # VERSION
use Scalar::Util qw/ openhandle /;
use base qw/ YAML::PP::Writer /;
use Carp qw/ croak /;
sub _open_handle {
my ($self) = @_;
if (openhandle($self->{output})) {
$self->{filehandle} = $self->{output};
return $self->{output};
}
open my $fh, '>:encoding(UTF-8)', $self->{output}
or croak "Could not open '$self->{output}' for writing: $!";
$self->{filehandle} = $fh;
return $fh;
}
sub write {
my ($self, $line) = @_;
my $fh = $self->{filehandle};
print $fh $line;
}
sub init {
my ($self) = @_;
my $fh = $self->_open_handle;
}
sub finish {
my ($self) = @_;
if (openhandle($self->{output})) {
# Original argument was a file handle, so the caller needs
# to close it
return;
}
close $self->{filehandle};
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Writer::File - Write YAML output to file or file handle
=head1 SYNOPSIS
my $writer = YAML::PP::Writer::File->new(output => $file);
=head1 DESCRIPTION
The L sends its output to the writer.
You can use your own writer. if you want to send the YAML output to
somewhere else. See t/44.writer.t for an example.
=head1 METHODS
=over
=item new
my $writer = YAML::PP::Writer::File->new(output => $file);
my $writer = YAML::PP::Writer::File->new(output => $filehandle);
Constructor.
=item write
$writer->write('- ');
=item init
$writer->init;
Initialize
=item finish
$writer->finish;
Gets called when the output ends. If The argument was a filename, the
filehandle will be closed. If the argument was a filehandle, the caller needs to
close it.
=item output, set_output
Getter/setter for the YAML output
=back
=cut
YAML-PP-v0.41.0/lib/YAML/PP/PaxHeaders/Constructor.pm 0000644 0000000 0000000 00000000132 15214605475 016642 x ustar 00 30 mtime=1781730109.610707717
30 atime=1781730109.610610847
30 ctime=1781730109.610707717
YAML-PP-v0.41.0/lib/YAML/PP/Constructor.pm 0000644 0001750 0001750 00000032577 15214605475 016312 0 ustar 00tina tina # ABSTRACT: Construct data structure from Parser Events
use strict;
use warnings;
package YAML::PP::Constructor;
our $VERSION = 'v0.41.0'; # VERSION
use YAML::PP;
use YAML::PP::Common qw/
PRESERVE_ORDER PRESERVE_SCALAR_STYLE PRESERVE_FLOW_STYLE PRESERVE_ALIAS
/;
use Scalar::Util qw/ reftype /;
use Carp qw/ croak /;
use constant DEBUG => ($ENV{YAML_PP_LOAD_DEBUG} or $ENV{YAML_PP_LOAD_TRACE}) ? 1 : 0;
use constant TRACE => $ENV{YAML_PP_LOAD_TRACE} ? 1 : 0;
use constant MAX_DEPTH => 2 ** 9;
my %cyclic_refs = qw/ allow 1 ignore 1 warn 1 fatal 1 /;
sub new {
my ($class, %args) = @_;
my $default_yaml_version = delete $args{default_yaml_version};
my $duplicate_keys = delete $args{duplicate_keys};
unless (defined $duplicate_keys) {
$duplicate_keys = 0;
}
my $require_footer = delete $args{require_footer};
my $max_depth = delete $args{max_depth} || MAX_DEPTH;
my $preserve = delete $args{preserve} || 0;
if ($preserve == 1) {
$preserve = PRESERVE_ORDER | PRESERVE_SCALAR_STYLE | PRESERVE_FLOW_STYLE | PRESERVE_ALIAS;
}
my $cyclic_refs = delete $args{cyclic_refs} || 'fatal';
die "Invalid value for cyclic_refs: $cyclic_refs"
unless $cyclic_refs{ $cyclic_refs };
my $schemas = delete $args{schemas};
if (keys %args) {
die "Unexpected arguments: " . join ', ', sort keys %args;
}
my $self = bless {
default_yaml_version => $default_yaml_version,
schemas => $schemas,
cyclic_refs => $cyclic_refs,
preserve => $preserve,
duplicate_keys => $duplicate_keys,
require_footer => $require_footer,
max_depth => $max_depth,
}, $class;
$self->init;
return $self;
}
sub clone {
my ($self) = @_;
my $clone = {
schemas => $self->{schemas},
schema => $self->{schema},
default_yaml_version => $self->{default_yaml_version},
cyclic_refs => $self->cyclic_refs,
preserve => $self->{preserve},
max_depth => $self->{max_depth},
};
return bless $clone, ref $self;
}
sub init {
my ($self) = @_;
$self->set_docs([]);
$self->set_stack([]);
$self->set_anchors({});
$self->set_yaml_version($self->default_yaml_version);
$self->set_schema($self->schemas->{ $self->yaml_version } );
}
sub docs { return $_[0]->{docs} }
sub stack { return $_[0]->{stack} }
sub anchors { return $_[0]->{anchors} }
sub set_docs { $_[0]->{docs} = $_[1] }
sub set_stack { $_[0]->{stack} = $_[1] }
sub set_anchors { $_[0]->{anchors} = $_[1] }
sub schemas { return $_[0]->{schemas} }
sub schema { return $_[0]->{schema} }
sub set_schema { $_[0]->{schema} = $_[1] }
sub cyclic_refs { return $_[0]->{cyclic_refs} }
sub set_cyclic_refs { $_[0]->{cyclic_refs} = $_[1] }
sub yaml_version { return $_[0]->{yaml_version} }
sub set_yaml_version { $_[0]->{yaml_version} = $_[1] }
sub default_yaml_version { return $_[0]->{default_yaml_version} }
sub preserve_order { return $_[0]->{preserve} & PRESERVE_ORDER }
sub preserve_scalar_style { return $_[0]->{preserve} & PRESERVE_SCALAR_STYLE }
sub preserve_flow_style { return $_[0]->{preserve} & PRESERVE_FLOW_STYLE }
sub preserve_alias { return $_[0]->{preserve} & PRESERVE_ALIAS }
sub duplicate_keys { return $_[0]->{duplicate_keys} }
sub require_footer { return $_[0]->{require_footer} }
sub max_depth { return $_[0]->{max_depth} }
sub document_start_event {
my ($self, $event) = @_;
my $stack = $self->stack;
if ($event->{version_directive}) {
my $version = $event->{version_directive};
$version = "$version->{major}.$version->{minor}";
if ($self->{schemas}->{ $version }) {
$self->set_yaml_version($version);
$self->set_schema($self->schemas->{ $version });
}
else {
$self->set_yaml_version($self->default_yaml_version);
$self->set_schema($self->schemas->{ $self->default_yaml_version });
}
}
my $ref = [];
push @$stack, { type => 'document', ref => $ref, data => $ref, event => $event };
}
sub document_end_event {
my ($self, $event) = @_;
my $stack = $self->stack;
my $last = pop @$stack;
$last->{type} eq 'document' or die "Expected mapping, but got $last->{type}";
if (@$stack) {
die "Got unexpected end of document";
}
my $docs = $self->docs;
if ($event->{implicit} and $self->require_footer) {
die sprintf "load: Document (%d) did not end with '...' (require_footer=1)", 1 + scalar @$docs;
}
push @$docs, $last->{ref}->[0];
$self->set_anchors({});
$self->set_stack([]);
}
sub _check_depth {
my ($self) = @_;
my $stack = $self->stack;
my $c = @$stack;
if ($c > ($self->max_depth || MAX_DEPTH)){
croak sprintf 'Depth of nesting exceeds maximum %s', $self->max_depth;
}
}
sub mapping_start_event {
my ($self, $event) = @_;
my ($data, $on_data) = $self->schema->create_mapping($self, $event);
my $ref = {
type => 'mapping',
ref => [],
data => \$data,
event => $event,
on_data => $on_data,
};
$self->_check_depth;
my $stack = $self->stack;
my $preserve_order = $self->preserve_order;
my $preserve_style = $self->preserve_flow_style;
my $preserve_alias = $self->preserve_alias;
if (($preserve_order or $preserve_style or $preserve_alias) and not tied(%$data)) {
tie %$data, 'YAML::PP::Preserve::Hash', %$data;
}
if ($preserve_style) {
my $t = tied %$data;
$t->{style} = $event->{style};
}
push @$stack, $ref;
if (defined(my $anchor = $event->{anchor})) {
if ($preserve_alias) {
my $t = tied %$data;
unless (exists $self->anchors->{ $anchor }) {
# Repeated anchors cannot be preserved
$t->{alias} = $anchor;
}
}
$self->anchors->{ $anchor } = { data => $ref->{data} };
}
}
sub mapping_end_event {
my ($self, $event) = @_;
my $stack = $self->stack;
my $last = pop @$stack;
my ($ref, $data) = @{ $last }{qw/ ref data /};
$last->{type} eq 'mapping' or die "Expected mapping, but got $last->{type}";
my @merge_keys;
my @ref;
for (my $i = 0; $i < @$ref; $i += 2) {
my $key = $ref->[ $i ];
if (ref $key eq 'YAML::PP::Type::MergeKey') {
my $merge = $ref->[ $i + 1 ];
if ((reftype($merge) || '') eq 'HASH') {
push @merge_keys, $merge;
}
elsif ((reftype($merge) || '') eq 'ARRAY') {
for my $item (@$merge) {
if ((reftype($item) || '') eq 'HASH') {
push @merge_keys, $item;
}
else {
die "Expected hash for merge key";
}
}
}
else {
die "Expected hash or array for merge key";
}
}
else {
push @ref, $key, $ref->[ $i + 1 ];
}
}
for my $merge (@merge_keys) {
for my $key (keys %$merge) {
unless (exists $$data->{ $key }) {
$$data->{ $key } = $merge->{ $key };
}
}
}
my $on_data = $last->{on_data} || sub {
my ($self, $hash, $items) = @_;
my %seen;
for (my $i = 0; $i < @$items; $i += 2) {
my ($key, $value) = @$items[ $i, $i + 1 ];
$key = '' unless defined $key;
if (ref $key) {
$key = $self->stringify_complex($key);
}
if ($seen{ $key }++ and not $self->duplicate_keys) {
croak "Duplicate key '$key'";
}
$$hash->{ $key } = $value;
}
};
$on_data->($self, $data, \@ref);
push @{ $stack->[-1]->{ref} }, $$data;
if (defined(my $anchor = $last->{event}->{anchor})) {
$self->anchors->{ $anchor }->{finished} = 1;
}
return;
}
sub sequence_start_event {
my ($self, $event) = @_;
my ($data, $on_data) = $self->schema->create_sequence($self, $event);
my $ref = {
type => 'sequence',
ref => [],
data => \$data,
event => $event,
on_data => $on_data,
};
my $stack = $self->stack;
$self->_check_depth;
my $preserve_style = $self->preserve_flow_style;
my $preserve_alias = $self->preserve_alias;
if ($preserve_style or $preserve_alias and not tied(@$data)) {
tie @$data, 'YAML::PP::Preserve::Array', @$data;
my $t = tied @$data;
$t->{style} = $event->{style};
}
push @$stack, $ref;
if (defined(my $anchor = $event->{anchor})) {
if ($preserve_alias) {
my $t = tied @$data;
unless (exists $self->anchors->{ $anchor }) {
# Repeated anchors cannot be preserved
$t->{alias} = $anchor;
}
}
$self->anchors->{ $anchor } = { data => $ref->{data} };
}
}
sub sequence_end_event {
my ($self, $event) = @_;
my $stack = $self->stack;
my $last = pop @$stack;
$last->{type} eq 'sequence' or die "Expected mapping, but got $last->{type}";
my ($ref, $data) = @{ $last }{qw/ ref data /};
my $on_data = $last->{on_data} || sub {
my ($self, $array, $items) = @_;
push @$$array, @$items;
};
$on_data->($self, $data, $ref);
push @{ $stack->[-1]->{ref} }, $$data;
if (defined(my $anchor = $last->{event}->{anchor})) {
my $test = $self->anchors->{ $anchor };
$self->anchors->{ $anchor }->{finished} = 1;
}
return;
}
sub stream_start_event {}
sub stream_end_event {}
sub scalar_event {
my ($self, $event) = @_;
DEBUG and warn "CONTENT $event->{value} ($event->{style})\n";
my $value = $self->schema->load_scalar($self, $event);
my $last = $self->stack->[-1];
my $preserve_alias = $self->preserve_alias;
my $preserve_style = $self->preserve_scalar_style;
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') {
croak "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:
$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 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, use
the default stringification, C for example.
=back
=cut
YAML-PP-v0.41.0/lib/YAML/PP/PaxHeaders/Representer.pm 0000644 0000000 0000000 00000000131 15214605475 016612 x ustar 00 30 mtime=1781730109.610610847
29 atime=1781730109.61051684
30 ctime=1781730109.610610847
YAML-PP-v0.41.0/lib/YAML/PP/Representer.pm 0000644 0001750 0001750 00000015734 15214605475 016257 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Representer;
our $VERSION = 'v0.41.0'; # 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) {
die "Unexpected arguments: " . join ', ', sort keys %args;
}
return $self;
}
sub clone {
my ($self) = @_;
my $clone = {
schema => $self->schema,
preserve => $self->{preserve},
};
return bless $clone, ref $self;
}
sub schema { return $_[0]->{schema} }
sub preserve_order { return $_[0]->{preserve} & PRESERVE_ORDER }
sub preserve_scalar_style { return $_[0]->{preserve} & PRESERVE_SCALAR_STYLE }
sub preserve_flow_style { return $_[0]->{preserve} & PRESERVE_FLOW_STYLE }
sub preserve_alias { return $_[0]->{preserve} & PRESERVE_ALIAS }
sub represent_node {
my ($self, $node) = @_;
my $preserve_alias = $self->preserve_alias;
my $preserve_style = $self->preserve_scalar_style;
if ($preserve_style or $preserve_alias) {
if (ref $node->{value} eq 'YAML::PP::Preserve::Scalar') {
my $value = $node->{value}->value;
if ($preserve_style) {
$node->{style} = $node->{value}->style;
}
# $node->{tag} = $node->{value}->tag;
$node->{value} = $value;
}
}
$node->{reftype} = reftype($node->{value});
if (not $node->{reftype} and reftype(\$node->{value}) eq 'GLOB') {
$node->{reftype} = 'GLOB';
}
if ($node->{reftype}) {
$self->_represent_noderef($node);
}
else {
$self->_represent_node_nonref($node);
}
$node->{reftype} = (reftype $node->{data}) || '';
if ($node->{reftype} eq 'HASH' and my $tied = tied(%{ $node->{data} })) {
my $representers = $self->schema->representers;
$tied = ref $tied;
if (my $def = $representers->{tied_equals}->{ $tied }) {
my $code = $def->{code};
my $done = $code->($self, $node);
}
}
if ($node->{reftype} eq 'HASH') {
unless (defined $node->{items}) {
# by default we sort hash keys
my @keys;
if ($self->preserve_order) {
@keys = keys %{ $node->{data} };
}
else {
@keys = sort keys %{ $node->{data} };
}
for my $key (@keys) {
push @{ $node->{items} }, $key, $node->{data}->{ $key };
}
}
my %args;
if ($self->preserve_flow_style and reftype $node->{value} eq 'HASH') {
if (my $tied = tied %{ $node->{value} } ) {
$args{style} = $tied->{style};
}
}
return [ mapping => $node, %args ];
}
elsif ($node->{reftype} eq 'ARRAY') {
unless (defined $node->{items}) {
@{ $node->{items} } = @{ $node->{data} };
}
my %args;
if ($self->preserve_flow_style and reftype $node->{value} eq 'ARRAY') {
if (my $tied = tied @{ $node->{value} } ) {
$args{style} = $tied->{style};
}
}
return [ sequence => $node, %args ];
}
elsif ($node->{reftype}) {
die "Cannot handle reftype '$node->{reftype}' (you might want to enable YAML::PP::Schema::Perl)";
}
else {
unless (defined $node->{items}) {
$node->{items} = [$node->{data}];
}
return [ scalar => $node ];
}
}
my $bool_code = <<'EOM';
sub {
my ($x) = @_;
use experimental qw/ builtin /;
builtin::is_bool($x);
}
EOM
my $is_bool;
sub _represent_node_nonref {
my ($self, $node) = @_;
my $representers = $self->schema->representers;
if (not defined $node->{value}) {
if (my $undef = $representers->{undef}) {
return 1 if $undef->($self, $node);
}
else {
$node->{style} = YAML_SINGLE_QUOTED_SCALAR_STYLE;
$node->{data} = '';
return 1;
}
}
if ($] >= 5.036000 and my $rep = $representers->{bool}) {
$is_bool ||= eval $bool_code;
if ($is_bool->($node->{value})) {
return $rep->{code}->($self, $node);
}
}
for my $rep (@{ $representers->{flags} }) {
my $check_flags = $rep->{flags};
my $flags = B::svref_2object(\$node->{value})->FLAGS;
if ($flags & $check_flags) {
return 1 if $rep->{code}->($self, $node);
}
}
if (my $rep = $representers->{equals}->{ $node->{value} }) {
return 1 if $rep->{code}->($self, $node);
}
for my $rep (@{ $representers->{regex} }) {
if ($node->{value} =~ $rep->{regex}) {
return 1 if $rep->{code}->($self, $node);
}
}
unless (defined $node->{data}) {
$node->{data} = $node->{value};
}
unless (defined $node->{style}) {
$node->{style} = YAML_ANY_SCALAR_STYLE;
$node->{style} = "";
}
}
sub _represent_noderef {
my ($self, $node) = @_;
my $representers = $self->schema->representers;
if (my $classname = blessed($node->{value})) {
if (my $def = $representers->{class_equals}->{ $classname }) {
my $code = $def->{code};
return 1 if $code->($self, $node);
}
for my $matches (@{ $representers->{class_matches} }) {
my ($re, $code) = @$matches;
if (ref $re and $classname =~ $re or $re) {
return 1 if $code->($self, $node);
}
}
for my $isa (@{ $representers->{class_isa} }) {
my ($class_name, $code) = @$isa;
if ($node->{ value }->isa($class_name)) {
return 1 if $code->($self, $node);
}
}
}
if ($node->{reftype} eq 'SCALAR' and my $scalarref = $representers->{scalarref}) {
my $code = $scalarref->{code};
return 1 if $code->($self, $node);
}
if ($node->{reftype} eq 'REF' and my $refref = $representers->{refref}) {
my $code = $refref->{code};
return 1 if $code->($self, $node);
}
if ($node->{reftype} eq 'CODE' and my $coderef = $representers->{coderef}) {
my $code = $coderef->{code};
return 1 if $code->($self, $node);
}
if ($node->{reftype} eq 'GLOB' and my $glob = $representers->{glob}) {
my $code = $glob->{code};
return 1 if $code->($self, $node);
}
$node->{data} = $node->{value};
}
1;
YAML-PP-v0.41.0/lib/YAML/PP/PaxHeaders/Highlight.pm 0000644 0000000 0000000 00000000126 15214605475 016227 x ustar 00 28 mtime=1781730109.6096001
30 atime=1781730109.609508467
28 ctime=1781730109.6096001
YAML-PP-v0.41.0/lib/YAML/PP/Highlight.pm 0000644 0001750 0001750 00000014245 15214605475 015664 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Highlight;
our $VERSION = 'v0.41.0'; # VERSION
our @EXPORT_OK = qw/ Dump /;
use base 'Exporter';
use YAML::PP;
use YAML::PP::Parser;
use Encode;
sub Dump {
my (@docs) = @_;
# Dumping objects is safe, so we enable the Perl schema here
require YAML::PP::Schema::Perl;
my $yp = YAML::PP->new( schema => [qw/ + Perl /] );
my $yaml = $yp->dump_string(@docs);
my ($error, $tokens) = YAML::PP::Parser->yaml_to_tokens(string => $yaml);
my $highlighted = YAML::PP::Highlight->ansicolored($tokens);
encode_utf8 $highlighted;
}
my %ansicolors = (
ANCHOR => [qw/ green /],
ALIAS => [qw/ bold green /],
TAG => [qw/ bold blue /],
INDENT => [qw/ white on_grey3 /],
COMMENT => [qw/ grey12 /],
COLON => [qw/ bold magenta /],
DASH => [qw/ bold magenta /],
QUESTION => [qw/ bold magenta /],
YAML_DIRECTIVE => [qw/ cyan /],
TAG_DIRECTIVE => [qw/ bold cyan /],
SINGLEQUOTE => [qw/ bold green /],
SINGLEQUOTED => [qw/ green /],
SINGLEQUOTED_LINE => [qw/ green /],
DOUBLEQUOTE => [qw/ bold green /],
DOUBLEQUOTED => [qw/ green /],
DOUBLEQUOTED_LINE => [qw/ green /],
LITERAL => [qw/ bold yellow /],
FOLDED => [qw/ bold yellow /],
DOC_START => [qw/ bold /],
DOC_END => [qw/ bold /],
BLOCK_SCALAR_CONTENT => [qw/ yellow /],
TAB => [qw/ on_blue /],
ERROR => [qw/ bold red /],
EOL => [qw/ grey12 /],
TRAILING_SPACE => [qw/ on_grey6 /],
FLOWSEQ_START => [qw/ bold magenta /],
FLOWSEQ_END => [qw/ bold magenta /],
FLOWMAP_START => [qw/ bold magenta /],
FLOWMAP_END => [qw/ bold magenta /],
FLOW_COMMA => [qw/ bold magenta /],
PLAINKEY => [qw/ bright_blue /],
);
sub ansicolored {
my ($class, $tokens, %args) = @_;
my $expand_tabs = $args{expand_tabs};
$expand_tabs = 1 unless defined $expand_tabs;
require Term::ANSIColor;
local $Term::ANSIColor::EACHLINE = "\n";
my $ansi = '';
my $highlighted = '';
my @list = $class->transform($tokens);
for my $token (@list) {
my $name = $token->{name};
my $str = $token->{value};
my $color = $ansicolors{ $name };
if ($color) {
$str = Term::ANSIColor::colored($color, $str);
}
$highlighted .= $str;
}
if ($expand_tabs) {
# Tabs can't be displayed with ansicolors
$highlighted =~ s/\t/' ' x 8/eg;
}
$ansi .= $highlighted;
return $ansi;
}
my %htmlcolors = (
ANCHOR => 'anchor',
ALIAS => 'alias',
SINGLEQUOTE => 'singlequote',
DOUBLEQUOTE => 'doublequote',
SINGLEQUOTED => 'singlequoted',
DOUBLEQUOTED => 'doublequoted',
SINGLEQUOTED_LINE => 'singlequoted',
DOUBLEQUOTED_LINE => 'doublequoted',
INDENT => 'indent',
DASH => 'dash',
COLON => 'colon',
QUESTION => 'question',
YAML_DIRECTIVE => 'yaml_directive',
TAG_DIRECTIVE => 'tag_directive',
TAG => 'tag',
COMMENT => 'comment',
LITERAL => 'literal',
FOLDED => 'folded',
DOC_START => 'doc_start',
DOC_END => 'doc_end',
BLOCK_SCALAR_CONTENT => 'block_scalar_content',
TAB => 'tab',
ERROR => 'error',
EOL => 'eol',
TRAILING_SPACE => 'trailing_space',
FLOWSEQ_START => 'flowseq_start',
FLOWSEQ_END => 'flowseq_end',
FLOWMAP_START => 'flowmap_start',
FLOWMAP_END => 'flowmap_end',
FLOW_COMMA => 'flow_comma',
PLAINKEY => 'plainkey',
NOEOL => 'noeol',
);
sub htmlcolored {
require HTML::Entities;
my ($class, $tokens) = @_;
my $html = '';
my @list = $class->transform($tokens);
for my $token (@list) {
my $name = $token->{name};
my $str = $token->{value};
my $colorclass = $htmlcolors{ $name } || 'default';
$str = HTML::Entities::encode_entities($str);
$html .= qq{$str};
}
return $html;
}
sub transform {
my ($class, $tokens) = @_;
my @list;
for my $token (@$tokens) {
my @values;
my $value = $token->{value};
my $subtokens = $token->{subtokens};
if ($subtokens) {
@values = @$subtokens;
}
else {
@values = $token;
}
for my $token (@values) {
my $value = defined $token->{orig} ? $token->{orig} : $token->{value};
if ($token->{name} eq 'EOL' and not length $value) {
push @list, { name => 'NOEOL', value => '' };
next;
}
push @list, map {
$_ =~ tr/\t/\t/
? { name => 'TAB', value => $_ }
: { name => $token->{name}, value => $_ }
} split m/(\t+)/, $value;
}
}
for my $i (0 .. $#list) {
my $token = $list[ $i ];
my $name = $token->{name};
my $str = $token->{value};
my $trailing_space = 0;
if ($token->{name} eq 'EOL') {
if ($str =~ m/ +([\r\n]|\z)/) {
$token->{name} = "TRAILING_SPACE";
}
}
elsif ($i < $#list) {
if ($name eq 'PLAIN') {
for my $n ($i+1 .. $#list) {
my $next = $list[ $n ];
last if $next->{name} eq 'EOL';
next if $next->{name} =~ m/^(WS|SPACE)$/;
if ($next->{name} eq 'COLON') {
$token->{name} = 'PLAINKEY';
}
}
}
my $next = $list[ $i + 1];
if ($next->{name} eq 'EOL') {
if ($str =~ m/ \z/ and $name =~ m/^(BLOCK_SCALAR_CONTENT|WS|INDENT)$/) {
$token->{name} = "TRAILING_SPACE";
}
}
}
}
return @list;
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Highlight - Syntax highlighting utilities
=head1 SYNOPSIS
use YAML::PP::Highlight qw/ Dump /;
my $highlighted = Dump $data;
=head1 FUNCTIONS
=over
=item Dump
=back
use YAML::PP::Highlight qw/ Dump /;
my $highlighted = Dump $data;
my $highlighted = Dump @docs;
It will dump the given data, and then parse it again to create tokens, which
are then highlighted with ansi colors.
The return value is ansi colored YAML.
YAML-PP-v0.41.0/lib/YAML/PP/PaxHeaders/Exception.pm 0000644 0000000 0000000 00000000132 15214605475 016253 x ustar 00 30 mtime=1781730109.609508467
30 atime=1781730109.609417394
30 ctime=1781730109.609508467
YAML-PP-v0.41.0/lib/YAML/PP/Exception.pm 0000644 0001750 0001750 00000003605 15214605475 015711 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Exception;
our $VERSION = 'v0.41.0'; # 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-v0.41.0/lib/YAML/PP/PaxHeaders/Grammar.pm 0000644 0000000 0000000 00000000131 15214605475 015702 x ustar 00 30 mtime=1781730109.607367404
29 atime=1781730109.60726306
30 ctime=1781730109.607367404
YAML-PP-v0.41.0/lib/YAML/PP/Grammar.pm 0000644 0001750 0001750 00000136105 15214605475 015343 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Grammar;
our $VERSION = 'v0.41.0'; # 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'
},
'WS' => {
'new' => 'FULLNODE'
},
'match' => 'cb_doc_start_explicit'
},
'EOL' => {
'new' => 'DIRECTIVE'
},
'RESERVED_DIRECTIVE' => {
'EOL' => {
'new' => 'DIRECTIVE'
},
'WS' => {
'new' => 'DIRECTIVE'
},
'match' => 'cb_reserved_directive'
},
'TAG_DIRECTIVE' => {
'EOL' => {
'new' => 'DIRECTIVE'
},
'WS' => {
'new' => 'DIRECTIVE'
},
'match' => 'cb_tag_directive'
},
'YAML_DIRECTIVE' => {
'EOL' => {
'new' => 'DIRECTIVE'
},
'WS' => {
'new' => 'DIRECTIVE'
},
'match' => 'cb_set_yaml_version_directive'
}
},
'DOCUMENT_END' => {
'DOC_END' => {
'EOL' => {},
'match' => 'cb_end_document'
},
'DOC_START' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLNODE'
},
'match' => 'cb_end_doc_start_document'
},
'EOL' => {
'new' => 'DOCUMENT_END'
}
},
'END_FLOW' => {
'EOL' => {
'match' => 'cb_end_outer_flow',
'return' => 1
}
},
'FLOWMAP' => {
'ANCHOR' => {
'DEFAULT' => {
'new' => 'NEWFLOWMAP_ANCHOR'
},
'EOL' => {
'new' => 'NEWFLOWMAP_ANCHOR_SPC'
},
'WS' => {
'new' => 'NEWFLOWMAP_ANCHOR_SPC'
},
'match' => 'cb_anchor'
},
'COLON' => {
'EOL' => {
'match' => 'cb_empty_flow_mapkey',
'new' => 'RULE_FULLFLOWSCALAR'
},
'WS' => {
'match' => 'cb_empty_flow_mapkey',
'new' => 'RULE_FULLFLOWSCALAR'
}
},
'DEFAULT' => {
'new' => 'FLOWMAP_CONTENT'
},
'EOL' => {
'new' => 'FLOWMAP'
},
'FLOWMAP_END' => {
'match' => 'cb_end_flowmap',
'return' => 1
},
'TAG' => {
'DEFAULT' => {
'new' => 'NEWFLOWMAP_TAG'
},
'EOL' => {
'new' => 'NEWFLOWMAP_TAG_SPC'
},
'WS' => {
'new' => 'NEWFLOWMAP_TAG_SPC'
},
'match' => 'cb_tag'
},
'WS' => {
'new' => 'FLOWMAP'
}
},
'FLOWMAP_CONTENT' => {
'ALIAS' => {
'match' => 'cb_send_alias',
'return' => 1
},
'COLON' => {
'EOL' => {
'match' => 'cb_empty_flow_mapkey',
'new' => 'RULE_FULLFLOWSCALAR'
},
'WS' => {
'match' => 'cb_empty_flow_mapkey',
'new' => 'RULE_FULLFLOWSCALAR'
}
},
'FLOWMAP_START' => {
'match' => 'cb_start_flowmap',
'new' => 'NEWFLOWMAP'
},
'FLOWSEQ_START' => {
'match' => 'cb_start_flowseq',
'new' => 'NEWFLOWSEQ'
},
'PLAIN' => {
'match' => 'cb_flowkey_plain',
'return' => 1
},
'PLAIN_MULTI' => {
'match' => 'cb_send_plain_multi',
'return' => 1
},
'QUOTED' => {
'match' => 'cb_flowkey_quoted',
'return' => 1
},
'QUOTED_MULTILINE' => {
'match' => 'cb_quoted_multiline',
'return' => 1
}
},
'FLOWMAP_EMPTYKEY' => {
'FLOWMAP_END' => {
'match' => 'cb_end_empty_flowmap_key_value',
'return' => 1
},
'FLOW_COMMA' => {
'match' => 'cb_empty_flowmap_key_value',
'return' => 1
}
},
'FLOWMAP_EXPLICIT_KEY' => {
'DEFAULT' => {
'new' => 'FLOWMAP'
},
'EOL' => {
'new' => 'FLOWMAP_EXPLICIT_KEY'
},
'FLOWMAP_END' => {
'match' => 'cb_end_empty_flowmap_key_value',
'return' => 1
},
'FLOW_COMMA' => {
'match' => 'cb_empty_flowmap_key_value',
'return' => 1
},
'WS' => {
'new' => 'FLOWMAP_EXPLICIT_KEY'
}
},
'FLOWMAP_PROPS' => {
'COLON' => {
'EOL' => {
'match' => 'cb_empty_flow_mapkey',
'new' => 'RULE_FULLFLOWSCALAR'
},
'WS' => {
'match' => 'cb_empty_flow_mapkey',
'new' => 'RULE_FULLFLOWSCALAR'
}
},
'FLOWMAP_END' => {
'match' => 'cb_end_empty_flowmap_key_value',
'return' => 1
},
'FLOWMAP_START' => {
'match' => 'cb_start_flowmap',
'new' => 'NEWFLOWMAP'
},
'FLOWSEQ_START' => {
'match' => 'cb_start_flowseq',
'new' => 'NEWFLOWSEQ'
},
'FLOW_COMMA' => {
'match' => 'cb_empty_flowmap_key_value',
'return' => 1
},
'PLAIN' => {
'match' => 'cb_flowkey_plain',
'return' => 1
},
'PLAIN_MULTI' => {
'match' => 'cb_send_plain_multi',
'return' => 1
},
'QUOTED' => {
'match' => 'cb_flowkey_quoted',
'return' => 1
},
'QUOTED_MULTILINE' => {
'match' => 'cb_quoted_multiline',
'return' => 1
}
},
'FLOWSEQ' => {
'ALIAS' => {
'match' => 'cb_send_flow_alias',
'new' => 'FLOWSEQ_NEXT'
},
'COLON' => {
'EOL' => {
'match' => 'cb_insert_empty_implicit_flowseq_map',
'new' => 'RULE_FULLFLOWSCALAR'
},
'WS' => {
'match' => 'cb_insert_empty_implicit_flowseq_map',
'new' => 'RULE_FULLFLOWSCALAR'
}
},
'FLOWMAP_START' => {
'match' => 'cb_start_flowmap',
'new' => 'NEWFLOWMAP'
},
'FLOWSEQ_START' => {
'match' => 'cb_start_flowseq',
'new' => 'NEWFLOWSEQ'
},
'PLAIN' => {
'DEFAULT' => {
'new' => 'FLOWSEQ_MAYBE_KEY'
},
'EOL' => {
'match' => 'cb_send_scalar',
'new' => 'FLOWSEQ_NEXT'
},
'match' => 'cb_start_plain'
},
'PLAIN_MULTI' => {
'match' => 'cb_send_plain_multi',
'new' => 'FLOWSEQ_NEXT'
},
'QUOTED' => {
'DEFAULT' => {
'new' => 'FLOWSEQ_MAYBE_KEY'
},
'EOL' => {
'match' => 'cb_send_scalar',
'new' => 'FLOWSEQ_NEXT'
},
'match' => 'cb_take_quoted'
},
'QUOTED_MULTILINE' => {
'match' => 'cb_quoted_multiline',
'new' => 'FLOWSEQ_NEXT'
}
},
'FLOWSEQ_EMPTY' => {
'FLOWSEQ_END' => {
'match' => 'cb_empty_flowseq_end',
'return' => 1
},
'FLOW_COMMA' => {
'match' => 'cb_empty_flowseq_comma',
'return' => 1
}
},
'FLOWSEQ_MAYBE_KEY' => {
'COLON' => {
'DEFAULT' => {
'match' => 'cb_insert_implicit_flowseq_map',
'new' => 'RULE_FULLFLOWSCALAR'
},
'EOL' => {
'match' => 'cb_insert_implicit_flowseq_map',
'new' => 'RULE_FULLFLOWSCALAR'
},
'WS' => {
'match' => 'cb_insert_implicit_flowseq_map',
'new' => 'RULE_FULLFLOWSCALAR'
}
},
'DEFAULT' => {
'new' => 'FLOWSEQ_NEXT'
},
'WS' => {
'new' => 'FLOWSEQ_MAYBE_KEY'
}
},
'FLOWSEQ_NEXT' => {
'EOL' => {
'new' => 'FLOWSEQ_NEXT'
},
'FLOWSEQ_END' => {
'match' => 'cb_end_flowseq',
'return' => 1
},
'FLOW_COMMA' => {
'match' => 'cb_flow_comma',
'return' => 1
},
'WS' => {
'new' => 'FLOWSEQ_NEXT'
}
},
'FLOWSEQ_PROPS' => {
'COLON' => {
'EOL' => {
'match' => 'cb_insert_empty_implicit_flowseq_map',
'new' => 'RULE_FULLFLOWSCALAR'
},
'WS' => {
'match' => 'cb_insert_empty_implicit_flowseq_map',
'new' => 'RULE_FULLFLOWSCALAR'
}
},
'FLOWMAP_START' => {
'match' => 'cb_start_flowmap',
'new' => 'NEWFLOWMAP'
},
'FLOWSEQ_END' => {
'match' => 'cb_empty_flowseq_end',
'return' => 1
},
'FLOWSEQ_START' => {
'match' => 'cb_start_flowseq',
'new' => 'NEWFLOWSEQ'
},
'FLOW_COMMA' => {
'match' => 'cb_empty_flowseq_comma',
'return' => 1
},
'PLAIN' => {
'DEFAULT' => {
'new' => 'FLOWSEQ_MAYBE_KEY'
},
'EOL' => {
'match' => 'cb_send_scalar',
'new' => 'FLOWSEQ_NEXT'
},
'match' => 'cb_start_plain'
},
'PLAIN_MULTI' => {
'match' => 'cb_send_plain_multi',
'new' => 'FLOWSEQ_NEXT'
},
'QUOTED' => {
'DEFAULT' => {
'new' => 'FLOWSEQ_MAYBE_KEY'
},
'EOL' => {
'match' => 'cb_send_scalar',
'new' => 'FLOWSEQ_NEXT'
},
'match' => 'cb_take_quoted'
},
'QUOTED_MULTILINE' => {
'match' => 'cb_quoted_multiline',
'new' => 'FLOWSEQ_NEXT'
}
},
'FULLMAPVALUE_INLINE' => {
'ANCHOR' => {
'EOL' => {
'match' => 'cb_property_eol',
'new' => 'FULLNODE_ANCHOR'
},
'WS' => {
'DEFAULT' => {
'new' => 'NODETYPE_MAPVALUE_INLINE'
},
'TAG' => {
'EOL' => {
'match' => 'cb_property_eol',
'new' => 'FULLNODE_TAG_ANCHOR'
},
'WS' => {
'new' => 'NODETYPE_MAPVALUE_INLINE'
},
'match' => 'cb_tag'
}
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'NODETYPE_MAPVALUE_INLINE'
},
'TAG' => {
'EOL' => {
'match' => 'cb_property_eol',
'new' => 'FULLNODE_TAG'
},
'WS' => {
'ANCHOR' => {
'EOL' => {
'match' => 'cb_property_eol',
'new' => 'FULLNODE_TAG_ANCHOR'
},
'WS' => {
'new' => 'NODETYPE_MAPVALUE_INLINE'
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'NODETYPE_MAPVALUE_INLINE'
}
},
'match' => 'cb_tag'
}
},
'FULLNODE' => {
'ANCHOR' => {
'EOL' => {
'match' => 'cb_property_eol',
'new' => 'FULLNODE_ANCHOR'
},
'WS' => {
'DEFAULT' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
},
'TAG' => {
'EOL' => {
'match' => 'cb_property_eol',
'new' => 'FULLNODE_TAG_ANCHOR'
},
'WS' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
},
'match' => 'cb_tag'
}
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'NODETYPE_NODE'
},
'EOL' => {
'new' => 'FULLNODE'
},
'TAG' => {
'EOL' => {
'match' => 'cb_property_eol',
'new' => 'FULLNODE_TAG'
},
'WS' => {
'ANCHOR' => {
'EOL' => {
'match' => 'cb_property_eol',
'new' => 'FULLNODE_TAG_ANCHOR'
},
'WS' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
}
},
'match' => 'cb_tag'
}
},
'FULLNODE_ANCHOR' => {
'ANCHOR' => {
'WS' => {
'DEFAULT' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
},
'TAG' => {
'WS' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
},
'match' => 'cb_tag'
}
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'NODETYPE_NODE'
},
'EOL' => {
'new' => 'FULLNODE_ANCHOR'
},
'TAG' => {
'EOL' => {
'match' => 'cb_property_eol',
'new' => 'FULLNODE_TAG_ANCHOR'
},
'WS' => {
'ANCHOR' => {
'WS' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
}
},
'match' => 'cb_tag'
}
},
'FULLNODE_TAG' => {
'ANCHOR' => {
'EOL' => {
'match' => 'cb_property_eol',
'new' => 'FULLNODE_TAG_ANCHOR'
},
'WS' => {
'DEFAULT' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
},
'TAG' => {
'WS' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
},
'match' => 'cb_tag'
}
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'NODETYPE_NODE'
},
'EOL' => {
'new' => 'FULLNODE_TAG'
},
'TAG' => {
'WS' => {
'ANCHOR' => {
'WS' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
}
},
'match' => 'cb_tag'
}
},
'FULLNODE_TAG_ANCHOR' => {
'ANCHOR' => {
'WS' => {
'DEFAULT' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
},
'TAG' => {
'WS' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
},
'match' => 'cb_tag'
}
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'NODETYPE_NODE'
},
'EOL' => {
'new' => 'FULLNODE_TAG_ANCHOR'
},
'TAG' => {
'WS' => {
'ANCHOR' => {
'WS' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
}
},
'match' => 'cb_tag'
}
},
'NEWFLOWMAP' => {
'DEFAULT' => {
'new' => 'FLOWMAP'
},
'EOL' => {
'new' => 'NEWFLOWMAP'
},
'QUESTION' => {
'match' => 'cb_flow_question',
'new' => 'FLOWMAP_EXPLICIT_KEY'
},
'WS' => {
'new' => 'NEWFLOWMAP'
}
},
'NEWFLOWMAP_ANCHOR' => {
'DEFAULT' => {
'new' => 'FLOWMAP_EMPTYKEY'
}
},
'NEWFLOWMAP_ANCHOR_SPC' => {
'DEFAULT' => {
'new' => 'FLOWMAP_PROPS'
},
'EOL' => {
'new' => 'NEWFLOWMAP_ANCHOR_SPC'
},
'TAG' => {
'DEFAULT' => {
'new' => 'FLOWMAP_EMPTYKEY'
},
'EOL' => {
'new' => 'FLOWMAP_PROPS'
},
'WS' => {
'new' => 'FLOWMAP_PROPS'
},
'match' => 'cb_tag'
},
'WS' => {
'new' => 'NEWFLOWMAP_ANCHOR_SPC'
}
},
'NEWFLOWMAP_TAG' => {
'DEFAULT' => {
'new' => 'FLOWMAP_EMPTYKEY'
}
},
'NEWFLOWMAP_TAG_SPC' => {
'ANCHOR' => {
'DEFAULT' => {
'new' => 'FLOWMAP_EMPTYKEY'
},
'EOL' => {
'new' => 'FLOWMAP_PROPS'
},
'WS' => {
'new' => 'FLOWMAP_PROPS'
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'FLOWMAP_PROPS'
},
'EOL' => {
'new' => 'NEWFLOWMAP_TAG_SPC'
},
'WS' => {
'new' => 'NEWFLOWMAP_TAG_SPC'
}
},
'NEWFLOWSEQ' => {
'ANCHOR' => {
'DEFAULT' => {
'new' => 'NEWFLOWSEQ_ANCHOR'
},
'EOL' => {
'new' => 'NEWFLOWSEQ_ANCHOR_SPC'
},
'WS' => {
'new' => 'NEWFLOWSEQ_ANCHOR_SPC'
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'FLOWSEQ'
},
'EOL' => {
'new' => 'NEWFLOWSEQ'
},
'FLOWSEQ_END' => {
'match' => 'cb_end_flowseq',
'return' => 1
},
'TAG' => {
'DEFAULT' => {
'new' => 'NEWFLOWSEQ_TAG'
},
'EOL' => {
'new' => 'NEWFLOWSEQ_TAG_SPC'
},
'WS' => {
'new' => 'NEWFLOWSEQ_TAG_SPC'
},
'match' => 'cb_tag'
},
'WS' => {
'new' => 'NEWFLOWSEQ'
}
},
'NEWFLOWSEQ_ANCHOR' => {
'DEFAULT' => {
'new' => 'FLOWSEQ_EMPTY'
}
},
'NEWFLOWSEQ_ANCHOR_SPC' => {
'DEFAULT' => {
'new' => 'FLOWSEQ_PROPS'
},
'EOL' => {
'new' => 'NEWFLOWSEQ_ANCHOR_SPC'
},
'TAG' => {
'DEFAULT' => {
'new' => 'FLOWSEQ_EMPTY'
},
'EOL' => {
'new' => 'FLOWSEQ_PROPS'
},
'WS' => {
'new' => 'FLOWSEQ_PROPS'
},
'match' => 'cb_tag'
},
'WS' => {
'new' => 'NEWFLOWSEQ_ANCHOR_SPC'
}
},
'NEWFLOWSEQ_TAG' => {
'DEFAULT' => {
'new' => 'FLOWSEQ_EMPTY'
}
},
'NEWFLOWSEQ_TAG_SPC' => {
'ANCHOR' => {
'DEFAULT' => {
'new' => 'FLOWSEQ_EMPTY'
},
'EOL' => {
'new' => 'FLOWSEQ_PROPS'
},
'WS' => {
'new' => 'FLOWSEQ_PROPS'
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'FLOWSEQ_PROPS'
},
'EOL' => {
'new' => 'NEWFLOWSEQ_TAG_SPC'
},
'WS' => {
'new' => 'NEWFLOWSEQ_TAG_SPC'
}
},
'NODETYPE_COMPLEX' => {
'COLON' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLNODE'
},
'match' => 'cb_complexcolon'
},
'DEFAULT' => {
'match' => 'cb_empty_complexvalue',
'new' => 'NODETYPE_MAP'
},
'EOL' => {
'new' => 'NODETYPE_COMPLEX'
}
},
'NODETYPE_FLOWMAP' => {
'DEFAULT' => {
'new' => 'NEWFLOWMAP'
},
'EOL' => {
'new' => 'NODETYPE_FLOWMAP'
},
'FLOWMAP_END' => {
'match' => 'cb_end_flowmap',
'return' => 1
},
'FLOW_COMMA' => {
'match' => 'cb_flow_comma',
'new' => 'NEWFLOWMAP'
},
'WS' => {
'new' => 'NODETYPE_FLOWMAP'
}
},
'NODETYPE_FLOWMAPVALUE' => {
'COLON' => {
'DEFAULT' => {
'new' => 'RULE_FULLFLOWSCALAR'
},
'EOL' => {
'new' => 'RULE_FULLFLOWSCALAR'
},
'WS' => {
'new' => 'RULE_FULLFLOWSCALAR'
},
'match' => 'cb_flow_colon'
},
'EOL' => {
'new' => 'NODETYPE_FLOWMAPVALUE'
},
'FLOWMAP_END' => {
'match' => 'cb_end_flowmap_empty',
'return' => 1
},
'FLOW_COMMA' => {
'match' => 'cb_empty_flowmap_value',
'return' => 1
},
'WS' => {
'new' => 'NODETYPE_FLOWMAPVALUE'
}
},
'NODETYPE_FLOWSEQ' => {
'DEFAULT' => {
'new' => 'NEWFLOWSEQ'
},
'EOL' => {
'new' => 'NODETYPE_FLOWSEQ'
},
'FLOWSEQ_END' => {
'match' => 'cb_end_flowseq',
'return' => 1
},
'WS' => {
'new' => 'NODETYPE_FLOWSEQ'
}
},
'NODETYPE_MAP' => {
'ANCHOR' => {
'WS' => {
'DEFAULT' => {
'new' => 'RULE_MAPKEY'
},
'TAG' => {
'WS' => {
'new' => 'RULE_MAPKEY'
},
'match' => 'cb_tag'
}
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'RULE_MAPKEY'
},
'TAG' => {
'WS' => {
'ANCHOR' => {
'WS' => {
'new' => 'RULE_MAPKEY'
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'RULE_MAPKEY'
}
},
'match' => 'cb_tag'
}
},
'NODETYPE_MAPVALUE_INLINE' => {
'ALIAS' => {
'EOL' => {},
'match' => 'cb_send_alias'
},
'BLOCK_SCALAR' => {
'EOL' => {},
'match' => 'cb_send_block_scalar'
},
'DOC_END' => {
'EOL' => {},
'match' => 'cb_end_document'
},
'FLOWMAP_START' => {
'match' => 'cb_start_flowmap',
'new' => 'NEWFLOWMAP'
},
'FLOWSEQ_START' => {
'match' => 'cb_start_flowseq',
'new' => 'NEWFLOWSEQ'
},
'PLAIN' => {
'EOL' => {
'match' => 'cb_send_scalar'
},
'match' => 'cb_start_plain'
},
'PLAIN_MULTI' => {
'EOL' => {},
'match' => 'cb_send_plain_multi'
},
'QUOTED' => {
'EOL' => {
'match' => 'cb_send_scalar'
},
'match' => 'cb_take_quoted'
},
'QUOTED_MULTILINE' => {
'EOL' => {},
'match' => 'cb_quoted_multiline'
}
},
'NODETYPE_NODE' => {
'DASH' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLNODE'
},
'match' => 'cb_seqstart'
},
'DEFAULT' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
}
},
'NODETYPE_SCALAR_OR_MAP' => {
'ALIAS' => {
'EOL' => {
'match' => 'cb_send_alias_from_stack'
},
'WS' => {
'COLON' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLMAPVALUE_INLINE'
},
'match' => 'cb_insert_map_alias'
}
},
'match' => 'cb_alias'
},
'BLOCK_SCALAR' => {
'EOL' => {},
'match' => 'cb_send_block_scalar'
},
'COLON' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLMAPVALUE_INLINE'
},
'match' => 'cb_insert_empty_map'
},
'DOC_END' => {
'EOL' => {},
'match' => 'cb_end_document'
},
'DOC_START' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLNODE'
},
'match' => 'cb_end_doc_start_document'
},
'EOL' => {
'new' => 'NODETYPE_SCALAR_OR_MAP'
},
'FLOWMAP_START' => {
'match' => 'cb_start_flowmap',
'new' => 'NEWFLOWMAP'
},
'FLOWSEQ_START' => {
'match' => 'cb_start_flowseq',
'new' => 'NEWFLOWSEQ'
},
'PLAIN' => {
'COLON' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLMAPVALUE_INLINE'
},
'match' => 'cb_insert_map'
},
'EOL' => {
'match' => 'cb_send_scalar'
},
'WS' => {
'COLON' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLMAPVALUE_INLINE'
},
'match' => 'cb_insert_map'
}
},
'match' => 'cb_start_plain'
},
'PLAIN_MULTI' => {
'EOL' => {},
'match' => 'cb_send_plain_multi'
},
'QUESTION' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLNODE'
},
'match' => 'cb_questionstart'
},
'QUOTED' => {
'COLON' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLMAPVALUE_INLINE'
},
'match' => 'cb_insert_map'
},
'EOL' => {
'match' => 'cb_send_scalar'
},
'WS' => {
'COLON' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLMAPVALUE_INLINE'
},
'match' => 'cb_insert_map'
}
},
'match' => 'cb_take_quoted'
},
'QUOTED_MULTILINE' => {
'EOL' => {},
'match' => 'cb_quoted_multiline'
},
'WS' => {
'new' => 'FULLMAPVALUE_INLINE'
}
},
'NODETYPE_SEQ' => {
'DASH' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLNODE'
},
'match' => 'cb_seqitem'
},
'DOC_END' => {
'EOL' => {},
'match' => 'cb_end_document'
},
'DOC_START' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLNODE'
},
'match' => 'cb_end_doc_start_document'
},
'EOL' => {
'new' => 'NODETYPE_SEQ'
}
},
'RULE_FLOWSCALAR' => {
'ALIAS' => {
'match' => 'cb_send_alias',
'return' => 1
},
'FLOWMAP_END' => {
'match' => 'cb_end_flowmap_empty',
'return' => 1
},
'FLOWMAP_START' => {
'match' => 'cb_start_flowmap',
'new' => 'NEWFLOWMAP'
},
'FLOWSEQ_START' => {
'match' => 'cb_start_flowseq',
'new' => 'NEWFLOWSEQ'
},
'FLOW_COMMA' => {
'match' => 'cb_empty_flow_mapkey',
'return' => 1
},
'PLAIN' => {
'DEFAULT' => {
'match' => 'cb_send_scalar',
'return' => 1
},
'EOL' => {
'match' => 'cb_send_scalar'
},
'match' => 'cb_start_plain'
},
'PLAIN_MULTI' => {
'match' => 'cb_send_plain_multi',
'return' => 1
},
'QUOTED' => {
'DEFAULT' => {
'match' => 'cb_send_scalar',
'return' => 1
},
'EOL' => {
'match' => 'cb_send_scalar'
},
'WS' => {
'match' => 'cb_send_scalar',
'return' => 1
},
'match' => 'cb_take_quoted'
},
'QUOTED_MULTILINE' => {
'match' => 'cb_quoted_multiline',
'return' => 1
}
},
'RULE_FULLFLOWSCALAR' => {
'ANCHOR' => {
'DEFAULT' => {
'new' => 'RULE_FULLFLOWSCALAR_ANCHOR'
},
'EOL' => {
'new' => 'RULE_FULLFLOWSCALAR_ANCHOR'
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'RULE_FLOWSCALAR'
},
'TAG' => {
'DEFAULT' => {
'new' => 'RULE_FULLFLOWSCALAR_TAG'
},
'EOL' => {
'new' => 'RULE_FULLFLOWSCALAR_TAG'
},
'match' => 'cb_tag'
}
},
'RULE_FULLFLOWSCALAR_ANCHOR' => {
'DEFAULT' => {
'new' => 'RULE_FLOWSCALAR'
},
'TAG' => {
'EOL' => {
'new' => 'RULE_FLOWSCALAR'
},
'WS' => {
'new' => 'RULE_FLOWSCALAR'
},
'match' => 'cb_tag'
},
'WS' => {
'new' => 'RULE_FULLFLOWSCALAR_ANCHOR'
}
},
'RULE_FULLFLOWSCALAR_TAG' => {
'ANCHOR' => {
'EOL' => {
'new' => 'RULE_FLOWSCALAR'
},
'WS' => {
'new' => 'RULE_FLOWSCALAR'
},
'match' => 'cb_anchor'
},
'DEFAULT' => {
'new' => 'RULE_FLOWSCALAR'
},
'WS' => {
'new' => 'RULE_FULLFLOWSCALAR_TAG'
}
},
'RULE_MAPKEY' => {
'ALIAS' => {
'WS' => {
'COLON' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLMAPVALUE_INLINE'
}
}
},
'match' => 'cb_send_alias_key'
},
'COLON' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLMAPVALUE_INLINE'
},
'match' => 'cb_empty_mapkey'
},
'DOC_END' => {
'EOL' => {},
'match' => 'cb_end_document'
},
'DOC_START' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLNODE'
},
'match' => 'cb_end_doc_start_document'
},
'EOL' => {
'new' => 'RULE_MAPKEY'
},
'PLAIN' => {
'COLON' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLMAPVALUE_INLINE'
},
'match' => 'cb_send_mapkey'
},
'WS' => {
'COLON' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLMAPVALUE_INLINE'
},
'match' => 'cb_send_mapkey'
}
},
'match' => 'cb_mapkey'
},
'QUESTION' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLNODE'
},
'match' => 'cb_question'
},
'QUOTED' => {
'COLON' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLMAPVALUE_INLINE'
}
},
'WS' => {
'COLON' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLMAPVALUE_INLINE'
}
}
},
'match' => 'cb_take_quoted_key'
}
},
'STREAM' => {
'DEFAULT' => {
'match' => 'cb_doc_start_implicit',
'new' => 'FULLNODE'
},
'DOC_END' => {
'EOL' => {},
'match' => 'cb_end_document_empty'
},
'DOC_START' => {
'EOL' => {
'new' => 'FULLNODE'
},
'WS' => {
'new' => 'FULLNODE'
},
'match' => 'cb_doc_start_explicit'
},
'EOL' => {
'new' => 'STREAM'
},
'RESERVED_DIRECTIVE' => {
'EOL' => {
'new' => 'DIRECTIVE'
},
'WS' => {
'new' => 'DIRECTIVE'
},
'match' => 'cb_reserved_directive'
},
'TAG_DIRECTIVE' => {
'EOL' => {
'new' => 'DIRECTIVE'
},
'WS' => {
'new' => 'DIRECTIVE'
},
'match' => 'cb_tag_directive'
},
'YAML_DIRECTIVE' => {
'EOL' => {
'new' => 'DIRECTIVE'
},
'WS' => {
'new' => 'DIRECTIVE'
},
'match' => 'cb_set_yaml_version_directive'
}
}
};
# END OF GRAMMAR INLINE
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Grammar - YAML grammar
=head1 GRAMMAR
This is the Grammar in YAML
# START OF YAML INLINE
# DO NOT CHANGE THIS
# This grammar is automatically generated from etc/grammar.yaml
---
NODETYPE_NODE:
DASH:
match: cb_seqstart
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
NODETYPE_SCALAR_OR_MAP:
# Flow nodes can follow tabs
WS: { new: FULLMAPVALUE_INLINE }
ALIAS:
match: cb_alias
EOL: { match: cb_send_alias_from_stack }
WS:
COLON:
match: cb_insert_map_alias
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
QUESTION:
match: cb_questionstart
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
QUOTED:
match: cb_take_quoted
EOL: { match: cb_send_scalar }
WS:
COLON:
match: cb_insert_map
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
COLON:
match: cb_insert_map
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
QUOTED_MULTILINE:
match: cb_quoted_multiline
EOL: { }
PLAIN:
match: cb_start_plain
EOL:
match: cb_send_scalar
WS:
COLON:
match: cb_insert_map
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
COLON:
match: cb_insert_map
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
PLAIN_MULTI:
match: cb_send_plain_multi
EOL: { }
COLON:
match: cb_insert_empty_map
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
BLOCK_SCALAR:
match: cb_send_block_scalar
EOL: { }
FLOWSEQ_START:
match: cb_start_flowseq
new: NEWFLOWSEQ
FLOWMAP_START:
match: cb_start_flowmap
new: NEWFLOWMAP
DOC_END:
match: cb_end_document
EOL: { }
DOC_START:
match: cb_end_doc_start_document
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
EOL:
new: NODETYPE_SCALAR_OR_MAP
NODETYPE_COMPLEX:
COLON:
match: cb_complexcolon
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
DEFAULT:
match: cb_empty_complexvalue
new: NODETYPE_MAP
EOL:
new: NODETYPE_COMPLEX
RULE_FULLFLOWSCALAR:
ANCHOR:
match: cb_anchor
EOL: { new: RULE_FULLFLOWSCALAR_ANCHOR }
DEFAULT: { new: RULE_FULLFLOWSCALAR_ANCHOR }
TAG:
match: cb_tag
EOL: { new: RULE_FULLFLOWSCALAR_TAG }
DEFAULT: { new: RULE_FULLFLOWSCALAR_TAG }
DEFAULT: { new: RULE_FLOWSCALAR }
RULE_FULLFLOWSCALAR_ANCHOR:
WS: { new: RULE_FULLFLOWSCALAR_ANCHOR }
TAG:
match: cb_tag
WS: { new: RULE_FLOWSCALAR }
EOL: { new: RULE_FLOWSCALAR }
DEFAULT: { new: RULE_FLOWSCALAR }
RULE_FULLFLOWSCALAR_TAG:
WS: { new: RULE_FULLFLOWSCALAR_TAG }
ANCHOR:
match: cb_anchor
WS: { new: RULE_FLOWSCALAR }
EOL: { new: RULE_FLOWSCALAR }
DEFAULT: { new: RULE_FLOWSCALAR }
RULE_FLOWSCALAR:
FLOWSEQ_START: { match: cb_start_flowseq, new: NEWFLOWSEQ }
FLOWMAP_START: { match: cb_start_flowmap, new: NEWFLOWMAP }
ALIAS: { match: cb_send_alias, return: 1 }
QUOTED:
match: cb_take_quoted
EOL: { match: cb_send_scalar }
WS: { match: cb_send_scalar, return: 1 }
DEFAULT: { match: cb_send_scalar, return: 1 }
QUOTED_MULTILINE: { match: cb_quoted_multiline, return: 1 }
PLAIN:
match: cb_start_plain
EOL: { match: cb_send_scalar }
DEFAULT: { match: cb_send_scalar, return: 1 }
PLAIN_MULTI: { match: cb_send_plain_multi, return: 1 }
FLOW_COMMA: { match: cb_empty_flow_mapkey, return: 1 }
FLOWMAP_END:
match: cb_end_flowmap_empty
return: 1
FLOWSEQ:
FLOWSEQ_START: { match: cb_start_flowseq, new: NEWFLOWSEQ }
FLOWMAP_START: { match: cb_start_flowmap, new: NEWFLOWMAP }
ALIAS: { match: cb_send_flow_alias, new: FLOWSEQ_NEXT }
PLAIN:
match: cb_start_plain
EOL:
match: cb_send_scalar
new: FLOWSEQ_NEXT
DEFAULT:
new: FLOWSEQ_MAYBE_KEY
PLAIN_MULTI: { match: cb_send_plain_multi, new: FLOWSEQ_NEXT }
QUOTED:
match: cb_take_quoted
EOL:
match: cb_send_scalar
new: FLOWSEQ_NEXT
DEFAULT:
new: FLOWSEQ_MAYBE_KEY
QUOTED_MULTILINE: { match: cb_quoted_multiline, new: FLOWSEQ_NEXT }
COLON:
WS:
match: cb_insert_empty_implicit_flowseq_map
new: RULE_FULLFLOWSCALAR
EOL:
match: cb_insert_empty_implicit_flowseq_map
new: RULE_FULLFLOWSCALAR
FLOWSEQ_PROPS:
FLOWSEQ_START: { match: cb_start_flowseq, new: NEWFLOWSEQ }
FLOWMAP_START: { match: cb_start_flowmap, new: NEWFLOWMAP }
PLAIN:
match: cb_start_plain
EOL:
match: cb_send_scalar
new: FLOWSEQ_NEXT
DEFAULT:
new: FLOWSEQ_MAYBE_KEY
PLAIN_MULTI: { match: cb_send_plain_multi, new: FLOWSEQ_NEXT }
QUOTED:
match: cb_take_quoted
EOL:
match: cb_send_scalar
new: FLOWSEQ_NEXT
DEFAULT:
new: FLOWSEQ_MAYBE_KEY
QUOTED_MULTILINE: { match: cb_quoted_multiline, new: FLOWSEQ_NEXT }
FLOW_COMMA:
match: cb_empty_flowseq_comma
return: 1
FLOWSEQ_END:
match: cb_empty_flowseq_end
return: 1
COLON:
WS:
match: cb_insert_empty_implicit_flowseq_map
new: RULE_FULLFLOWSCALAR
EOL:
match: cb_insert_empty_implicit_flowseq_map
new: RULE_FULLFLOWSCALAR
FLOWSEQ_EMPTY:
FLOW_COMMA:
match: cb_empty_flowseq_comma
return: 1
FLOWSEQ_END:
match: cb_empty_flowseq_end
return: 1
FLOWSEQ_NEXT:
WS: { new: FLOWSEQ_NEXT }
EOL: { new: FLOWSEQ_NEXT }
FLOW_COMMA:
match: cb_flow_comma
return: 1
FLOWSEQ_END:
match: cb_end_flowseq
return: 1
FLOWSEQ_MAYBE_KEY:
WS: { new: FLOWSEQ_MAYBE_KEY }
COLON:
WS:
match: cb_insert_implicit_flowseq_map
new: RULE_FULLFLOWSCALAR
EOL:
match: cb_insert_implicit_flowseq_map
new: RULE_FULLFLOWSCALAR
DEFAULT:
match: cb_insert_implicit_flowseq_map
new: RULE_FULLFLOWSCALAR
DEFAULT:
new: FLOWSEQ_NEXT
FLOWMAP_CONTENT:
FLOWSEQ_START: { match: cb_start_flowseq, new: NEWFLOWSEQ }
FLOWMAP_START: { match: cb_start_flowmap, new: NEWFLOWMAP }
ALIAS: { match: cb_send_alias, return: 1 }
PLAIN: { match: cb_flowkey_plain, return: 1 }
PLAIN_MULTI: { match: cb_send_plain_multi, return: 1 }
QUOTED: { match: cb_flowkey_quoted, return: 1 }
QUOTED_MULTILINE: { match: cb_quoted_multiline, return: 1 }
COLON:
WS:
match: cb_empty_flow_mapkey
new: RULE_FULLFLOWSCALAR
EOL:
match: cb_empty_flow_mapkey
new: RULE_FULLFLOWSCALAR
FLOWMAP_PROPS:
FLOWSEQ_START: { match: cb_start_flowseq, new: NEWFLOWSEQ }
FLOWMAP_START: { match: cb_start_flowmap, new: NEWFLOWMAP }
PLAIN: { match: cb_flowkey_plain, return: 1 }
PLAIN_MULTI: { match: cb_send_plain_multi, return: 1 }
QUOTED: { match: cb_flowkey_quoted, return: 1 }
QUOTED_MULTILINE: { match: cb_quoted_multiline, return: 1 }
COLON:
WS:
match: cb_empty_flow_mapkey
new: RULE_FULLFLOWSCALAR
EOL:
match: cb_empty_flow_mapkey
new: RULE_FULLFLOWSCALAR
FLOW_COMMA:
match: cb_empty_flowmap_key_value
return: 1
FLOWMAP_END:
match: cb_end_empty_flowmap_key_value
return: 1
FLOWMAP_EMPTYKEY:
FLOW_COMMA:
match: cb_empty_flowmap_key_value
return: 1
FLOWMAP_END:
match: cb_end_empty_flowmap_key_value
return: 1
NEWFLOWSEQ:
EOL: { new: NEWFLOWSEQ }
WS: { new: NEWFLOWSEQ }
ANCHOR:
match: cb_anchor
WS: { new: NEWFLOWSEQ_ANCHOR_SPC }
EOL: { new: NEWFLOWSEQ_ANCHOR_SPC }
DEFAULT: { new: NEWFLOWSEQ_ANCHOR }
TAG:
match: cb_tag
WS: { new: NEWFLOWSEQ_TAG_SPC }
EOL: { new: NEWFLOWSEQ_TAG_SPC }
DEFAULT: { new: NEWFLOWSEQ_TAG }
FLOWSEQ_END:
match: cb_end_flowseq
return: 1
DEFAULT: { new: FLOWSEQ }
NODETYPE_FLOWSEQ:
EOL: { new: NODETYPE_FLOWSEQ }
WS: { new: NODETYPE_FLOWSEQ }
FLOWSEQ_END:
match: cb_end_flowseq
return: 1
DEFAULT: { new: NEWFLOWSEQ }
NODETYPE_FLOWMAPVALUE:
WS: { new: NODETYPE_FLOWMAPVALUE }
EOL: { new: NODETYPE_FLOWMAPVALUE }
COLON:
match: cb_flow_colon
WS: { new: RULE_FULLFLOWSCALAR }
EOL: { new: RULE_FULLFLOWSCALAR }
DEFAULT: { new: RULE_FULLFLOWSCALAR }
FLOW_COMMA:
match: cb_empty_flowmap_value
return: 1
FLOWMAP_END:
match: cb_end_flowmap_empty
return: 1
NEWFLOWSEQ_ANCHOR:
DEFAULT: { new: FLOWSEQ_EMPTY }
NEWFLOWSEQ_TAG:
DEFAULT: { new: FLOWSEQ_EMPTY }
NEWFLOWSEQ_ANCHOR_SPC:
WS: { new: NEWFLOWSEQ_ANCHOR_SPC }
EOL: { new: NEWFLOWSEQ_ANCHOR_SPC }
TAG:
match: cb_tag
WS: { new: FLOWSEQ_PROPS }
EOL: { new: FLOWSEQ_PROPS }
DEFAULT: { new: FLOWSEQ_EMPTY }
DEFAULT: { new: FLOWSEQ_PROPS }
NEWFLOWSEQ_TAG_SPC:
WS: { new: NEWFLOWSEQ_TAG_SPC }
EOL: { new: NEWFLOWSEQ_TAG_SPC }
ANCHOR:
match: cb_anchor
WS: { new: FLOWSEQ_PROPS }
EOL: { new: FLOWSEQ_PROPS }
DEFAULT: { new: FLOWSEQ_EMPTY }
DEFAULT: { new: FLOWSEQ_PROPS }
NEWFLOWMAP_ANCHOR:
DEFAULT: { new: FLOWMAP_EMPTYKEY }
NEWFLOWMAP_TAG:
DEFAULT: { new: FLOWMAP_EMPTYKEY }
NEWFLOWMAP_ANCHOR_SPC:
WS: { new: NEWFLOWMAP_ANCHOR_SPC }
EOL: { new: NEWFLOWMAP_ANCHOR_SPC }
TAG:
match: cb_tag
WS: { new: FLOWMAP_PROPS }
EOL: { new: FLOWMAP_PROPS }
DEFAULT: { new: FLOWMAP_EMPTYKEY }
DEFAULT: { new: FLOWMAP_PROPS }
NEWFLOWMAP_TAG_SPC:
WS: { new: NEWFLOWMAP_TAG_SPC }
EOL: { new: NEWFLOWMAP_TAG_SPC }
ANCHOR:
match: cb_anchor
WS: { new: FLOWMAP_PROPS }
EOL: { new: FLOWMAP_PROPS }
DEFAULT: { new: FLOWMAP_EMPTYKEY }
DEFAULT: { new: FLOWMAP_PROPS }
NEWFLOWMAP:
EOL: { new: NEWFLOWMAP }
WS: { new: NEWFLOWMAP }
QUESTION: { match: cb_flow_question, new: FLOWMAP_EXPLICIT_KEY }
DEFAULT: { new: FLOWMAP }
FLOWMAP_EXPLICIT_KEY:
WS: { new: FLOWMAP_EXPLICIT_KEY }
EOL: { new: FLOWMAP_EXPLICIT_KEY }
FLOWMAP_END:
match: cb_end_empty_flowmap_key_value
return: 1
FLOW_COMMA:
match: cb_empty_flowmap_key_value
return: 1
DEFAULT: { new: FLOWMAP }
FLOWMAP:
EOL: { new: FLOWMAP }
WS: { new: FLOWMAP }
ANCHOR:
match: cb_anchor
WS: { new: NEWFLOWMAP_ANCHOR_SPC }
EOL: { new: NEWFLOWMAP_ANCHOR_SPC }
DEFAULT: { new: NEWFLOWMAP_ANCHOR }
TAG:
match: cb_tag
WS: { new: NEWFLOWMAP_TAG_SPC }
EOL: { new: NEWFLOWMAP_TAG_SPC }
DEFAULT: { new: NEWFLOWMAP_TAG }
FLOWMAP_END:
match: cb_end_flowmap
return: 1
COLON:
WS:
match: cb_empty_flow_mapkey
new: RULE_FULLFLOWSCALAR
EOL:
match: cb_empty_flow_mapkey
new: RULE_FULLFLOWSCALAR
DEFAULT: { new: FLOWMAP_CONTENT }
NODETYPE_FLOWMAP:
EOL: { new: NODETYPE_FLOWMAP }
WS: { new: NODETYPE_FLOWMAP }
FLOWMAP_END:
match: cb_end_flowmap
return: 1
FLOW_COMMA: { match: cb_flow_comma, new: NEWFLOWMAP }
DEFAULT: { new: NEWFLOWMAP }
END_FLOW:
EOL:
match: cb_end_outer_flow
return: 1
RULE_MAPKEY:
QUESTION:
match: cb_question
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
ALIAS:
match: cb_send_alias_key
WS:
COLON:
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
QUOTED:
match: cb_take_quoted_key
WS:
COLON:
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
COLON:
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
PLAIN:
match: cb_mapkey
WS:
COLON:
match: cb_send_mapkey
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
COLON:
match: cb_send_mapkey
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
COLON:
match: cb_empty_mapkey
EOL: { new: FULLNODE }
WS: { new: FULLMAPVALUE_INLINE }
DOC_END:
match: cb_end_document
EOL: { }
DOC_START:
match: cb_end_doc_start_document
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
EOL:
new: RULE_MAPKEY
NODETYPE_SEQ:
DASH:
match: cb_seqitem
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
DOC_END:
match: cb_end_document
EOL: { }
DOC_START:
match: cb_end_doc_start_document
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
EOL:
new: NODETYPE_SEQ
NODETYPE_MAP:
ANCHOR:
match: cb_anchor
WS:
TAG:
match: cb_tag
WS: { new: RULE_MAPKEY }
DEFAULT: { new: RULE_MAPKEY }
TAG:
match: cb_tag
WS:
ANCHOR:
match: cb_anchor
WS: { new: RULE_MAPKEY }
DEFAULT: { new: RULE_MAPKEY }
DEFAULT: { new: RULE_MAPKEY }
FULLNODE_ANCHOR:
TAG:
match: cb_tag
EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
WS:
ANCHOR:
match: cb_anchor
WS: { new: NODETYPE_SCALAR_OR_MAP }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
ANCHOR:
match: cb_anchor
WS:
TAG:
match: cb_tag
WS: { new: NODETYPE_SCALAR_OR_MAP }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
EOL: { new: FULLNODE_ANCHOR }
DEFAULT: { new: NODETYPE_NODE }
FULLNODE_TAG:
ANCHOR:
match: cb_anchor
EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
WS:
TAG:
match: cb_tag
WS: { new: NODETYPE_SCALAR_OR_MAP }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP, }
TAG:
match: cb_tag
WS:
ANCHOR:
match: cb_anchor
WS: { new: NODETYPE_SCALAR_OR_MAP }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
EOL: { new: FULLNODE_TAG }
DEFAULT: { new: NODETYPE_NODE }
FULLNODE_TAG_ANCHOR:
ANCHOR:
match: cb_anchor
WS:
TAG:
match: cb_tag
WS: { new: NODETYPE_SCALAR_OR_MAP }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
TAG:
match: cb_tag
WS:
ANCHOR:
match: cb_anchor
WS: { new: NODETYPE_SCALAR_OR_MAP }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
EOL: { new: FULLNODE_TAG_ANCHOR }
DEFAULT: { new: NODETYPE_NODE }
FULLNODE:
ANCHOR:
match: cb_anchor
EOL: { match: cb_property_eol, new: FULLNODE_ANCHOR }
WS:
TAG:
match: cb_tag
EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
WS: { new: NODETYPE_SCALAR_OR_MAP }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
TAG:
match: cb_tag
EOL: { match: cb_property_eol, new: FULLNODE_TAG }
WS:
ANCHOR:
match: cb_anchor
EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
WS: { new: NODETYPE_SCALAR_OR_MAP }
DEFAULT: { new: NODETYPE_SCALAR_OR_MAP }
EOL: { new: FULLNODE }
DEFAULT: { new: NODETYPE_NODE }
FULLMAPVALUE_INLINE:
ANCHOR:
match: cb_anchor
EOL: { match: cb_property_eol, new: FULLNODE_ANCHOR }
WS:
TAG:
match: cb_tag
EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
WS: { new: NODETYPE_MAPVALUE_INLINE }
DEFAULT: { new: NODETYPE_MAPVALUE_INLINE }
TAG:
match: cb_tag
EOL: { match: cb_property_eol, new: FULLNODE_TAG }
WS:
ANCHOR:
match: cb_anchor
EOL: { match: cb_property_eol, new: FULLNODE_TAG_ANCHOR }
WS: { new: NODETYPE_MAPVALUE_INLINE }
DEFAULT: { new: NODETYPE_MAPVALUE_INLINE }
DEFAULT: { new: NODETYPE_MAPVALUE_INLINE }
NODETYPE_MAPVALUE_INLINE:
ALIAS:
match: cb_send_alias
EOL: { }
QUOTED:
match: cb_take_quoted
EOL: { match: cb_send_scalar }
QUOTED_MULTILINE:
match: cb_quoted_multiline
EOL: { }
PLAIN:
match: cb_start_plain
EOL:
match: cb_send_scalar
PLAIN_MULTI:
match: cb_send_plain_multi
EOL: { }
BLOCK_SCALAR:
match: cb_send_block_scalar
EOL: { }
FLOWSEQ_START:
match: cb_start_flowseq
new: NEWFLOWSEQ
FLOWMAP_START:
match: cb_start_flowmap
new: NEWFLOWMAP
DOC_END:
match: cb_end_document
EOL: { }
DOCUMENT_END:
DOC_END:
match: cb_end_document
EOL: { }
DOC_START:
match: cb_end_doc_start_document
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
EOL:
new: DOCUMENT_END
STREAM:
DOC_END:
match: cb_end_document_empty
EOL: { }
DOC_START:
match: cb_doc_start_explicit
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
YAML_DIRECTIVE:
match: cb_set_yaml_version_directive
EOL: { new: DIRECTIVE }
WS: { new: DIRECTIVE }
RESERVED_DIRECTIVE:
match: cb_reserved_directive
EOL: { new: DIRECTIVE }
WS: { new: DIRECTIVE }
TAG_DIRECTIVE:
match: cb_tag_directive
EOL: { new: DIRECTIVE }
WS: { new: DIRECTIVE }
EOL:
new: STREAM
DEFAULT:
match: cb_doc_start_implicit
new: FULLNODE
DIRECTIVE:
DOC_START:
match: cb_doc_start_explicit
EOL: { new: FULLNODE }
WS: { new: FULLNODE }
YAML_DIRECTIVE:
match: cb_set_yaml_version_directive
EOL: { new: DIRECTIVE }
WS: { new: DIRECTIVE }
RESERVED_DIRECTIVE:
match: cb_reserved_directive
EOL: { new: DIRECTIVE }
WS: { new: DIRECTIVE }
TAG_DIRECTIVE:
match: cb_tag_directive
EOL: { new: DIRECTIVE }
WS: { new: DIRECTIVE }
EOL:
new: DIRECTIVE
# END OF YAML INLINE
=cut
YAML-PP-v0.41.0/lib/YAML/PP/PaxHeaders/Emitter.pm 0000644 0000000 0000000 00000000130 15214605475 015724 x ustar 00 29 mtime=1781730109.60726306
30 atime=1781730109.607164933
29 ctime=1781730109.60726306
YAML-PP-v0.41.0/lib/YAML/PP/Emitter.pm 0000644 0001750 0001750 00000075125 15214605475 015372 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Emitter;
our $VERSION = 'v0.41.0'; # 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;
my $last = $stack->[-1];
my $indent = $last->{indent};
my $new_indent = $indent;
my $yaml = '';
my $props = '';
my $anchor = $info->{anchor};
my $tag = $info->{tag};
if (defined $anchor) {
$anchor = "&$anchor";
}
if (defined $tag) {
$tag = $self->_emit_tag('map', $tag);
}
$props = join ' ', grep defined, ($anchor, $tag);
my $flow = $last->{flow} || 0;
$flow++ if ($info->{style} || 0) eq YAML_FLOW_MAPPING_STYLE;
my $newline = 0;
if ($flow > 1) {
if ($last->{type} eq 'SEQ') {
if ($last->{newline}) {
$yaml .= ' ';
}
if ($last->{index} == 0) {
$yaml .= "[";
}
else {
$yaml .= ",";
}
}
elsif ($last->{type} eq 'MAP') {
if ($last->{newline}) {
$yaml .= ' ';
}
if ($last->{index} == 0) {
$yaml .= "{";
}
else {
$yaml .= ",";
}
}
elsif ($last->{type} eq 'MAPVALUE') {
if ($last->{index} == 0) {
die "Should not happen (index 0 in MAPVALUE)";
}
$yaml .= ": ";
}
if ($props) {
$yaml .= " $props ";
}
$new_indent .= ' ' x $self->indent;
}
else {
if ($last->{type} eq 'DOC') {
$newline = $last->{newline};
}
else {
if ($last->{newline}) {
$yaml .= "\n";
$last->{column} = 0;
}
if ($last->{type} eq 'MAPVALUE') {
$new_indent .= ' ' x $self->indent;
$newline = 1;
}
else {
$new_indent = $indent;
if (not $props and $self->indent == 1) {
$new_indent .= ' ' x 2;
}
else {
$new_indent .= ' ' x $self->indent;
}
if ($last->{column}) {
my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
$yaml .= $space;
}
else {
$yaml .= $indent;
}
if ($last->{type} eq 'SEQ') {
$yaml .= '-';
}
elsif ($last->{type} eq 'MAP') {
$yaml .= "?";
$last->{type} = 'COMPLEX';
}
elsif ($last->{type} eq 'COMPLEXVALUE') {
$yaml .= ":";
}
else {
die "Should not happen ($last->{type} in mapping_start)";
}
$last->{column} = 1;
}
$last->{newline} = 0;
}
if ($props) {
$yaml .= $last->{column} ? ' ' : $indent;
$yaml .= $props;
$newline = 1;
}
}
$self->_write($yaml);
my $new_info = {
index => 0, indent => $new_indent, info => $info,
newline => $newline,
column => $self->column,
flow => $flow,
};
$new_info->{type} = 'MAP';
push @{ $stack }, $new_info;
$last->{index}++;
$self->{open_ended} = 0;
}
sub mapping_end_event {
DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ mapping_end_event\n";
my ($self, $info) = @_;
my $stack = $self->event_stack;
my $last = pop @{ $stack };
if ($last->{index} == 0) {
my $indent = $last->{indent};
my $zero_indent = $last->{zero_indent};
if ($last->{zero_indent}) {
$indent .= ' ' x $self->indent;
}
if ($self->column) {
$self->_write(" {}\n");
}
else {
$self->_write("$indent\{}\n");
}
}
elsif ($last->{flow}) {
my $yaml = "}";
if ($last->{flow} == 1) {
$yaml .= "\n";
}
$self->_write("$yaml");
}
$last = $stack->[-1];
$last->{column} = $self->column;
if ($last->{type} eq 'SEQ') {
}
elsif ($last->{type} eq 'MAP') {
$last->{type} = 'MAPVALUE';
}
elsif ($last->{type} eq 'MAPVALUE') {
$last->{type} = 'MAP';
}
elsif ($last->{type} eq 'COMPLEX') {
$last->{type} = 'COMPLEXVALUE';
}
elsif ($last->{type} eq 'COMPLEXVALUE') {
$last->{type} = 'MAP';
}
}
sub sequence_start_event {
DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ sequence_start_event\n";
my ($self, $info) = @_;
my $stack = $self->event_stack;
my $last = $stack->[-1];
my $indent = $last->{indent};
my $new_indent = $indent;
my $yaml = '';
my $props = '';
my $anchor = $info->{anchor};
my $tag = $info->{tag};
if (defined $anchor) {
$anchor = "&$anchor";
}
if (defined $tag) {
$tag = $self->_emit_tag('seq', $tag);
}
$props = join ' ', grep defined, ($anchor, $tag);
my $flow = $last->{flow} || 0;
$flow++ if $flow or ($info->{style} || 0) eq YAML_FLOW_SEQUENCE_STYLE;
my $newline = 0;
my $zero_indent = 0;
if ($flow > 1) {
if ($last->{type} eq 'SEQ') {
if ($last->{newline}) {
$yaml .= ' ';
}
if ($last->{index} == 0) {
$yaml .= "[";
}
else {
$yaml .= ",";
}
}
elsif ($last->{type} eq 'MAP') {
if ($last->{newline}) {
$yaml .= ' ';
}
if ($last->{index} == 0) {
$yaml .= "{";
}
else {
$yaml .= ",";
}
}
elsif ($last->{type} eq 'MAPVALUE') {
if ($last->{index} == 0) {
die "Should not happen (index 0 in MAPVALUE)";
}
$yaml .= ": ";
}
if ($props) {
$yaml .= " $props ";
}
$new_indent .= ' ' x $self->indent;
}
else {
if ($last->{type} eq 'DOC') {
$newline = $last->{newline};
}
else {
if ($last->{newline}) {
$yaml .= "\n";
$last->{column} = 0;
}
if ($last->{type} eq 'MAPVALUE') {
$zero_indent = 1;
$newline = 1;
}
else {
if (not $props and $self->indent == 1) {
$new_indent .= ' ' x 2;
}
else {
$new_indent .= ' ' x $self->indent;
}
if ($last->{column}) {
my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
$yaml .= $space;
}
else {
$yaml .= $indent;
}
if ($last->{type} eq 'SEQ') {
$yaml .= "-";
}
elsif ($last->{type} eq 'MAP') {
$last->{type} = 'COMPLEX';
$zero_indent = 1;
$yaml .= "?";
}
elsif ($last->{type} eq 'COMPLEXVALUE') {
$yaml .= ":";
$zero_indent = 1;
}
else {
die "Should not happen ($last->{type} in sequence_start)";
}
$last->{column} = 1;
}
$last->{newline} = 0;
}
if ($props) {
$yaml .= $last->{column} ? ' ' : $indent;
$yaml .= $props;
$newline = 1;
}
}
$self->_write($yaml);
$last->{index}++;
my $new_info = {
index => 0,
indent => $new_indent,
info => $info,
zero_indent => $zero_indent,
newline => $newline,
column => $self->column,
flow => $flow,
};
$new_info->{type} = 'SEQ';
push @{ $stack }, $new_info;
$self->{open_ended} = 0;
}
sub sequence_end_event {
DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ sequence_end_event\n";
my ($self, $info) = @_;
my $stack = $self->event_stack;
my $last = pop @{ $stack };
if ($last->{index} == 0) {
my $indent = $last->{indent};
my $zero_indent = $last->{zero_indent};
if ($last->{zero_indent}) {
$indent .= ' ' x $self->indent;
}
my $yaml .= $self->column ? ' ' : $indent;
$yaml .= "[]";
if ($last->{flow} < 2) {
$yaml .= "\n";
}
$self->_write($yaml);
}
elsif ($last->{flow}) {
my $yaml = "]";
if ($last->{flow} == 1) {
$yaml .= "\n";
}
$self->_write($yaml);
}
$last = $stack->[-1];
$last->{column} = $self->column;
if ($last->{type} eq 'SEQ') {
}
elsif ($last->{type} eq 'MAP') {
$last->{type} = 'MAPVALUE';
}
elsif ($last->{type} eq 'MAPVALUE') {
$last->{type} = 'MAP';
}
elsif ($last->{type} eq 'COMPLEX') {
$last->{type} = 'COMPLEXVALUE';
}
elsif ($last->{type} eq 'COMPLEXVALUE') {
$last->{type} = 'MAP';
}
}
my %forbidden_first = (qw/
! 1 & 1 * 1 { 1 } 1 [ 1 ] 1 | 1 > 1 @ 1 ` 1 " 1 ' 1
/, '#' => 1, '%' => 1, ',' => 1, " " => 1);
my %forbidden_first_plus_space = (qw/
? 1 - 1 : 1
/);
my %control = (
"\x00" => '\0',
"\x01" => '\x01',
"\x02" => '\x02',
"\x03" => '\x03',
"\x04" => '\x04',
"\x05" => '\x05',
"\x06" => '\x06',
"\x07" => '\a',
"\x08" => '\b',
"\x0b" => '\v',
"\x0c" => '\f',
"\x0e" => '\x0e',
"\x0f" => '\x0f',
"\x10" => '\x10',
"\x11" => '\x11',
"\x12" => '\x12',
"\x13" => '\x13',
"\x14" => '\x14',
"\x15" => '\x15',
"\x16" => '\x16',
"\x17" => '\x17',
"\x18" => '\x18',
"\x19" => '\x19',
"\x1a" => '\x1a',
"\x1b" => '\e',
"\x1c" => '\x1c',
"\x1d" => '\x1d',
"\x1e" => '\x1e',
"\x1f" => '\x1f',
"\x7f" => '\x7f',
"\x80" => '\x80',
"\x81" => '\x81',
"\x82" => '\x82',
"\x83" => '\x83',
"\x84" => '\x84',
"\x86" => '\x86',
"\x87" => '\x87',
"\x88" => '\x88',
"\x89" => '\x89',
"\x8a" => '\x8a',
"\x8b" => '\x8b',
"\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);
DEBUG and local $Data::Dumper::Useqq = 1;
$value = '' unless defined $value;
my $style = $self->_find_best_scalar_style(
info => $info,
value => $value,
);
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 $trailing = -1;
while (@lines) {
last if $lines[-1] ne '';
pop @lines;
$trailing++;
}
my %start_with_space;
for my $i (0 .. $#lines) {
if ($lines[ $i ] =~ m/^[ \t]+/) {
$start_with_space{ $i } = 1;
}
}
my $indicators = '';
if ($value =~ m/\A\n* +/) {
$indicators .= $self->indent;
}
my $indent = $indent . ' ' x $self->indent;
if ($trailing > 0) {
$indicators .= '+';
$open_ended = 1;
}
elsif ($trailing < 0) {
$indicators .= '-';
}
$value = ">$indicators\n";
my $got_content = 0;
for my $i (0 .. $#lines) {
my $line = $lines[ $i ];
my $sp = $start_with_space{ $i } || 0;
my $spnext = $i == $#lines ? 1 : $start_with_space{ $i+1 } || 0;
my $spprev = $i == 0 ? 1 : $start_with_space{ $i-1 } || 0;
my $empty = length $line ? 0 : 1;
my $emptynext = $i == $#lines ? '' : length $lines[$i+1] ? 0 : 1;
my $nl = 0;
if ($empty) {
if ($spnext and $spprev) {
$nl = 1;
}
elsif (not $spnext) {
$nl = 1;
}
elsif (not $got_content) {
$nl = 1;
}
}
else {
$got_content = 1;
$value .= "$indent$line\n";
if (not $sp and not $spnext) {
$nl = 1;
}
}
if ($nl) {
$value .= "\n";
}
}
$value .= "\n" x ($trailing) if $trailing > 0;
}
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 = $self->_emit_scalar(
indent => $indent,
props => $props,
value => $value,
style => $style,
);
$last->{index}++;
$last->{newline} = 0;
$self->_write($yaml);
$last->{column} = $self->column;
$self->{open_ended} = $open_ended;
}
sub _find_best_scalar_style {
my ($self, %args) = @_;
my $info = $args{info};
my $style = $info->{style};
my $value = $args{value};
my $stack = $self->event_stack;
my $last = $stack->[-1];
my $flow = $last->{flow};
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;
}
}
return $style;
}
sub _emit_scalar {
my ($self, %args) = @_;
my $props = $args{props};
my $value = $args{value};
my $style = $args{style};
my $stack = $self->event_stack;
my $last = $stack->[-1];
my $flow = $last->{flow};
my $yaml = '';
my $pvalue = $props;
if ($props and length $value) {
$pvalue .= " $value";
}
elsif (length $value) {
$pvalue .= $value;
}
if ($flow) {
if ($props and not length $value) {
$pvalue .= ' ';
}
$yaml = $self->_emit_flow_scalar(
value => $value,
pvalue => $pvalue,
style => $args{style},
);
}
else {
$yaml = $self->_emit_block_scalar(
props => $props,
value => $value,
pvalue => $pvalue,
indent => $args{indent},
style => $args{style},
);
}
return $yaml;
}
sub _emit_block_scalar {
my ($self, %args) = @_;
my $props = $args{props};
my $value = $args{value};
my $pvalue = $args{pvalue};
my $indent = $args{indent};
my $style = $args{style};
my $stack = $self->event_stack;
my $last = $stack->[-1];
my $yaml;
if ($last->{type} eq 'MAP' or $last->{type} eq 'SEQ') {
if ($last->{index} == 0 and $last->{newline}) {
$yaml .= "\n";
$last->{column} = 0;
$last->{newline} = 0;
}
}
my $space = ' ';
my $multiline = ($style == YAML_LITERAL_SCALAR_STYLE or $style == YAML_FOLDED_SCALAR_STYLE);
if ($last->{type} eq 'MAP') {
if ($last->{column}) {
my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
$yaml .= $space;
}
else {
$yaml .= $indent;
}
if ($props and not length $value) {
$pvalue .= ' ';
}
$last->{type} = 'MAPVALUE';
if ($multiline) {
# oops, a complex key
$yaml .= "? ";
$last->{type} = 'COMPLEXVALUE';
}
if (not $multiline) {
$pvalue .= ":";
}
}
else {
if ($last->{type} eq 'MAPVALUE') {
$last->{type} = 'MAP';
}
elsif ($last->{type} eq 'DOC') {
}
else {
if ($last->{column}) {
my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
$yaml .= $space;
}
else {
$yaml .= $indent;
}
if ($last->{type} eq 'COMPLEXVALUE') {
$last->{type} = 'MAP';
$yaml .= ":";
}
elsif ($last->{type} eq 'SEQ') {
$yaml .= "-";
}
else {
die "Should not happen ($last->{type} in scalar_event)";
}
$last->{column} = 1;
}
if (length $pvalue) {
if ($last->{column}) {
$pvalue = "$space$pvalue";
}
}
if (not $multiline) {
$pvalue .= "\n";
}
}
$yaml .= $pvalue;
return $yaml;
}
sub _emit_flow_scalar {
my ($self, %args) = @_;
my $value = $args{value};
my $pvalue = $args{pvalue};
my $stack = $self->event_stack;
my $last = $stack->[-1];
my $yaml;
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 .= ' ';
}
$yaml .= "{";
}
else {
$yaml .= ", ";
}
$last->{type} = 'MAPVALUE';
}
elsif ($last->{type} eq 'MAPVALUE') {
if ($last->{index} == 0) {
die "Should not happen (index 0 in MAPVALUE)";
}
$yaml .= ": ";
$last->{type} = 'MAP';
}
if ($self->column + length $pvalue > $self->width) {
$yaml .= "\n";
$yaml .= $last->{indent};
$yaml .= ' ' x $self->indent;
}
$yaml .= $pvalue;
return $yaml;
}
sub alias_event {
DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ alias_event\n";
my ($self, $info) = @_;
my $stack = $self->event_stack;
my $last = $stack->[-1];
my $indent = $last->{indent};
my $flow = $last->{flow};
my $alias = '*' . $info->{value};
my $yaml = '';
if ($last->{type} eq 'MAP' or $last->{type} eq 'SEQ') {
if ($last->{index} == 0 and $last->{newline}) {
$yaml .= "\n";
$last->{column} = 0;
$last->{newline} = 0;
}
}
$yaml .= $last->{column} ? ' ' : $indent;
if ($flow) {
my $space = '';
if ($last->{type} eq 'SEQ') {
if ($last->{index} == 0) {
if ($flow == 1) {
$yaml .= ' ';
}
$yaml .= "[";
}
else {
$yaml .= ", ";
}
}
elsif ($last->{type} eq 'MAP') {
if ($last->{index} == 0) {
if ($flow == 1) {
$yaml .= ' ';
}
$yaml .= "{";
}
else {
$yaml .= ", ";
}
$last->{type} = 'MAPVALUE';
$space = ' ';
}
elsif ($last->{type} eq 'MAPVALUE') {
if ($last->{index} == 0) {
die 23;
if ($flow == 1) {
$yaml .= ' ';
}
$yaml .= "{";
}
else {
$yaml .= ": ";
}
$last->{type} = 'MAP';
}
$yaml .= "$alias$space";
}
else {
if ($last->{type} eq 'MAP') {
$yaml .= "$alias :";
$last->{type} = 'MAPVALUE';
}
else {
if ($last->{type} eq 'MAPVALUE') {
$last->{type} = 'MAP';
}
elsif ($last->{type} eq 'DOC') {
# TODO an alias at document level isn't actually valid
}
else {
if ($last->{type} eq 'COMPLEXVALUE') {
$last->{type} = 'MAP';
$yaml .= ": ";
}
elsif ($last->{type} eq 'COMPLEX') {
$yaml .= ": ";
}
elsif ($last->{type} eq 'SEQ') {
$yaml .= "- ";
}
else {
die "Unexpected";
}
}
$yaml .= "$alias\n";
}
}
$self->_write("$yaml");
$last->{index}++;
$last->{column} = $self->column;
$self->{open_ended} = 0;
}
sub document_start_event {
DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ document_start_event\n";
my ($self, $info) = @_;
my $newline = 0;
my $implicit = $info->{implicit};
if ($info->{version_directive}) {
if ($self->{open_ended}) {
$self->_write("...\n");
}
$self->_write("%YAML $info->{version_directive}->{major}.$info->{version_directive}->{minor}\n");
$self->{open_ended} = 0;
$implicit = 0; # we need ---
}
unless ($implicit) {
$newline = 1;
$self->_write("---");
}
$self->set_event_stack([
{
type => 'DOC', index => 0, indent => '', info => $info,
newline => $newline, column => $self->column,
}
]);
}
sub document_end_event {
DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ document_end_event\n";
my ($self, $info) = @_;
$self->set_event_stack([]);
if ($self->{open_ended} or not $info->{implicit}) {
$self->_write("...\n");
$self->{open_ended} = 0;
}
else {
$self->{open_ended} = 1;
}
}
sub stream_start_event {
}
sub stream_end_event {
}
sub _emit_tag {
my ($self, $type, $tag) = @_;
my $map = $self->tagmap;
for my $key (sort keys %$map) {
if ($tag =~ m/^\Q$key\E(.*)/) {
$tag = $map->{ $key } . $1;
return $tag;
}
}
if ($tag =~ m/^(!.*)/) {
$tag = "$1";
}
else {
$tag = "!<$tag>";
}
return $tag;
}
sub finish {
my ($self) = @_;
$self->writer->finish;
}
sub _write {
my ($self, $yaml) = @_;
return unless length $yaml;
my @lines = split m/\n/, $yaml, -1;
my $newlines = @lines - 1;
$self->{line} += $newlines;
if (length $lines[-1]) {
if ($newlines) {
$self->{column} = length $lines[-1];
}
else {
$self->{column} += length $lines[-1];
}
}
else {
$self->{column} = 0;
}
$self->writer->write($yaml);
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Emitter - Emitting events
=head1 SYNOPSIS
my $emitter = YAML::PP::Emitter->new(
indent => 4,
);
$emitter->init;
$emitter->stream_start_event;
$emitter->document_start_event({ implicit => 1 });
$emitter->sequence_start_event;
$emitter->scalar_event({ value => $input, style => $style });
$emitter->sequence_end_event;
$emitter->document_end_event({ implicit => 1 });
$emitter->stream_end_event;
my $yaml = $emitter->writer->output;
$emitter->finish;
=head1 DESCRIPTION
The emitter emits events to YAML. It provides methods for each event
type. The arguments are mostly the same as the events from L.
=head1 METHODS
=over
=item new
my $emitter = YAML::PP::Emitter->new(
indent => 4,
);
Constructor. Currently takes these options:
=over
=item indent
=item writer
=back
=item stream_start_event, stream_end_event, document_start_event, document_end_event, sequence_start_event, sequence_end_event, mapping_start_event, mapping_end_event, scalar_event, alias_event
=item indent, set_indent
Getter/setter for number of indentation spaces.
TODO: Currently sequences are always zero-indented.
=item writer, set_writer
Getter/setter for the writer object. By default L.
You can pass your own writer if you want to output the resulting YAML yourself.
=item init
Initialize
=item finish
=back
=cut
YAML-PP-v0.41.0/lib/YAML/PP/PaxHeaders/Common.pm 0000644 0000000 0000000 00000000131 15214605475 015544 x ustar 00 30 mtime=1781730109.606241418
29 atime=1781730109.60613903
30 ctime=1781730109.606241418
YAML-PP-v0.41.0/lib/YAML/PP/Common.pm 0000644 0001750 0001750 00000015731 15214605475 015206 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Common;
our $VERSION = 'v0.41.0'; # VERSION
use base 'Exporter';
my @p = qw/
PRESERVE_ALL PRESERVE_ORDER PRESERVE_SCALAR_STYLE PRESERVE_FLOW_STYLE
PRESERVE_ALIAS
/;
my @s = qw/
YAML_ANY_SCALAR_STYLE YAML_PLAIN_SCALAR_STYLE
YAML_SINGLE_QUOTED_SCALAR_STYLE YAML_DOUBLE_QUOTED_SCALAR_STYLE
YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE
YAML_QUOTED_SCALAR_STYLE
YAML_ANY_SEQUENCE_STYLE
YAML_BLOCK_SEQUENCE_STYLE YAML_FLOW_SEQUENCE_STYLE
YAML_ANY_MAPPING_STYLE
YAML_BLOCK_MAPPING_STYLE YAML_FLOW_MAPPING_STYLE
/;
our @EXPORT_OK = (@s, @p);
our %EXPORT_TAGS = (
PRESERVE => [@p],
STYLES => [@s],
);
use constant {
YAML_ANY_SCALAR_STYLE => 0,
YAML_PLAIN_SCALAR_STYLE => 1,
YAML_SINGLE_QUOTED_SCALAR_STYLE => 2,
YAML_DOUBLE_QUOTED_SCALAR_STYLE => 3,
YAML_LITERAL_SCALAR_STYLE => 4,
YAML_FOLDED_SCALAR_STYLE => 5,
YAML_QUOTED_SCALAR_STYLE => 'Q', # deprecated
YAML_ANY_SEQUENCE_STYLE => 0,
YAML_BLOCK_SEQUENCE_STYLE => 1,
YAML_FLOW_SEQUENCE_STYLE => 2,
YAML_ANY_MAPPING_STYLE => 0,
YAML_BLOCK_MAPPING_STYLE => 1,
YAML_FLOW_MAPPING_STYLE => 2,
PRESERVE_ORDER => 2,
PRESERVE_SCALAR_STYLE => 4,
PRESERVE_FLOW_STYLE => 8,
PRESERVE_ALIAS => 16,
PRESERVE_ALL => 31,
};
my %scalar_style_to_string = (
YAML_PLAIN_SCALAR_STYLE() => ':',
YAML_SINGLE_QUOTED_SCALAR_STYLE() => "'",
YAML_DOUBLE_QUOTED_SCALAR_STYLE() => '"',
YAML_LITERAL_SCALAR_STYLE() => '|',
YAML_FOLDED_SCALAR_STYLE() => '>',
);
sub event_to_test_suite {
my ($event, $args) = @_;
my $ev = $event->{name};
my $string;
my $content = $event->{value};
my $properties = '';
$properties .= " &$event->{anchor}" if defined $event->{anchor};
$properties .= " <$event->{tag}>" if defined $event->{tag};
if ($ev eq 'document_start_event') {
$string = "+DOC";
$string .= " ---" unless $event->{implicit};
}
elsif ($ev eq 'document_end_event') {
$string = "-DOC";
$string .= " ..." unless $event->{implicit};
}
elsif ($ev eq 'stream_start_event') {
$string = "+STR";
}
elsif ($ev eq 'stream_end_event') {
$string = "-STR";
}
elsif ($ev eq 'mapping_start_event') {
$string = "+MAP";
if ($event->{style} and $event->{style} eq YAML_FLOW_MAPPING_STYLE) {
$string .= ' {}' if $args->{flow};
}
$string .= $properties;
if (0) {
# doesn't match yaml-test-suite format
}
}
elsif ($ev eq 'sequence_start_event') {
$string = "+SEQ";
if ($event->{style} and $event->{style} eq YAML_FLOW_SEQUENCE_STYLE) {
$string .= ' []' if $args->{flow};
}
$string .= $properties;
if (0) {
# doesn't match yaml-test-suite format
}
}
elsif ($ev eq 'mapping_end_event') {
$string = "-MAP";
}
elsif ($ev eq 'sequence_end_event') {
$string = "-SEQ";
}
elsif ($ev eq 'scalar_event') {
$string = '=VAL';
$string .= $properties;
$content =~ s/\\/\\\\/g;
$content =~ s/\t/\\t/g;
$content =~ s/\r/\\r/g;
$content =~ s/\n/\\n/g;
$content =~ s/[\b]/\\b/g;
$string .= ' '
. $scalar_style_to_string{ $event->{style} }
. $content;
}
elsif ($ev eq 'alias_event') {
$string = "=ALI *$content";
}
return $string;
}
sub test_suite_to_event {
my ($str) = @_;
my $event = {};
if ($str =~ s/^\+STR//) {
$event->{name} = 'stream_start_event';
}
elsif ($str =~ s/^\-STR//) {
$event->{name} = 'stream_end_event';
}
elsif ($str =~ s/^\+DOC//) {
$event->{name} = 'document_start_event';
if ($str =~ s/^ ---//) {
$event->{implicit} = 0;
}
else {
$event->{implicit} = 1;
}
}
elsif ($str =~ s/^\-DOC//) {
$event->{name} = 'document_end_event';
if ($str =~ s/^ \.\.\.//) {
$event->{implicit} = 0;
}
else {
$event->{implicit} = 1;
}
}
elsif ($str =~ s/^\+SEQ//) {
$event->{name} = 'sequence_start_event';
if ($str =~ s/^ \&(\S+)//) {
$event->{anchor} = $1;
}
if ($str =~ s/^ <(\S+)>//) {
$event->{tag} = $1;
}
}
elsif ($str =~ s/^\-SEQ//) {
$event->{name} = 'sequence_end_event';
}
elsif ($str =~ s/^\+MAP//) {
$event->{name} = 'mapping_start_event';
if ($str =~ s/^ \&(\S+)//) {
$event->{anchor} = $1;
}
if ($str =~ s/^ <(\S+)>//) {
$event->{tag} = $1;
}
}
elsif ($str =~ s/^\-MAP//) {
$event->{name} = 'mapping_end_event';
}
elsif ($str =~ s/^=VAL//) {
$event->{name} = 'scalar_event';
if ($str =~ s/^ <(\S+)>//) {
$event->{tag} = $1;
}
if ($str =~ s/^ [:'">|]//) {
$event->{style} = $1;
}
if ($str =~ s/^(.*)//) {
$event->{value} = $1;
}
}
elsif ($str =~ s/^=ALI//) {
$event->{name} = 'alias_event';
if ($str =~ s/^ \*(.*)//) {
$event->{value} = $1;
}
}
else {
die "Could not parse event '$str'";
}
return $event;
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Common - Constants and common functions
=head1 SYNOPSIS
use YAML::PP::Common ':STYLES';
# or
use YAML::PP::Common qw/
YAML_ANY_SCALAR_STYLE YAML_PLAIN_SCALAR_STYLE
YAML_SINGLE_QUOTED_SCALAR_STYLE YAML_DOUBLE_QUOTED_SCALAR_STYLE
YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE
YAML_QUOTED_SCALAR_STYLE
YAML_ANY_SEQUENCE_STYLE
YAML_BLOCK_SEQUENCE_STYLE YAML_FLOW_SEQUENCE_STYLE
YAML_ANY_MAPPING_STYLE
YAML_BLOCK_MAPPING_STYLE YAML_FLOW_MAPPING_STYLE
/;
use YAML::PP::Common ':PRESERVE';
# or
use YAML::PP::Common qw/
PRESERVE_ALL PRESERVE_ORDER PRESERVE_SCALAR_STYLE PRESERVE_FLOW_STYLE
PRESERVE_ALIAS
/:
=head1 DESCRIPTION
This module provides common constants and functions for modules working with
YAML::PP events.
=head1 FUNCTIONS
=over
=item event_to_test_suite
my $string = YAML::PP::Common::event_to_test_suite($event_prom_parser);
For examples of the returned format look into this distributions's directory
C which is a copy of
L.
=item test_suite_to_event
my $event = YAML::PP::Common::test_suite_to_event($str);
Turns an event string in test suite format into an event hashref. Not complete
yet.
=back
YAML-PP-v0.41.0/lib/YAML/PP/PaxHeaders/Parser.pm 0000644 0000000 0000000 00000000130 15214605475 015547 x ustar 00 29 mtime=1781730109.60613903
30 atime=1781730109.606040274
29 ctime=1781730109.60613903
YAML-PP-v0.41.0/lib/YAML/PP/Parser.pm 0000644 0001750 0001750 00000121264 15214605475 015211 0 ustar 00tina tina # ABSTRACT: YAML Parser
use strict;
use warnings;
package YAML::PP::Parser;
our $VERSION = 'v0.41.0'; # VERSION
use constant TRACE => $ENV{YAML_PP_TRACE} ? 1 : 0;
use constant DEBUG => ($ENV{YAML_PP_DEBUG} || $ENV{YAML_PP_TRACE}) ? 1 : 0;
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 YAML::PP::Render;
use YAML::PP::Lexer;
use YAML::PP::Grammar qw/ $GRAMMAR /;
use YAML::PP::Exception;
use YAML::PP::Reader;
use Carp qw/ croak /;
sub new {
my ($class, %args) = @_;
my $reader = delete $args{reader} || YAML::PP::Reader->new;
my $default_yaml_version = delete $args{default_yaml_version};
my $self = bless {
default_yaml_version => $default_yaml_version || '1.2',
lexer => YAML::PP::Lexer->new(
reader => $reader,
),
}, $class;
my $receiver = delete $args{receiver};
if ($receiver) {
$self->set_receiver($receiver);
}
return $self;
}
sub clone {
my ($self) = @_;
my $clone = {
default_yaml_version => $self->default_yaml_version,
lexer => YAML::PP::Lexer->new(),
};
return bless $clone, ref $self;
}
sub receiver { return $_[0]->{receiver} }
sub set_receiver {
my ($self, $receiver) = @_;
my $callback;
if (ref $receiver eq 'CODE') {
$callback = $receiver;
}
else {
$callback = sub {
my ($self, $event, $info) = @_;
return $receiver->$event($info);
};
}
$self->{callback} = $callback;
$self->{receiver} = $receiver;
}
sub reader { return $_[0]->lexer->{reader} }
sub set_reader {
my ($self, $reader) = @_;
$self->lexer->set_reader($reader);
}
sub lexer { return $_[0]->{lexer} }
sub callback { return $_[0]->{callback} }
sub set_callback { $_[0]->{callback} = $_[1] }
sub level { return $#{ $_[0]->{offset} } }
sub offset { return $_[0]->{offset} }
sub set_offset { $_[0]->{offset} = $_[1] }
sub events { return $_[0]->{events} }
sub set_events { $_[0]->{events} = $_[1] }
sub new_node { return $_[0]->{new_node} }
sub set_new_node { $_[0]->{new_node} = $_[1] }
sub tagmap { return $_[0]->{tagmap} }
sub set_tagmap { $_[0]->{tagmap} = $_[1] }
sub tokens { return $_[0]->{tokens} }
sub set_tokens { $_[0]->{tokens} = $_[1] }
sub event_stack { return $_[0]->{event_stack} }
sub set_event_stack { $_[0]->{event_stack} = $_[1] }
sub default_yaml_version { return $_[0]->{default_yaml_version} }
sub yaml_version { return $_[0]->{yaml_version} }
sub set_yaml_version { $_[0]->{yaml_version} = $_[1] }
sub yaml_version_directive { return $_[0]->{yaml_version_directive} }
sub set_yaml_version_directive { $_[0]->{yaml_version_directive} = $_[1] }
sub rule { return $_[0]->{rule} }
sub set_rule {
my ($self, $name) = @_;
no warnings 'uninitialized';
DEBUG and $self->info("set_rule($name)");
$self->{rule} = $name;
}
sub init {
my ($self) = @_;
$self->set_offset([]);
$self->set_events([]);
$self->set_new_node(0);
$self->set_tagmap({
'!!' => "tag:yaml.org,2002:",
});
$self->set_tokens([]);
$self->set_rule(undef);
$self->set_event_stack([]);
$self->set_yaml_version($self->default_yaml_version);
$self->set_yaml_version_directive(undef);
$self->lexer->init;
}
sub parse_string {
my ($self, $yaml) = @_;
$self->set_reader(YAML::PP::Reader->new( input => $yaml ));
$self->parse();
}
sub parse_file {
my ($self, $file) = @_;
$self->set_reader(YAML::PP::Reader::File->new( input => $file ));
$self->parse();
}
my %nodetypes = (
MAPVALUE => 'NODETYPE_COMPLEX',
MAP => 'NODETYPE_MAP',
# IMAP => 'NODETYPE_SEQ',
SEQ => 'NODETYPE_SEQ',
SEQ0 => 'NODETYPE_SEQ',
FLOWMAP => 'NODETYPE_FLOWMAP',
FLOWMAPVALUE => 'NODETYPE_FLOWMAPVALUE',
FLOWSEQ => 'NODETYPE_FLOWSEQ',
FLOWSEQ_NEXT => 'FLOWSEQ_NEXT',
DOC => 'FULLNODE',
DOC_END => 'DOCUMENT_END',
STR => 'STREAM',
END_FLOW => 'END_FLOW',
);
sub parse {
my ($self) = @_;
TRACE and warn "=== parse()\n";
TRACE and $self->debug_yaml;
$self->init;
$self->lexer->init;
eval {
$self->start_stream;
$self->set_rule( 'STREAM' );
$self->parse_tokens();
$self->end_stream;
};
if (my $error = $@) {
if (ref $error) {
croak "$error\n ";
}
croak $error;
}
DEBUG and $self->highlight_yaml;
TRACE and $self->debug_tokens;
}
sub lex_next_tokens {
my ($self) = @_;
DEBUG and $self->info("----------------> lex_next_tokens");
TRACE and $self->debug_events;
my $indent = $self->offset->[-1];
my $event_types = $self->events;
my $next_tokens = $self->lexer->fetch_next_tokens($indent);
return unless @$next_tokens;
my $next = $next_tokens->[0];
return 1 if ($next->{name} ne 'SPACE');
my $flow = $event_types->[-1] =~ m/^FLOW/;
my $space = length $next->{value};
my $tokens = $self->tokens;
if (not $space) {
shift @$next_tokens;
}
else {
push @$tokens, shift @$next_tokens;
}
if ($flow) {
if ($space >= $indent) {
return 1;
}
$self->exception("Bad indendation in " . $self->events->[-1]);
}
$next = $next_tokens->[0];
if ($space > $indent ) {
return 1 if $indent < 0;
unless ($self->new_node) {
$self->exception("Bad indendation in " . $self->events->[-1]);
}
return 1;
}
if ($self->new_node) {
if ($space < $indent) {
$self->scalar_event({ style => YAML_PLAIN_SCALAR_STYLE, value => '' });
$self->remove_nodes($space);
}
else {
# unindented sequence starts
my $exp = $self->events->[-1];
my $seq_start = $next->{name} eq 'DASH';
if ( $seq_start and ($exp eq 'MAPVALUE' or $exp eq 'MAP')) {
}
else {
$self->scalar_event({ style => YAML_PLAIN_SCALAR_STYLE, value => '' });
}
}
}
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',
IMAP => 'IMAPVALUE',
MAPVALUE => 'MAP',
IMAPVALUE => 'IMAP',
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',
IMAP => 'mapping',
FLOWMAP => 'mapping',
SEQ => 'sequence',
SEQ0 => 'sequence',
FLOWSEQ => 'sequence',
DOC => 'document',
STR => 'stream',
VAL => 'scalar',
ALI => 'alias',
MAPVALUE => 'mapping',
IMAPVALUE => '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) {
if ($rule_name eq 'DIRECTIVE') {
$self->exception("Directive needs document start");
}
$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;
}
$rule = $GRAMMAR->{ $rule_name }
or die "Unexpected rule $rule_name";
}
die "Unexpected";
}
sub end_sequence {
my ($self) = @_;
my $event_types = $self->events;
pop @{ $event_types };
pop @{ $self->offset };
my $info = { name => 'sequence_end_event' };
$self->callback->($self, $info->{name} => $info );
$event_types->[-1] = $next_event{ $event_types->[-1] };
}
sub remove_nodes {
my ($self, $space) = @_;
my $offset = $self->offset;
my $event_types = $self->events;
my $exp = $event_types->[-1];
while (@$offset) {
if ($offset->[ -1 ] <= $space) {
last;
}
if ($exp eq 'MAPVALUE') {
$self->scalar_event({ style => YAML_PLAIN_SCALAR_STYLE, value => '' });
$exp = 'MAP';
}
my $info = { name => $exp };
$info->{name} = $event_to_method{ $exp } . '_end_event';
pop @{ $event_types };
pop @{ $offset };
$self->callback->($self, $info->{name} => $info );
$event_types->[-1] = $next_event{ $event_types->[-1] };
$exp = $event_types->[-1];
}
return $exp;
}
sub start_stream {
my ($self) = @_;
push @{ $self->events }, 'STR';
push @{ $self->offset }, -1;
$self->callback->($self, 'stream_start_event', {
name => 'stream_start_event',
});
}
sub start_document {
my ($self, $implicit) = @_;
push @{ $self->events }, 'DOC';
push @{ $self->offset }, -1;
my $directive = $self->yaml_version_directive;
my %directive;
if ($directive) {
my ($major, $minor) = split m/\./, $self->yaml_version;
%directive = ( version_directive => { major => $major, minor => $minor } );
}
$self->callback->($self, 'document_start_event', {
name => 'document_start_event',
implicit => $implicit,
%directive,
});
$self->set_yaml_version_directive(undef);
$self->set_rule( 'FULLNODE' );
$self->set_new_node(1);
}
sub start_sequence {
my ($self, $offset) = @_;
my $offsets = $self->offset;
if ($offsets->[-1] == $offset) {
push @{ $self->events }, 'SEQ0';
}
else {
push @{ $self->events }, 'SEQ';
}
push @{ $offsets }, $offset;
my $event_stack = $self->event_stack;
my $info = { name => 'sequence_start_event' };
if (@$event_stack and $event_stack->[-1]->[0] eq 'properties') {
my $properties = pop @$event_stack;
$self->node_properties($properties->[1], $info);
}
$self->callback->($self, 'sequence_start_event', $info);
}
sub start_flow_sequence {
my ($self, $offset) = @_;
my $offsets = $self->offset;
my $new_offset = $offsets->[-1];
my $event_types = $self->events;
if ($new_offset < 0) {
$new_offset = 0;
}
elsif ($self->new_node) {
if ($event_types->[-1] !~ m/^FLOW/) {
$new_offset++;
}
}
push @{ $self->events }, 'FLOWSEQ';
push @{ $offsets }, $new_offset;
my $event_stack = $self->event_stack;
my $info = { style => YAML_FLOW_SEQUENCE_STYLE, name => 'sequence_start_event' };
if (@$event_stack and $event_stack->[-1]->[0] eq 'properties') {
$self->fetch_inline_properties($event_stack, $info);
}
$self->callback->($self, 'sequence_start_event', $info);
}
sub start_flow_mapping {
my ($self, $offset, $implicit_flowseq_map) = @_;
my $offsets = $self->offset;
my $new_offset = $offsets->[-1];
my $event_types = $self->events;
if ($new_offset < 0) {
$new_offset = 0;
}
elsif ($self->new_node) {
if ($event_types->[-1] !~ m/^FLOW/) {
$new_offset++;
}
}
push @{ $self->events }, $implicit_flowseq_map ? 'IMAP' : 'FLOWMAP';
push @{ $offsets }, $new_offset;
my $event_stack = $self->event_stack;
my $info = { name => 'mapping_start_event', style => YAML_FLOW_MAPPING_STYLE };
if (@$event_stack and $event_stack->[-1]->[0] eq 'properties') {
$self->fetch_inline_properties($event_stack, $info);
}
$self->callback->($self, 'mapping_start_event', $info);
}
sub end_flow_sequence {
my ($self) = @_;
my $event_types = $self->events;
pop @{ $event_types };
pop @{ $self->offset };
my $info = { name => 'sequence_end_event' };
$self->callback->($self, $info->{name}, $info);
if ($event_types->[-1] =~ m/^FLOW|^IMAP/) {
$event_types->[-1] = $next_event{ $event_types->[-1] };
}
else {
push @$event_types, 'END_FLOW';
}
}
sub end_flow_mapping {
my ($self) = @_;
my $event_types = $self->events;
pop @{ $event_types };
pop @{ $self->offset };
my $info = { name => 'mapping_end_event' };
$self->callback->($self, $info->{name}, $info);
if ($event_types->[-1] =~ m/^FLOW|^IMAP/) {
$event_types->[-1] = $next_event{ $event_types->[-1] };
}
else {
push @$event_types, 'END_FLOW';
}
}
sub cb_end_outer_flow {
my ($self) = @_;
my $event_types = $self->events;
pop @$event_types;
$event_types->[-1] = $next_event{ $event_types->[-1] };
}
sub start_mapping {
my ($self, $offset) = @_;
my $offsets = $self->offset;
push @{ $self->events }, 'MAP';
push @{ $offsets }, $offset;
my $event_stack = $self->event_stack;
my $info = { name => 'mapping_start_event' };
if (@$event_stack and $event_stack->[-1]->[0] eq 'properties') {
my $properties = pop @$event_stack;
$self->node_properties($properties->[1], $info);
}
$self->callback->($self, 'mapping_start_event', $info);
}
sub end_document {
my ($self, $implicit) = @_;
my $event_types = $self->events;
if ($event_types->[-1] =~ m/FLOW/) {
die "Unexpected end of flow context";
}
if ($self->new_node) {
$self->scalar_event({ style => YAML_PLAIN_SCALAR_STYLE, value => '' });
}
$self->remove_nodes(-1);
if ($event_types->[-1] eq 'STR') {
return;
}
my $last = pop @{ $event_types };
if ($last ne 'DOC' and $last ne 'DOC_END') {
$self->exception("Unexpected event type $last");
}
pop @{ $self->offset };
$self->callback->($self, 'document_end_event', {
name => 'document_end_event',
implicit => $implicit,
});
if ($self->yaml_version eq '1.2') {
# In YAML 1.2, directives are only for the following
# document. In YAML 1.1, they are global
$self->set_tagmap({ '!!' => "tag:yaml.org,2002:" });
}
$event_types->[-1] = $next_event{ $event_types->[-1] };
$self->set_rule('STREAM');
}
sub end_stream {
my ($self) = @_;
my $last = pop @{ $self->events };
$self->exception("Unexpected event type $last") unless $last eq 'STR';
pop @{ $self->offset };
$self->callback->($self, 'stream_end_event', {
name => 'stream_end_event',
});
}
sub fetch_inline_properties {
my ($self, $stack, $info) = @_;
my $properties = $stack->[-1];
$properties = $properties->[1];
my $property_offset;
if ($properties) {
for my $p (@{ $properties->{inline} }) {
my $type = $p->{type};
if (exists $info->{ $type }) {
$self->exception("A node can only have one $type");
}
$info->{ $type } = $p->{value};
unless (defined $property_offset) {
$property_offset = $p->{offset};
$info->{offset} = $p->{offset};
}
}
delete $properties->{inline};
undef $properties unless $properties->{newline};
}
unless ($properties) {
pop @$stack;
}
}
sub node_properties {
my ($self, $properties, $info) = @_;
if ($properties) {
for my $p (@{ $properties->{newline} }) {
my $type = $p->{type};
if (exists $info->{ $type }) {
$self->exception("A node can only have one $type");
}
$info->{ $type } = $p->{value};
}
undef $properties;
}
}
sub scalar_event {
my ($self, $info) = @_;
my $event_types = $self->events;
my $event_stack = $self->event_stack;
if (@$event_stack and $event_stack->[-1]->[0] eq 'properties') {
my $properties = pop @$event_stack;
$properties = $self->node_properties($properties->[1], $info);
}
$info->{name} = 'scalar_event';
$self->callback->($self, 'scalar_event', $info);
$self->set_new_node(0);
$event_types->[-1] = $next_event{ $event_types->[-1] };
}
sub alias_event {
my ($self, $info) = @_;
my $event_stack = $self->event_stack;
if (@$event_stack and $event_stack->[-1]->[0] eq 'properties') {
$self->exception("Parse error: Alias not allowed in this context");
}
my $event_types = $self->events;
$info->{name} = 'alias_event';
$self->callback->($self, 'alias_event', $info);
$self->set_new_node(0);
$event_types->[-1] = $next_event{ $event_types->[-1] };
}
sub yaml_to_tokens {
my ($class, $type, $input) = @_;
my $yp = YAML::PP::Parser->new( receiver => sub {} );
my @docs = eval {
$type eq 'string' ? $yp->parse_string($input) : $yp->parse_file($input);
};
my $error = $@;
my $tokens = $yp->tokens;
if ($error) {
my $remaining_tokens = $yp->_remaining_tokens;
push @$tokens, map { +{ %$_, name => 'ERROR' } } @$remaining_tokens;
}
return $error, $tokens;
}
sub _remaining_tokens {
my ($self) = @_;
my @tokens;
my $next = $self->lexer->next_tokens;
push @tokens, @$next;
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;
}
}
$remaining .= $self->reader->read;
$remaining = '' unless defined $remaining;
push @tokens, { name => "ERROR", value => $remaining };
return \@tokens;
}
# deprecated
sub event_to_test_suite {
# uncoverable subroutine
my ($self, $event) = @_; # uncoverable statement
if (ref $event eq 'ARRAY') { # uncoverable statement
return YAML::PP::Common::event_to_test_suite($event->[1]); # uncoverable statement
}
return YAML::PP::Common::event_to_test_suite($event); # uncoverable statement
}
sub debug_events {
# uncoverable subroutine
my ($self) = @_; # uncoverable statement
$self->note("EVENTS: (" # uncoverable statement
. join (' | ', @{ $_[0]->events }) . ')' # uncoverable statement
);
$self->debug_offset; # uncoverable statement
}
sub debug_offset {
# uncoverable subroutine
my ($self) = @_; # uncoverable statement
$self->note(
qq{OFFSET: (}
# uncoverable statement count:1
# uncoverable statement count:2
# uncoverable statement count:3
. join (' | ', map { defined $_ ? sprintf "%-3d", $_ : '?' } @{ $_[0]->offset })
# uncoverable statement
. qq/) level=@{[ $_[0]->level ]}]}/
);
}
sub debug_yaml {
# uncoverable subroutine
my ($self) = @_; # uncoverable statement
my $line = $self->lexer->line; # uncoverable statement
$self->note("LINE NUMBER: $line"); # uncoverable statement
my $next_tokens = $self->lexer->next_tokens; # uncoverable statement
if (@$next_tokens) { # uncoverable statement
$self->debug_tokens($next_tokens); # uncoverable statement
}
}
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 {
# uncoverable subroutine
my ($self, $colors, $text) = @_; # uncoverable statement
require Term::ANSIColor; # uncoverable statement
warn Term::ANSIColor::colored($colors, $text), "\n"; # uncoverable statement
}
sub debug_event {
# uncoverable subroutine
my ($self, $event) = @_; # uncoverable statement
my $str = YAML::PP::Common::event_to_test_suite($event); # uncoverable statement
require Term::ANSIColor; # uncoverable statement
warn Term::ANSIColor::colored(["magenta"], "============ $str"), "\n"; # uncoverable statement
}
sub debug_rules {
# uncoverable subroutine
my ($self, $rules) = @_; # uncoverable statement
local $Data::Dumper::Maxdepth = 2; # uncoverable statement
$self->note("RULES:"); # uncoverable statement
for my $rule ($rules) { # uncoverable statement
if (ref $rule eq 'ARRAY') { # uncoverable statement
my $first = $rule->[0]; # uncoverable statement
if (ref $first eq 'SCALAR') { # uncoverable statement
$self->info("-> $$first"); # uncoverable statement
}
else { # uncoverable statement
if (ref $first eq 'ARRAY') { # uncoverable statement
$first = $first->[0]; # uncoverable statement
}
$self->info("TYPE $first"); # uncoverable statement
}
}
else { # uncoverable statement
eval { # uncoverable statement
my @keys = sort keys %$rule; # uncoverable statement
$self->info("@keys"); # uncoverable statement
};
}
}
}
sub debug_tokens {
# uncoverable subroutine
my ($self, $tokens) = @_; # uncoverable statement
$tokens ||= $self->tokens; # uncoverable statement
require Term::ANSIColor; # uncoverable statement
for my $token (@$tokens) { # uncoverable statement
my $type = Term::ANSIColor::colored(["green"], # uncoverable statement
sprintf "%-22s L %2d C %2d ", # uncoverable statement
$token->{name}, $token->{line}, $token->{column} + 1 # uncoverable statement
);
local $Data::Dumper::Useqq = 1; # uncoverable statement
local $Data::Dumper::Terse = 1; # uncoverable statement
require Data::Dumper; # uncoverable statement
my $str = Data::Dumper->Dump([$token->{value}], ['str']); # uncoverable statement
chomp $str; # uncoverable statement
$str =~ s/(^.|.$)/Term::ANSIColor::colored(['blue'], $1)/ge; # uncoverable statement
warn "$type$str\n"; # uncoverable statement
}
}
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) = @_;
my $stack = $self->event_stack;
if (! @$stack or $stack->[-1]->[0] ne 'properties') {
push @$stack, [ properties => {} ];
}
my $last = $stack->[-1]->[1];
my $tag = $self->_read_tag($token->{value}, $self->tagmap);
$last->{inline} ||= [];
push @{ $last->{inline} }, {
type => 'tag',
value => $tag,
offset => $token->{column},
};
}
sub _read_tag {
my ($self, $tag, $map) = @_;
if ($tag eq '!') {
return "!";
}
elsif ($tag =~ m/^!<(.*)>/) {
return $1;
}
elsif ($tag =~ m/^(![^!]*!|!)(.+)/) {
my $alias = $1;
my $name = $2;
$name =~ s/%([0-9a-fA-F]{2})/chr hex $1/eg;
if (exists $map->{ $alias }) {
$tag = $map->{ $alias }. $name;
}
else {
if ($alias ne '!' and $alias ne '!!') {
die "Found undefined tag handle '$alias'";
}
$tag = "!$name";
}
}
else {
die "Invalid tag";
}
return $tag;
}
sub cb_anchor {
my ($self, $token) = @_;
my $anchor = $token->{value};
$anchor = substr($anchor, 1);
my $stack = $self->event_stack;
if (! @$stack or $stack->[-1]->[0] ne 'properties') {
push @$stack, [ properties => {} ];
}
my $last = $stack->[-1]->[1];
$last->{inline} ||= [];
push @{ $last->{inline} }, {
type => 'anchor',
value => $anchor,
offset => $token->{column},
};
}
sub cb_property_eol {
my ($self, $res) = @_;
my $stack = $self->event_stack;
my $last = $stack->[-1]->[1];
my $inline = delete $last->{inline} or return;
my $newline = $last->{newline} ||= [];
push @$newline, @$inline;
}
sub cb_mapkey {
my ($self, $token) = @_;
my $stack = $self->event_stack;
my $info = {
style => YAML_PLAIN_SCALAR_STYLE,
value => $token->{value},
offset => $token->{column},
};
if (@$stack and $stack->[-1]->[0] eq 'properties') {
$self->fetch_inline_properties($stack, $info);
}
push @{ $stack }, [ scalar => $info ];
}
sub cb_send_mapkey {
my ($self, $res) = @_;
my $last = pop @{ $self->event_stack };
$self->scalar_event($last->[1]);
$self->set_new_node(1);
}
sub cb_send_scalar {
my ($self, $res) = @_;
my $last = pop @{ $self->event_stack };
return unless $last;
$self->scalar_event($last->[1]);
my $e = $self->events;
if ($e->[-1] eq 'IMAP') {
$self->end_flow_mapping;
}
}
sub cb_empty_mapkey {
my ($self, $token) = @_;
my $stack = $self->event_stack;
my $info = {
style => YAML_PLAIN_SCALAR_STYLE,
value => '',
offset => $token->{column},
};
if (@$stack and $stack->[-1]->[0] eq 'properties') {
$self->fetch_inline_properties($stack, $info);
}
$self->scalar_event($info);
$self->set_new_node(1);
}
sub cb_send_flow_alias {
my ($self, $token) = @_;
my $alias = substr($token->{value}, 1);
$self->alias_event({ value => $alias });
}
sub cb_send_alias {
my ($self, $token) = @_;
my $alias = substr($token->{value}, 1);
$self->alias_event({ value => $alias });
}
sub cb_send_alias_key {
my ($self, $token) = @_;
my $alias = substr($token->{value}, 1);
$self->alias_event({ value => $alias });
$self->set_new_node(1);
}
sub cb_send_alias_from_stack {
my ($self, $token) = @_;
my $last = pop @{ $self->event_stack };
$self->alias_event($last->[1]);
}
sub cb_alias {
my ($self, $token) = @_;
my $alias = substr($token->{value}, 1);
push @{ $self->event_stack }, [ alias => {
value => $alias,
offset => $token->{column},
}];
}
sub cb_question {
my ($self, $res) = @_;
$self->set_new_node(1);
}
sub cb_flow_question {
my ($self, $res) = @_;
$self->set_new_node(2);
}
sub cb_empty_complexvalue {
my ($self, $res) = @_;
$self->scalar_event({ style => YAML_PLAIN_SCALAR_STYLE, value => '' });
}
sub cb_questionstart {
my ($self, $token) = @_;
$self->start_mapping($token->{column});
}
sub cb_complexcolon {
my ($self, $res) = @_;
$self->set_new_node(1);
}
sub cb_seqstart {
my ($self, $token) = @_;
my $column = $token->{column};
$self->start_sequence($column);
$self->set_new_node(1);
}
sub cb_seqitem {
my ($self, $res) = @_;
$self->set_new_node(1);
}
sub cb_take_quoted {
my ($self, $token) = @_;
my $subtokens = $token->{subtokens};
my $stack = $self->event_stack;
my $info = {
style => $subtokens->[0]->{value} eq '"'
? YAML_DOUBLE_QUOTED_SCALAR_STYLE
: YAML_SINGLE_QUOTED_SCALAR_STYLE,
value => $token->{value},
offset => $token->{column},
};
if (@$stack and $stack->[-1]->[0] eq 'properties') {
$self->fetch_inline_properties($stack, $info);
}
push @{ $stack }, [ scalar => $info ];
}
sub cb_quoted_multiline {
my ($self, $token) = @_;
my $subtokens = $token->{subtokens};
my $stack = $self->event_stack;
my $info = {
style => $subtokens->[0]->{value} eq '"'
? YAML_DOUBLE_QUOTED_SCALAR_STYLE
: YAML_SINGLE_QUOTED_SCALAR_STYLE,
value => $token->{value},
offset => $token->{column},
};
if (@$stack and $stack->[-1]->[0] eq 'properties') {
$self->fetch_inline_properties($stack, $info);
}
push @{ $stack }, [ scalar => $info ];
$self->cb_send_scalar;
}
sub cb_take_quoted_key {
my ($self, $token) = @_;
$self->cb_take_quoted($token);
$self->cb_send_mapkey;
}
sub cb_send_plain_multi {
my ($self, $token) = @_;
my $stack = $self->event_stack;
my $info = {
style => YAML_PLAIN_SCALAR_STYLE,
value => $token->{value},
offset => $token->{column},
};
if (@$stack and $stack->[-1]->[0] eq 'properties') {
$self->fetch_inline_properties($stack, $info);
}
push @{ $stack }, [ scalar => $info ];
$self->cb_send_scalar;
}
sub cb_start_plain {
my ($self, $token) = @_;
my $stack = $self->event_stack;
my $info = {
style => YAML_PLAIN_SCALAR_STYLE,
value => $token->{value},
offset => $token->{column},
};
if (@$stack and $stack->[-1]->[0] eq 'properties') {
$self->fetch_inline_properties($stack, $info);
}
push @{ $stack }, [ scalar => $info ];
}
sub cb_start_flowseq {
my ($self, $token) = @_;
$self->start_flow_sequence($token->{column});
}
sub cb_start_flowmap {
my ($self, $token) = @_;
$self->start_flow_mapping($token->{column});
}
sub cb_end_flowseq {
my ($self, $res) = @_;
$self->cb_send_scalar;
$self->end_flow_sequence;
$self->set_new_node(0);
}
sub cb_flow_comma {
my ($self) = @_;
my $event_types = $self->events;
$self->set_new_node(0);
if ($event_types->[-1] =~ m/^FLOWSEQ/) {
$self->cb_send_scalar;
$event_types->[-1] = $next_event{ $event_types->[-1] };
}
}
sub cb_flow_colon {
my ($self) = @_;
$self->set_new_node(1);
}
sub cb_empty_flow_mapkey {
my ($self, $token) = @_;
my $stack = $self->event_stack;
my $info = {
style => YAML_PLAIN_SCALAR_STYLE,
value => '',
offset => $token->{column},
};
if (@$stack and $stack->[-1]->[0] eq 'properties') {
$self->fetch_inline_properties($stack, $info);
}
$self->scalar_event($info);
}
sub cb_end_flowmap {
my ($self, $res) = @_;
$self->end_flow_mapping;
$self->set_new_node(0);
}
sub cb_end_flowmap_empty {
my ($self, $res) = @_;
$self->cb_empty_flowmap_value;
$self->end_flow_mapping;
$self->set_new_node(0);
}
sub cb_flowkey_plain {
my ($self, $token) = @_;
my $stack = $self->event_stack;
my $info = {
style => YAML_PLAIN_SCALAR_STYLE,
value => $token->{value},
offset => $token->{column},
};
if (@$stack and $stack->[-1]->[0] eq 'properties') {
$self->fetch_inline_properties($stack, $info);
}
$self->scalar_event($info);
}
sub cb_flowkey_quoted {
my ($self, $token) = @_;
my $stack = $self->event_stack;
my $subtokens = $token->{subtokens};
my $info = {
style => $subtokens->[0]->{value} eq '"'
? YAML_DOUBLE_QUOTED_SCALAR_STYLE
: YAML_SINGLE_QUOTED_SCALAR_STYLE,
value => $token->{value},
offset => $token->{column},
};
if (@$stack and $stack->[-1]->[0] eq 'properties') {
$self->fetch_inline_properties($stack, $info);
}
$self->scalar_event($info);
}
sub cb_empty_flowmap_key_value {
my ($self, $token) = @_;
$self->cb_empty_flow_mapkey($token);
$self->cb_empty_flowmap_value;
$self->cb_flow_comma;
}
sub cb_end_empty_flowmap_key_value {
my ($self, $token) = @_;
$self->cb_empty_flow_mapkey($token);
$self->cb_empty_flowmap_value;
$self->cb_flow_comma;
$self->cb_end_flowmap;
}
sub cb_empty_flowmap_value {
my ($self, $token) = @_;
my $stack = $self->event_stack;
my $info = {
style => YAML_PLAIN_SCALAR_STYLE,
value => '',
offset => $token->{column},
};
if (@$stack and $stack->[-1]->[0] eq 'properties') {
$self->fetch_inline_properties($stack, $info);
}
$self->scalar_event($info);
}
sub cb_empty_flowseq_comma {
my ($self, $token) = @_;
$self->cb_empty_flowmap_value($token);
$self->cb_flow_comma;
}
sub cb_empty_flowseq_end {
my ($self, $token) = @_;
$self->cb_empty_flowmap_value($token);
$self->cb_end_flowseq;
}
sub cb_insert_map_alias {
my ($self, $res) = @_;
my $stack = $self->event_stack;
my $scalar = pop @$stack;
my $info = $scalar->[1];
$self->start_mapping($info->{offset});
$self->alias_event($info);
$self->set_new_node(1);
}
sub cb_insert_map {
my ($self, $res) = @_;
my $stack = $self->event_stack;
my $scalar = pop @$stack;
my $info = $scalar->[1];
$self->start_mapping($info->{offset});
$self->scalar_event($info);
$self->set_new_node(1);
}
sub cb_insert_implicit_flowseq_map {
my ($self, $res) = @_;
my $stack = $self->event_stack;
my $scalar = pop @$stack;
my $info = $scalar->[1];
$self->start_flow_mapping($info->{offset}, 1);
$self->scalar_event($info);
$self->set_new_node(1);
}
sub cb_insert_empty_implicit_flowseq_map {
my ($self, $res) = @_;
my $stack = $self->event_stack;
my $scalar = pop @$stack;
my $info = $scalar->[1];
$self->start_flow_mapping($info->{offset}, 1);
$self->cb_empty_flowmap_value;
$self->set_new_node(2);
}
sub cb_insert_empty_map {
my ($self, $token) = @_;
my $stack = $self->event_stack;
my $info = {
style => YAML_PLAIN_SCALAR_STYLE,
value => '',
offset => $token->{column},
};
if (@$stack and $stack->[-1]->[0] eq 'properties') {
$self->fetch_inline_properties($stack, $info);
}
$self->start_mapping($info->{offset});
$self->scalar_event($info);
$self->set_new_node(1);
}
sub cb_send_block_scalar {
my ($self, $token) = @_;
my $type = $token->{subtokens}->[0]->{value};
my $stack = $self->event_stack;
my $info = {
style => $type eq '|'
? YAML_LITERAL_SCALAR_STYLE
: YAML_FOLDED_SCALAR_STYLE,
value => $token->{value},
offset => $token->{column},
};
if (@$stack and $stack->[-1]->[0] eq 'properties') {
$self->fetch_inline_properties($stack, $info);
}
push @{ $self->event_stack }, [ scalar => $info ];
$self->cb_send_scalar;
}
sub cb_end_document {
my ($self, $token) = @_;
$self->end_document(0);
}
sub cb_end_document_empty {
my ($self, $token) = @_;
$self->end_document(0);
}
sub cb_doc_start_implicit {
my ($self, $token) = @_;
$self->start_document(1);
}
sub cb_doc_start_explicit {
my ($self, $token) = @_;
$self->start_document(0);
}
sub cb_end_doc_start_document {
my ($self, $token) = @_;
$self->end_document(1);
$self->start_document(0);
}
sub cb_tag_directive {
my ($self, $token) = @_;
my ($name, $tag_alias, $tag_url) = split ' ', $token->{value};
$self->tagmap->{ $tag_alias } = $tag_url;
}
sub cb_reserved_directive {
}
sub cb_set_yaml_version_directive {
my ($self, $token) = @_;
if ($self->yaml_version_directive) {
croak "Found duplicate YAML directive";
}
my ($version) = $token->{value} =~ m/^%YAML[ \t]+(1\.[12])/;
$self->set_yaml_version($version || '1.2');
$self->set_yaml_version_directive(1);
}
1;
YAML-PP-v0.41.0/lib/YAML/PP/PaxHeaders/Dumper.pm 0000644 0000000 0000000 00000000132 15214605475 015551 x ustar 00 30 mtime=1781730109.606040274
30 atime=1781730109.605943404
30 ctime=1781730109.606040274
YAML-PP-v0.41.0/lib/YAML/PP/Dumper.pm 0000644 0001750 0001750 00000020323 15214605475 015203 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Dumper;
our $VERSION = 'v0.41.0'; # 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,
seen => {},
anchors => {},
anchor_num => 0,
header => $header,
footer => $footer,
}, $class;
return $self;
}
sub clone {
my ($self) = @_;
my $clone = {
representer => $self->representer->clone,
emitter => $self->emitter->clone,
version_directive => $self->version_directive,
seen => {},
anchors => {},
anchor_num => 0,
header => $self->header,
footer => $self->footer,
};
return bless $clone, ref $self;
}
sub init {
my ($self) = @_;
$self->{seen} = {};
$self->{anchors} = {};
$self->{anchor_num} = 0;
}
sub emitter { return $_[0]->{emitter} }
sub representer { return $_[0]->{representer} }
sub set_representer { $_[0]->{representer} = $_[1] }
sub header { return $_[0]->{header} }
sub footer { return $_[0]->{footer} }
sub version_directive { return $_[0]->{version_directive} }
sub dump {
my ($self, @docs) = @_;
$self->emitter->init;
$self->emitter->stream_start_event({});
for my $i (0 .. $#docs) {
my $header_implicit = ($i == 0 and not $self->header);
my %args = (
implicit => $header_implicit,
);
if ($self->version_directive) {
my ($major, $minor) = split m/\./, $self->representer->schema->yaml_version;
$args{version_directive} = { major => $major, minor => $minor };
}
$self->emitter->document_start_event( \%args );
$self->init;
$self->_check_references($docs[ $i ]);
$self->_dump_node($docs[ $i ]);
my $footer_implicit = (not $self->footer);
$self->emitter->document_end_event({ implicit => $footer_implicit });
}
$self->emitter->stream_end_event({});
my $output = $self->emitter->writer->output;
$self->emitter->finish;
return $output;
}
sub _dump_node {
my ($self, $value) = @_;
my $node = {
value => $value,
};
if (ref $value) {
my $seen = $self->{seen};
my $refaddr = refaddr $value;
if ($seen->{ $refaddr } and $seen->{ $refaddr } > 1) {
my $anchor = $self->{anchors}->{ $refaddr };
unless (defined $anchor) {
if ($self->representer->preserve_alias) {
if (ref $node->{value} eq 'YAML::PP::Preserve::Scalar') {
if (defined $node->{value}->alias) {
$node->{anchor} = $node->{value}->alias;
$self->{anchors}->{ $refaddr } = $node->{value}->alias;
}
}
elsif (reftype $node->{value} eq 'HASH') {
if (my $tied = tied %{ $node->{value} } ) {
if (defined $tied->{alias}) {
$node->{anchor} = $tied->{alias};
$self->{anchors}->{ $refaddr } = $node->{anchor};
}
}
}
elsif (reftype $node->{value} eq 'ARRAY') {
if (my $tied = tied @{ $node->{value} } ) {
if (defined $tied->{alias}) {
$node->{anchor} = $tied->{alias};
$self->{anchors}->{ $refaddr } = $node->{anchor};
}
}
}
}
unless (defined $node->{anchor}) {
my $num = ++$self->{anchor_num};
$self->{anchors}->{ $refaddr } = $num;
$node->{anchor} = $num;
}
}
else {
$node->{value} = $anchor;
$self->_emit_node([ alias => $node ]);
return;
}
}
}
$node = $self->representer->represent_node($node);
$self->_emit_node($node);
}
sub _emit_node {
my ($self, $item) = @_;
my ($type, $node, %args) = @$item;
if ($type eq 'alias') {
$self->emitter->alias_event({ value => $node->{value} });
return;
}
if ($type eq 'mapping') {
my $style = $args{style} || YAML_BLOCK_MAPPING_STYLE;
# TODO
if ($node->{items} and @{ $node->{items} } == 0) {
# $style = YAML_FLOW_MAPPING_STYLE;
}
$self->emitter->mapping_start_event({
anchor => $node->{anchor},
style => $style,
tag => $node->{tag},
});
for (@{ $node->{items} }) {
$self->_dump_node($_);
}
$self->emitter->mapping_end_event;
return;
}
if ($type eq 'sequence') {
my $style = $args{style} || YAML_BLOCK_SEQUENCE_STYLE;
if (@{ $node->{items} } == 0) {
# $style = YAML_FLOW_SEQUENCE_STYLE;
}
$self->emitter->sequence_start_event({
anchor => $node->{anchor},
style => $style,
tag => $node->{tag},
});
for (@{ $node->{items} }) {
$self->_dump_node($_);
}
$self->emitter->sequence_end_event;
return;
}
$self->emitter->scalar_event({
value => $node->{items}->[0],
style => $node->{style},
anchor => $node->{anchor},
tag => $node->{tag},
});
}
sub dump_string {
my ($self, @docs) = @_;
my $writer = YAML::PP::Writer->new;
$self->emitter->set_writer($writer);
my $output = $self->dump(@docs);
return $output;
}
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
grep { 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-v0.41.0/lib/YAML/PP/PaxHeaders/Loader.pm 0000644 0000000 0000000 00000000132 15214605475 015523 x ustar 00 30 mtime=1781730109.605943404
30 atime=1781730109.605840737
30 ctime=1781730109.605943404
YAML-PP-v0.41.0/lib/YAML/PP/Loader.pm 0000644 0001750 0001750 00000005154 15214605475 015162 0 ustar 00tina tina # ABSTRACT: Load YAML into data with Parser and Constructor
use strict;
use warnings;
package YAML::PP::Loader;
our $VERSION = 'v0.41.0'; # VERSION
use YAML::PP::Parser;
use YAML::PP::Constructor;
use YAML::PP::Reader;
sub new {
my ($class, %args) = @_;
my $cyclic_refs = delete $args{cyclic_refs} || 'fatal';
my $default_yaml_version = delete $args{default_yaml_version} || '1.2';
my $preserve = delete $args{preserve};
my $duplicate_keys = delete $args{duplicate_keys};
my $require_footer = delete $args{require_footer};
my $max_depth = delete $args{max_depth};
my $schemas = delete $args{schemas};
$schemas ||= {
'1.2' => YAML::PP->default_schema(
boolean => 'perl',
)
};
my $constructor = delete $args{constructor} || YAML::PP::Constructor->new(
schemas => $schemas,
cyclic_refs => $cyclic_refs,
default_yaml_version => $default_yaml_version,
preserve => $preserve,
duplicate_keys => $duplicate_keys,
require_footer => $require_footer,
max_depth => $max_depth,
);
my $parser = delete $args{parser};
unless ($parser) {
$parser = YAML::PP::Parser->new(
default_yaml_version => $default_yaml_version,
);
}
unless ($parser->receiver) {
$parser->set_receiver($constructor);
}
if (keys %args) {
die "Unexpected arguments: " . join ', ', sort keys %args;
}
my $self = bless {
parser => $parser,
constructor => $constructor,
}, $class;
return $self;
}
sub clone {
my ($self) = @_;
my $clone = {
parser => $self->parser->clone,
constructor => $self->constructor->clone,
};
bless $clone, ref $self;
$clone->parser->set_receiver($clone->constructor);
return $clone;
}
sub parser { return $_[0]->{parser} }
sub constructor { return $_[0]->{constructor} }
sub filename {
my ($self) = @_;
my $reader = $self->parser->reader;
if ($reader->isa('YAML::PP::Reader::File')) {
return $reader->input;
}
die "Reader is not a YAML::PP::Reader::File";
}
sub load_string {
my ($self, $yaml) = @_;
$self->parser->set_reader(YAML::PP::Reader->new( input => $yaml ));
$self->load();
}
sub load_file {
my ($self, $file) = @_;
$self->parser->set_reader(YAML::PP::Reader::File->new( input => $file ));
$self->load();
}
sub load {
my ($self) = @_;
my $parser = $self->parser;
my $constructor = $self->constructor;
$constructor->init;
$parser->parse();
my $docs = $constructor->docs;
return wantarray ? @$docs : $docs->[0];
}
1;
YAML-PP-v0.41.0/lib/YAML/PP/PaxHeaders/Render.pm 0000644 0000000 0000000 00000000132 15214605475 015534 x ustar 00 30 mtime=1781730109.605840737
30 atime=1781730109.605746311
30 ctime=1781730109.605840737
YAML-PP-v0.41.0/lib/YAML/PP/Render.pm 0000644 0001750 0001750 00000007061 15214605475 015172 0 ustar 00tina tina # ABSTRACT: YAML::PP Rendering functions
use strict;
use warnings;
package YAML::PP::Render;
our $VERSION = 'v0.41.0'; # VERSION
use constant TRACE => $ENV{YAML_PP_TRACE} ? 1 : 0;
sub render_quoted {
my ($self, $style, $lines) = @_;
my $quoted = '';
my $addspace = 0;
for my $i (0 .. $#$lines) {
my $line = $lines->[ $i ];
my $value = $line->{value};
my $last = $i == $#$lines;
my $first = $i == 0;
if ($value eq '') {
if ($first) {
$addspace = 1;
}
elsif ($last) {
$quoted .= ' ' if $addspace;
}
else {
$addspace = 0;
$quoted .= "\n";
}
next;
}
$quoted .= ' ' if $addspace;
$addspace = 1;
if ($style eq '"') {
if ($line->{orig} =~ m/\\$/) {
$line->{value} =~ s/\\$//;
$value =~ s/\\$//;
$addspace = 0;
}
}
$quoted .= $value;
}
return $quoted;
}
sub render_block_scalar {
my ($self, $block_type, $chomp, $lines) = @_;
my ($folded, $keep, $trim);
if ($block_type eq '>') {
$folded = 1;
}
if ($chomp eq '+') {
$keep = 1;
}
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';
my $trailing = '';
if ($keep) {
while (@$lines and $lines->[-1] eq '') {
pop @$lines;
$trailing .= "\n";
}
}
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;
}
if ($keep) {
$string .= $trailing;
}
$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-v0.41.0/lib/YAML/PP/PaxHeaders/Reader.pm 0000644 0000000 0000000 00000000132 15214605475 015517 x ustar 00 30 mtime=1781730109.605746311
30 atime=1781730109.605653142
30 ctime=1781730109.605746311
YAML-PP-v0.41.0/lib/YAML/PP/Reader.pm 0000644 0001750 0001750 00000003012 15214605475 015145 0 ustar 00tina tina # ABSTRACT: Reader class for YAML::PP representing input data
use strict;
use warnings;
package YAML::PP::Reader;
our $VERSION = 'v0.41.0'; # VERSION
sub input { return $_[0]->{input} }
sub set_input { $_[0]->{input} = $_[1] }
sub new {
my ($class, %args) = @_;
my $input = delete $args{input};
return bless {
input => $input,
}, $class;
}
sub read {
my ($self) = @_;
my $pos = pos $self->{input} || 0;
my $yaml = substr($self->{input}, $pos);
$self->{input} = '';
return $yaml;
}
sub readline {
my ($self) = @_;
unless (length $self->{input}) {
return;
}
if ( $self->{input} =~ m/\G([^\r\n]*(?:\n|\r\n|\r|\z))/g ) {
my $line = $1;
unless (length $line) {
$self->{input} = '';
return;
}
return $line;
}
return;
}
package YAML::PP::Reader::File;
use Scalar::Util qw/ openhandle /;
our @ISA = qw/ YAML::PP::Reader /;
use Carp qw/ croak /;
sub open_handle {
if (openhandle( $_[0]->{input} )) {
return $_[0]->{input};
}
open my $fh, '<:encoding(UTF-8)', $_[0]->{input}
or croak "Could not open '$_[0]->{input}' for reading: $!";
return $fh;
}
sub read {
my $fh = $_[0]->{filehandle} ||= $_[0]->open_handle;
if (wantarray) {
my @yaml = <$fh>;
return @yaml;
}
else {
local $/;
my $yaml = <$fh>;
return $yaml;
}
}
sub readline {
my $fh = $_[0]->{filehandle} ||= $_[0]->open_handle;
return scalar <$fh>;
}
1;
YAML-PP-v0.41.0/lib/YAML/PP/PaxHeaders/Schema.pm 0000644 0000000 0000000 00000000132 15214605475 015515 x ustar 00 30 mtime=1781730109.605653142
30 atime=1781730109.605560392
30 ctime=1781730109.605653142
YAML-PP-v0.41.0/lib/YAML/PP/Schema.pm 0000644 0001750 0001750 00000027332 15214605475 015156 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema;
use B;
use Module::Load qw//;
our $VERSION = 'v0.41.0'; # VERSION
use YAML::PP::Common qw/ YAML_PLAIN_SCALAR_STYLE /;
use Carp qw/ croak /;
use Scalar::Util qw/ blessed /;
sub new {
my ($class, %args) = @_;
my $yaml_version = delete $args{yaml_version};
my $bool = delete $args{boolean};
$bool = 'perl' unless defined $bool;
if (keys %args) {
die "Unexpected arguments: " . join ', ', sort keys %args;
}
my $true;
my $false;
my @bool_class;
my @bools = split m/,/, $bool;
for my $b (@bools) {
if ($b eq '*') {
push @bool_class, ('boolean', 'JSON::PP::Boolean');
last;
}
elsif ($b eq 'JSON::PP') {
require JSON::PP;
$true ||= \&_bool_jsonpp_true;
$false ||= \&_bool_jsonpp_false;
push @bool_class, 'JSON::PP::Boolean';
}
elsif ($b eq 'boolean') {
require boolean;
$true ||= \&_bool_booleanpm_true;
$false ||= \&_bool_booleanpm_false;
push @bool_class, 'boolean';
}
elsif ($b eq 'perl' or $b eq 'perl_experimental') {
push @bool_class, 'perl';
}
else {
die "Invalid value for 'boolean': '$b'. Allowed: ('perl', 'boolean', 'JSON::PP')";
}
}
# Ensure booleans are resolved
$true ||= \&_bool_perl_true;
$false ||= \&_bool_perl_false;
my %representers = (
'undef' => undef,
flags => [],
equals => {},
regex => [],
class_equals => {},
class_matches => [],
class_isa => [],
scalarref => undef,
refref => undef,
coderef => undef,
glob => undef,
tied_equals => {},
bool => undef,
);
my $self = bless {
yaml_version => $yaml_version,
resolvers => {},
representers => \%representers,
true => $true,
false => $false,
bool_class => \@bool_class,
}, $class;
return $self;
}
sub resolvers { return $_[0]->{resolvers} }
sub representers { return $_[0]->{representers} }
sub true { return $_[0]->{true} }
sub false { return $_[0]->{false} }
sub bool_class { return @{ $_[0]->{bool_class} } ? $_[0]->{bool_class} : undef }
sub yaml_version { return $_[0]->{yaml_version} }
my %LOADED_SCHEMA = (
JSON => 1,
);
my %DEFAULT_SCHEMA = (
'1.2' => 'Core',
'1.1' => 'YAML1_1',
);
sub load_subschemas {
my ($self, @schemas) = @_;
my $yaml_version = $self->yaml_version;
my $i = 0;
while ($i < @schemas) {
my $item = $schemas[ $i ];
if ($item eq '+') {
$item = $DEFAULT_SCHEMA{ $yaml_version };
}
$i++;
if (blessed($item)) {
$item->register(
schema => $self,
);
next;
}
my @options;
while ($i < @schemas
and (
$schemas[ $i ] =~ m/^[^A-Za-z]/
or
$schemas[ $i ] =~ m/^[a-zA-Z0-9]+=/
)
) {
push @options, $schemas[ $i ];
$i++;
}
my $class;
if ($item =~ m/^\:(.*)/) {
$class = "$1";
unless ($class =~ m/\A[A-Za-z0-9_:]+\z/) {
die "Module name '$class' is invalid";
}
Module::Load::load $class;
}
else {
$class = "YAML::PP::Schema::$item";
unless ($class =~ m/\A[A-Za-z0-9_:]+\z/) {
die "Module name '$class' is invalid";
}
$LOADED_SCHEMA{ $item } ||= Module::Load::load $class;
}
$class->register(
schema => $self,
options => \@options,
);
}
}
sub add_resolver {
my ($self, %args) = @_;
my $tag = $args{tag};
my $rule = $args{match};
my $resolvers = $self->resolvers;
my ($type, @rule) = @$rule;
my $implicit = $args{implicit};
$implicit = 1 unless defined $implicit;
my $resolver_list = [];
if ($tag) {
if (ref $tag eq 'Regexp') {
my $res = $resolvers->{tags} ||= [];
push @$res, [ $tag, {} ];
push @$resolver_list, $res->[-1]->[1];
}
else {
my $res = $resolvers->{tag}->{ $tag } ||= {};
push @$resolver_list, $res;
}
}
if ($implicit) {
push @$resolver_list, $resolvers->{value} ||= {};
}
for my $res (@$resolver_list) {
if ($type eq 'equals') {
my ($match, $value) = @rule;
unless (exists $res->{equals}->{ $match }) {
$res->{equals}->{ $match } = $value;
}
next;
}
elsif ($type eq 'regex') {
my ($match, $value) = @rule;
push @{ $res->{regex} }, [ $match => $value ];
}
elsif ($type eq 'all') {
my ($value) = @rule;
$res->{all} = $value;
}
}
}
sub add_sequence_resolver {
my ($self, %args) = @_;
return $self->add_collection_resolver(sequence => %args);
}
sub add_mapping_resolver {
my ($self, %args) = @_;
return $self->add_collection_resolver(mapping => %args);
}
sub add_collection_resolver {
my ($self, $type, %args) = @_;
my $tag = $args{tag};
my $implicit = $args{implicit};
my $resolvers = $self->resolvers;
if ($tag and ref $tag eq 'Regexp') {
my $res = $resolvers->{ $type }->{tags} ||= [];
push @$res, [ $tag, {
on_create => $args{on_create},
on_data => $args{on_data},
} ];
}
elsif ($tag) {
my $res = $resolvers->{ $type }->{tag}->{ $tag } ||= {
on_create => $args{on_create},
on_data => $args{on_data},
};
}
}
sub add_representer {
my ($self, %args) = @_;
my $representers = $self->representers;
if (my $flags = $args{flags}) {
my $rep = $representers->{flags};
push @$rep, \%args;
return;
}
if (my $regex = $args{regex}) {
my $rep = $representers->{regex};
push @$rep, \%args;
return;
}
if (my $regex = $args{class_matches}) {
my $rep = $representers->{class_matches};
push @$rep, [ $args{class_matches}, $args{code} ];
return;
}
if (my $bool = $args{bool} and $] >= 5.036000) {
$representers->{bool} = {
code => $args{code},
};
return;
}
if (my $class_equals = $args{class_equals}) {
my $rep = $representers->{class_equals};
$rep->{ $class_equals } = {
code => $args{code},
};
return;
}
if (my $class_isa = $args{class_isa}) {
my $rep = $representers->{class_isa};
push @$rep, [ $args{class_isa}, $args{code} ];
return;
}
if (my $tied_equals = $args{tied_equals}) {
my $rep = $representers->{tied_equals};
$rep->{ $tied_equals } = {
code => $args{code},
};
return;
}
if (defined(my $equals = $args{equals})) {
my $rep = $representers->{equals};
$rep->{ $equals } = {
code => $args{code},
};
return;
}
if (defined(my $scalarref = $args{scalarref})) {
$representers->{scalarref} = {
code => $args{code},
};
return;
}
if (defined(my $refref = $args{refref})) {
$representers->{refref} = {
code => $args{code},
};
return;
}
if (defined(my $coderef = $args{coderef})) {
$representers->{coderef} = {
code => $args{code},
};
return;
}
if (defined(my $glob = $args{glob})) {
$representers->{glob} = {
code => $args{code},
};
return;
}
if (my $undef = $args{undefined}) {
$representers->{undef} = $undef;
return;
}
}
sub load_scalar {
my ($self, $constructor, $event) = @_;
my $tag = $event->{tag};
my $value = $event->{value};
my $resolvers = $self->resolvers;
my $res;
if ($tag) {
if ($tag eq '!') {
return $value;
}
$res = $resolvers->{tag}->{ $tag };
if (not $res and my $matches = $resolvers->{tags}) {
for my $match (@$matches) {
my ($re, $rule) = @$match;
if ($tag =~ $re) {
$res = $rule;
last;
}
}
}
#unless ($res) {
# croak "Unknown tag '$tag'. Use schema 'Catchall' to ignore unknown tags";
#}
}
else {
$res = $resolvers->{value};
if ($event->{style} ne YAML_PLAIN_SCALAR_STYLE) {
return $value;
}
}
if (my $equals = $res->{equals}) {
if (exists $equals->{ $value }) {
my $res = $equals->{ $value };
if (ref $res eq 'CODE') {
return $res->($constructor, $event);
}
return $res;
}
}
if (my $regex = $res->{regex}) {
for my $item (@$regex) {
my ($re, $sub) = @$item;
my @matches = $value =~ $re;
if (@matches) {
return $sub->($constructor, $event, \@matches);
}
}
}
if (my $catch_all = $res->{all}) {
if (ref $catch_all eq 'CODE') {
return $catch_all->($constructor, $event);
}
return $catch_all;
}
return $value;
}
sub create_sequence {
my ($self, $constructor, $event) = @_;
my $tag = $event->{tag};
my $data = [];
my $on_data;
my $resolvers = $self->resolvers->{sequence};
if ($tag) {
if (my $equals = $resolvers->{tag}->{ $tag }) {
my $on_create = $equals->{on_create};
$on_data = $equals->{on_data};
$on_create and $data = $on_create->($constructor, $event);
return ($data, $on_data);
}
if (my $matches = $resolvers->{tags}) {
for my $match (@$matches) {
my ($re, $actions) = @$match;
my $on_create = $actions->{on_create};
if ($tag =~ $re) {
$on_data = $actions->{on_data};
$on_create and $data = $on_create->($constructor, $event);
return ($data, $on_data);
}
}
}
#croak "Unknown tag '$tag'. Use schema 'Catchall' to ignore unknown tags";
}
return ($data, $on_data);
}
sub create_mapping {
my ($self, $constructor, $event) = @_;
my $tag = $event->{tag};
my $data = {};
my $on_data;
my $resolvers = $self->resolvers->{mapping};
if ($tag) {
if (my $equals = $resolvers->{tag}->{ $tag }) {
my $on_create = $equals->{on_create};
$on_data = $equals->{on_data};
$on_create and $data = $on_create->($constructor, $event);
return ($data, $on_data);
}
if (my $matches = $resolvers->{tags}) {
for my $match (@$matches) {
my ($re, $actions) = @$match;
my $on_create = $actions->{on_create};
if ($tag =~ $re) {
$on_data = $actions->{on_data};
$on_create and $data = $on_create->($constructor, $event);
return ($data, $on_data);
}
}
}
#croak "Unknown tag '$tag'. Use schema 'Catchall' to ignore unknown tags";
}
return ($data, $on_data);
}
sub _bool_jsonpp_true { JSON::PP::true() }
sub _bool_booleanpm_true { boolean::true() }
sub _bool_perl_true { !!1 }
sub _bool_jsonpp_false { JSON::PP::false() }
sub _bool_booleanpm_false { boolean::false() }
sub _bool_perl_false { !!0 }
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Schema - Schema for YAML::PP
YAML-PP-v0.41.0/lib/YAML/PP/PaxHeaders/Writer.pm 0000644 0000000 0000000 00000000132 15214605475 015571 x ustar 00 30 mtime=1781730109.605560392
30 atime=1781730109.605468271
30 ctime=1781730109.605560392
YAML-PP-v0.41.0/lib/YAML/PP/Writer.pm 0000644 0001750 0001750 00000002352 15214605475 015225 0 ustar 00tina tina # ABSTRACT: Writer class for YAML::PP representing output data
use strict;
use warnings;
package YAML::PP::Writer;
our $VERSION = 'v0.41.0'; # VERSION
sub output { return $_[0]->{output} }
sub set_output { $_[0]->{output} = $_[1] }
sub new {
my ($class, %args) = @_;
my $output = delete $args{output};
$output = '' unless defined $output;
return bless {
output => $output,
}, $class;
}
sub write {
my ($self, $line) = @_;
$self->{output} .= $line;
}
sub init {
$_[0]->set_output('');
}
sub finish {
my ($self) = @_;
$_[0]->set_output(undef);
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Writer - Write YAML output
=head1 SYNOPSIS
my $writer = YAML::PP::Writer->new;
=head1 DESCRIPTION
The L sends its output to the writer.
You can use your own writer. if you want to send the YAML output to
somewhere else. See t/44.writer.t for an example.
=head1 METHODS
=over
=item new
my $writer = YAML::PP::Writer->new;
Constructor.
=item write
$writer->write('- ');
=item init
$writer->init;
Initialize
=item finish
$writer->finish;
Gets called when the output ends.
=item output, set_output
Getter/setter for the YAML output
=back
=cut
YAML-PP-v0.41.0/lib/YAML/PP/PaxHeaders/Lexer.pm 0000644 0000000 0000000 00000000132 15214605475 015374 x ustar 00 30 mtime=1781730109.603460116
30 atime=1781730109.603358636
30 ctime=1781730109.603460116
YAML-PP-v0.41.0/lib/YAML/PP/Lexer.pm 0000644 0001750 0001750 00000073474 15214605475 015045 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Lexer;
our $VERSION = 'v0.41.0'; # VERSION
use constant TRACE => $ENV{YAML_PP_TRACE} ? 1 : 0;
use constant DEBUG => ($ENV{YAML_PP_DEBUG} || $ENV{YAML_PP_TRACE}) ? 1 : 0;
use YAML::PP::Grammar qw/ $GRAMMAR /;
use Carp qw/ croak /;
sub new {
my ($class, %args) = @_;
my $self = bless {
reader => $args{reader},
}, $class;
$self->init;
return $self;
}
sub init {
my ($self) = @_;
$self->{next_tokens} = [];
$self->{next_line} = undef;
$self->{line} = 0;
$self->{offset} = 0;
$self->{flowcontext} = 0;
}
sub next_line { return $_[0]->{next_line} }
sub set_next_line { $_[0]->{next_line} = $_[1] }
sub reader { return $_[0]->{reader} }
sub set_reader { $_[0]->{reader} = $_[1] }
sub next_tokens { return $_[0]->{next_tokens} }
sub line { return $_[0]->{line} }
sub set_line { $_[0]->{line} = $_[1] }
sub offset { return $_[0]->{offset} }
sub set_offset { $_[0]->{offset} = $_[1] }
sub inc_line { return $_[0]->{line}++ }
sub context { return $_[0]->{context} }
sub set_context { $_[0]->{context} = $_[1] }
sub flowcontext { return $_[0]->{flowcontext} }
sub set_flowcontext { $_[0]->{flowcontext} = $_[1] }
sub block { return $_[0]->{block} }
sub set_block { $_[0]->{block} = $_[1] }
my $RE_WS = '[\t ]';
my $RE_LB = '[\r\n]';
my $RE_DOC_END = qr/\A(\.\.\.)(?=$RE_WS|$)/m;
my $RE_DOC_START = qr/\A(---)(?=$RE_WS|$)/m;
my $RE_EOL = qr/\A($RE_WS+#.*|$RE_WS+)\z/;
#my $RE_COMMENT_EOL = qr/\A(#.*)?(?:$RE_LB|\z)/;
#ns-word-char ::= ns-dec-digit | ns-ascii-letter | “-”
my $RE_NS_WORD_CHAR = '[0-9A-Za-z-]';
my $RE_URI_CHAR = '(?:' . '%[0-9a-fA-F]{2}' .'|'. q{[0-9A-Za-z#;/?:@&=+$,_.!*'\(\)\[\]-]} . ')';
my $RE_NS_TAG_CHAR = '(?:' . '%[0-9a-fA-F]{2}' .'|'. q{[0-9A-Za-z#;/?:@&=+$_.~*'\(\)-]} . ')';
# [#x21-#x7E] /* 8 bit */
# | #x85 | [#xA0-#xD7FF] | [#xE000-#xFFFD] /* 16 bit */
# | [#x10000-#x10FFFF] /* 32 bit */
#nb-char ::= c-printable - b-char - c-byte-order-mark
#my $RE_NB_CHAR = '[\x21-\x7E]';
my $RE_ANCHOR_CAR = '[\x21-\x2B\x2D-\x5A\x5C\x5E-\x7A\x7C\x7E\xA0-\xFF\x{100}-\x{10FFFF}]';
my $RE_PLAIN_START = '[\x21\x22\x24-\x39\x3B-\x7E\xA0-\xFF\x{100}-\x{10FFFF}]';
my $RE_PLAIN_END = '[\x21-\x39\x3B-\x7E\x85\xA0-\x{D7FF}\x{E000}-\x{FEFE}\x{FF00}-\x{FFFD}\x{10000}-\x{10FFFF}]';
my $RE_PLAIN_FIRST = '[\x24\x28-\x29\x2B\x2E-\x39\x3B-\x3D\x41-\x5A\x5C\x5E-\x5F\x61-\x7A\x7E\xA0-\xFF\x{100}-\x{10FFFF}]';
my $RE_PLAIN_START_FLOW = '[\x21\x22\x24-\x2B\x2D-\x39\x3B-\x5A\x5C\x5E-\x7A\x7C\x7E\xA0-\xFF\x{100}-\x{10FFFF}]';
my $RE_PLAIN_END_FLOW = '[\x21-\x2B\x2D-\x39\x3B-\x5A\x5C\x5E-\x7A\x7C\x7E\x85\xA0-\x{D7FF}\x{E000}-\x{FEFE}\x{FF00}-\x{FFFD}\x{10000}-\x{10FFFF}]';
my $RE_PLAIN_FIRST_FLOW = '[\x24\x28-\x29\x2B\x2E-\x39\x3B-\x3D\x41-\x5A\x5C\x5E-\x5F\x61-\x7A\x7C\x7E\xA0-\xFF\x{100}-\x{10FFFF}]';
# c-indicators
#! 21
#" 22
## 23
#% 25
#& 26
#' 27
#* 2A
#, 2C FLOW
#- 2D XX
#: 3A XX
#> 3E
#? 3F XX
#@ 40
#[ 5B FLOW
#] 5D FLOW
#` 60
#{ 7B FLOW
#| 7C
#} 7D FLOW
my $RE_PLAIN_WORD = "(?::+$RE_PLAIN_END|$RE_PLAIN_START)(?::+$RE_PLAIN_END|$RE_PLAIN_END)*";
my $RE_PLAIN_FIRST_WORD = "(?:[:?-]+$RE_PLAIN_END|$RE_PLAIN_FIRST)(?::+$RE_PLAIN_END|$RE_PLAIN_END)*";
my $RE_PLAIN_WORDS = "(?:$RE_PLAIN_FIRST_WORD(?:$RE_WS+$RE_PLAIN_WORD)*)";
my $RE_PLAIN_WORDS2 = "(?:$RE_PLAIN_WORD(?:$RE_WS+$RE_PLAIN_WORD)*)";
my $RE_PLAIN_WORD_FLOW = "(?::+$RE_PLAIN_END_FLOW|$RE_PLAIN_START_FLOW)(?::+$RE_PLAIN_END_FLOW|$RE_PLAIN_END_FLOW)*";
my $RE_PLAIN_FIRST_WORD_FLOW = "(?:[:?-]+$RE_PLAIN_END_FLOW|$RE_PLAIN_FIRST_FLOW)(?::+$RE_PLAIN_END_FLOW|$RE_PLAIN_END_FLOW)*";
my $RE_PLAIN_WORDS_FLOW = "(?:$RE_PLAIN_FIRST_WORD_FLOW(?:$RE_WS+$RE_PLAIN_WORD_FLOW)*)";
my $RE_PLAIN_WORDS_FLOW2 = "(?:$RE_PLAIN_WORD_FLOW(?:$RE_WS+$RE_PLAIN_WORD_FLOW)*)";
#c-secondary-tag-handle ::= “!” “!”
#c-named-tag-handle ::= “!” ns-word-char+ “!”
#ns-tag-char ::= ns-uri-char - “!” - c-flow-indicator
#ns-global-tag-prefix ::= ns-tag-char ns-uri-char*
#c-ns-local-tag-prefix ::= “!” ns-uri-char*
my $RE_TAG = "!(?:$RE_NS_WORD_CHAR*!$RE_NS_TAG_CHAR+|$RE_NS_TAG_CHAR+|<$RE_URI_CHAR+>|)";
#c-ns-anchor-property ::= “&” ns-anchor-name
#ns-char ::= nb-char - s-white
#ns-anchor-char ::= ns-char - c-flow-indicator
#ns-anchor-name ::= ns-anchor-char+
my $RE_SEQSTART = qr/\A(-)(?=$RE_WS|$)/m;
my $RE_COMPLEX = qr/(\?)(?=$RE_WS|$)/m;
my $RE_COMPLEXCOLON = qr/\A(:)(?=$RE_WS|$)/m;
my $RE_ANCHOR = "&$RE_ANCHOR_CAR+";
my $RE_ALIAS = "\\*$RE_ANCHOR_CAR+";
my %REGEXES = (
ANCHOR => qr{($RE_ANCHOR)},
TAG => qr{($RE_TAG)},
ALIAS => qr{($RE_ALIAS)},
SINGLEQUOTED => qr{(?:''|[^'\r\n]+)*},
);
sub _fetch_next_line {
my ($self) = @_;
my $next_line = $self->next_line;
if (defined $next_line ) {
return $next_line;
}
my $line = $self->reader->readline;
unless (defined $line) {
$self->set_next_line(undef);
return;
}
$self->set_block(1);
$self->inc_line;
$line =~ m/\A( *)([^\r\n]*)([\r\n]|\z)/ or die "Unexpected";
$next_line = [ $1, $2, $3 ];
$self->set_next_line($next_line);
# $ESCAPE_CHAR from YAML.pm
if ($line =~ tr/\x00-\x08\x0b-\x0c\x0e-\x1f//) {
$self->exception("Control characters are not allowed");
}
return $next_line;
}
my %TOKEN_NAMES = (
'"' => 'DOUBLEQUOTE',
"'" => 'SINGLEQUOTE',
'|' => 'LITERAL',
'>' => 'FOLDED',
'!' => 'TAG',
'*' => 'ALIAS',
'&' => 'ANCHOR',
':' => 'COLON',
'-' => 'DASH',
'?' => 'QUESTION',
'[' => 'FLOWSEQ_START',
']' => 'FLOWSEQ_END',
'{' => 'FLOWMAP_START',
'}' => 'FLOWMAP_END',
',' => 'FLOW_COMMA',
'---' => 'DOC_START',
'...' => 'DOC_END',
);
sub fetch_next_tokens {
my ($self) = @_;
my $next = $self->next_tokens;
return $next if @$next;
my $next_line = $self->_fetch_next_line;
if (not $next_line) {
return [];
}
my $spaces = $next_line->[0];
my $yaml = \$next_line->[1];
if (not length $$yaml) {
$self->_push_tokens([ EOL => join('', @$next_line), $self->line ]);
$self->set_next_line(undef);
return $next;
}
if (substr($$yaml, 0, 1) eq '#') {
$self->_push_tokens([ EOL => join('', @$next_line), $self->line ]);
$self->set_next_line(undef);
return $next;
}
if (not $spaces and substr($$yaml, 0, 1) eq "%") {
$self->_fetch_next_tokens_directive($yaml, $next_line->[2]);
$self->set_context(0);
$self->set_next_line(undef);
return $next;
}
if (not $spaces and $$yaml =~ s/\A(---|\.\.\.)(?=$RE_WS|\z)//) {
$self->_push_tokens([ $TOKEN_NAMES{ $1 } => $1, $self->line ]);
}
elsif ($self->flowcontext and $$yaml =~ m/\A[ \t]+(#.*)?\z/) {
$self->_push_tokens([ EOL => join('', @$next_line), $self->line ]);
$self->set_next_line(undef);
return $next;
}
else {
$self->_push_tokens([ SPACE => $spaces, $self->line ]);
}
my $partial = $self->_fetch_next_tokens($next_line);
unless ($partial) {
$self->set_next_line(undef);
}
return $next;
}
my %ANCHOR_ALIAS_TAG = ( '&' => 1, '*' => 1, '!' => 1 );
my %BLOCK_SCALAR = ( '|' => 1, '>' => 1 );
my %COLON_DASH_QUESTION = ( ':' => 1, '-' => 1, '?' => 1 );
my %QUOTED = ( '"' => 1, "'" => 1 );
my %FLOW = ( '{' => 1, '[' => 1, '}' => 1, ']' => 1, ',' => 1 );
my %CONTEXT = ( '"' => 1, "'" => 1, '>' => 1, '|' => 1 );
my $RE_ESCAPES = qr{(?:
\\([ \\\/_0abefnrtvLNP\t"]) | \\x([0-9a-fA-F]{2})
| \\u([A-Fa-f0-9]{4}) | \\U([A-Fa-f0-9]{4,8})
)}x;
my %CONTROL = (
'\\' => '\\', '/' => '/', n => "\n", t => "\t", r => "\r", b => "\b",
'a' => "\a", 'b' => "\b", 'e' => "\e", 'f' => "\f", 'v' => "\x0b", "\t" => "\t",
'P' => "\x{2029}", L => "\x{2028}", 'N' => "\x85",
'0' => "\0", '_' => "\xa0", ' ' => ' ', q/"/ => q/"/,
);
sub _fetch_next_tokens {
TRACE and warn __PACKAGE__.':'.__LINE__.": _fetch_next_tokens\n";
my ($self, $next_line) = @_;
my $yaml = \$next_line->[1];
my $eol = $next_line->[2];
my @tokens;
while (1) {
unless (length $$yaml) {
push @tokens, ( EOL => $eol, $self->line );
$self->_push_tokens(\@tokens);
return;
}
my $first = substr($$yaml, 0, 1);
my $plain = 0;
if ($self->context) {
if ($$yaml =~ s/\A($RE_WS*)://) {
push @tokens, ( WS => $1, $self->line ) if $1;
push @tokens, ( COLON => ':', $self->line );
$self->set_context(0);
next;
}
if ($$yaml =~ s/\A($RE_WS*(?: #.*))\z//) {
push @tokens, ( EOL => $1 . $eol, $self->line );
$self->_push_tokens(\@tokens);
return;
}
$self->set_context(0);
}
if ($CONTEXT{ $first }) {
push @tokens, ( CONTEXT => $first, $self->line );
$self->_push_tokens(\@tokens);
return 1;
}
elsif ($COLON_DASH_QUESTION{ $first }) {
my $token_name = $TOKEN_NAMES{ $first };
if ($$yaml =~ s/\A\Q$first\E($RE_WS+|\z)//) {
my $after = $1;
if (not $self->flowcontext and not $self->block) {
push @tokens, ERROR => $first . $after, $self->line;
$self->_push_tokens(\@tokens);
$self->exception("Tabs can not be used for indentation");
}
if ($after =~ tr/\t//) {
$self->set_block(0);
}
my $token_name = $TOKEN_NAMES{ $first };
push @tokens, ( $token_name => $first, $self->line );
if (not defined $1) {
push @tokens, ( EOL => $eol, $self->line );
$self->_push_tokens(\@tokens);
return;
}
my $ws = $1;
if ($$yaml =~ s/\A(#.*|)\z//) {
push @tokens, ( EOL => $ws . $1 . $eol, $self->line );
$self->_push_tokens(\@tokens);
return;
}
push @tokens, ( WS => $ws, $self->line );
next;
}
elsif ($self->flowcontext and $$yaml =~ s/\A:(?=[,\{\}\[\]])//) {
push @tokens, ( $token_name => $first, $self->line );
next;
}
$plain = 1;
}
elsif ($ANCHOR_ALIAS_TAG{ $first }) {
my $token_name = $TOKEN_NAMES{ $first };
my $REGEX = $REGEXES{ $token_name };
if ($$yaml =~ s/\A$REGEX//) {
push @tokens, ( $token_name => $1, $self->line );
}
else {
push @tokens, ( "Invalid $token_name" => $$yaml, $self->line );
$self->_push_tokens(\@tokens);
return;
}
}
elsif ($first eq ' ' or $first eq "\t") {
if ($$yaml =~ s/\A($RE_WS+)//) {
my $ws = $1;
if ($$yaml =~ s/\A((?:#.*)?\z)//) {
push @tokens, ( EOL => $ws . $1 . $eol, $self->line );
$self->_push_tokens(\@tokens);
return;
}
push @tokens, ( WS => $ws, $self->line );
}
}
elsif ($FLOW{ $first }) {
push @tokens, ( $TOKEN_NAMES{ $first } => $first, $self->line );
substr($$yaml, 0, 1, '');
my $flowcontext = $self->flowcontext;
if ($first eq '{' or $first eq '[') {
$self->set_flowcontext(++$flowcontext);
}
elsif ($first eq '}' or $first eq ']') {
$self->set_flowcontext(--$flowcontext);
}
}
else {
$plain = 1;
}
if ($plain) {
push @tokens, ( CONTEXT => '', $self->line );
$self->_push_tokens(\@tokens);
return 1;
}
}
return;
}
sub fetch_plain {
my ($self, $indent, $context) = @_;
my $next_line = $self->next_line;
my $yaml = \$next_line->[1];
my $eol = $next_line->[2];
my $REGEX = $RE_PLAIN_WORDS;
if ($self->flowcontext) {
$REGEX = $RE_PLAIN_WORDS_FLOW;
}
my @tokens;
unless ($$yaml =~ s/\A($REGEX(?:[:]+(?=\:(\s|\z)))?)//) {
$self->_push_tokens(\@tokens);
$self->exception("Invalid plain scalar");
}
my $plain = $1;
push @tokens, ( PLAIN => $plain, $self->line );
if ($$yaml =~ s/\A(?:($RE_WS+#.*)|($RE_WS*))\z//) {
if (defined $1) {
push @tokens, ( EOL => $1 . $eol, $self->line );
$self->_push_tokens(\@tokens);
$self->set_next_line(undef);
return;
}
else {
push @tokens, ( EOL => $2. $eol, $self->line );
$self->set_next_line(undef);
}
}
else {
$self->_push_tokens(\@tokens);
my $partial = $self->_fetch_next_tokens($next_line);
if (not $partial) {
$self->set_next_line(undef);
}
return;
}
my $RE2 = $RE_PLAIN_WORDS2;
if ($self->flowcontext) {
$RE2 = $RE_PLAIN_WORDS_FLOW2;
}
my $fetch_next = 0;
my @lines = ($plain);
my @next;
LOOP: while (1) {
$next_line = $self->_fetch_next_line;
if (not $next_line) {
last LOOP;
}
my $spaces = $next_line->[0];
my $yaml = \$next_line->[1];
my $eol = $next_line->[2];
if (not length $$yaml) {
push @tokens, ( EOL => $spaces . $eol, $self->line );
$self->set_next_line(undef);
push @lines, '';
next LOOP;
}
if (not $spaces and $$yaml =~ s/\A(---|\.\.\.)(?=$RE_WS|\z)//) {
push @next, $TOKEN_NAMES{ $1 } => $1, $self->line;
$fetch_next = 1;
last LOOP;
}
if ((length $spaces) < $indent) {
last LOOP;
}
my $ws = '';
if ($$yaml =~ s/\A($RE_WS+)//) {
$ws = $1;
}
if (not length $$yaml) {
push @tokens, ( EOL => $spaces . $ws . $eol, $self->line );
$self->set_next_line(undef);
push @lines, '';
next LOOP;
}
if ($$yaml =~ s/\A(#.*)\z//) {
push @tokens, ( EOL => $spaces . $ws . $1 . $eol, $self->line );
$self->set_next_line(undef);
last LOOP;
}
if ($$yaml =~ s/\A($RE2)//) {
push @tokens, INDENT => $spaces, $self->line;
push @tokens, WS => $ws, $self->line;
push @tokens, PLAIN => $1, $self->line;
push @lines, $1;
my $ws = '';
if ($$yaml =~ s/\A($RE_WS+)//) {
$ws = $1;
}
if (not length $$yaml) {
push @tokens, EOL => $ws . $eol, $self->line;
$self->set_next_line(undef);
next LOOP;
}
if ($$yaml =~ s/\A(#.*)\z//) {
push @tokens, EOL => $ws . $1 . $eol, $self->line;
$self->set_next_line(undef);
last LOOP;
}
else {
push @tokens, WS => $ws, $self->line if $ws;
$fetch_next = 1;
}
}
else {
push @tokens, SPACE => $spaces, $self->line;
push @tokens, WS => $ws, $self->line;
if ($self->flowcontext) {
$fetch_next = 1;
}
else {
push @tokens, ERROR => $$yaml, $self->line;
}
}
last LOOP;
}
# remove empty lines at the end
while (@lines > 1 and $lines[-1] eq '') {
pop @lines;
}
if (@lines > 1) {
my $value = YAML::PP::Render->render_multi_val(\@lines);
my @eol;
if ($tokens[-3] eq 'EOL') {
@eol = splice @tokens, -3;
}
$self->push_subtokens( { name => 'PLAIN_MULTI', value => $value }, \@tokens);
$self->_push_tokens([ @eol, @next ]);
}
else {
$self->_push_tokens([ @tokens, @next ]);
}
@tokens = ();
if ($fetch_next) {
my $partial = $self->_fetch_next_tokens($next_line);
if (not $partial) {
$self->set_next_line(undef);
}
}
return;
}
sub fetch_block {
my ($self, $indent, $context) = @_;
my $next_line = $self->next_line;
my $yaml = \$next_line->[1];
my $eol = $next_line->[2];
my @tokens;
my $token_name = $TOKEN_NAMES{ $context };
$$yaml =~ s/\A\Q$context\E// or die "Unexpected";
push @tokens, ( $token_name => $context, $self->line );
my $current_indent = $indent;
my $started = 0;
my $set_indent = 0;
my $chomp = '';
if ($$yaml =~ s/\A([1-9])([+-]?)//) {
push @tokens, ( BLOCK_SCALAR_INDENT => $1, $self->line );
$set_indent = $1;
$chomp = $2 if $2;
push @tokens, ( BLOCK_SCALAR_CHOMP => $2, $self->line ) if $2;
}
elsif ($$yaml =~ s/\A([+-])([1-9])?//) {
push @tokens, ( BLOCK_SCALAR_CHOMP => $1, $self->line );
$chomp = $1;
push @tokens, ( BLOCK_SCALAR_INDENT => $2, $self->line ) if $2;
$set_indent = $2 if $2;
}
if ($set_indent) {
$started = 1;
$indent-- if $indent > 0;
$current_indent = $indent + $set_indent;
}
if (not length $$yaml) {
push @tokens, ( EOL => $eol, $self->line );
}
elsif ($$yaml =~ s/\A($RE_WS*(?:$RE_WS#.*|))\z//) {
push @tokens, ( EOL => $1 . $eol, $self->line );
}
else {
$self->_push_tokens(\@tokens);
$self->exception("Invalid block scalar");
}
my @lines;
while (1) {
$self->set_next_line(undef);
$next_line = $self->_fetch_next_line;
if (not $next_line) {
last;
}
my $spaces = $next_line->[0];
my $content = $next_line->[1];
my $eol = $next_line->[2];
if (not $spaces and $content =~ m/\A(---|\.\.\.)(?=$RE_WS|\z)/) {
last;
}
if ((length $spaces) < $current_indent) {
if (length $content) {
if ($content =~ m/\A\t/) {
$self->_push_tokens(\@tokens);
$self->exception("Invalid block scalar");
}
last;
}
else {
push @lines, '';
push @tokens, ( EOL => $spaces . $eol, $self->line );
next;
}
}
if ((length $spaces) > $current_indent) {
if ($started) {
($spaces, my $more_spaces) = unpack "a${current_indent}a*", $spaces;
$content = $more_spaces . $content;
}
}
unless (length $content) {
push @lines, '';
push @tokens, ( INDENT => $spaces, $self->line, EOL => $eol, $self->line );
unless ($started) {
$current_indent = length $spaces;
}
next;
}
unless ($started) {
$started = 1;
$current_indent = length $spaces;
}
push @lines, $content;
push @tokens, (
INDENT => $spaces, $self->line,
BLOCK_SCALAR_CONTENT => $content, $self->line,
EOL => $eol, $self->line,
);
}
my $value = YAML::PP::Render->render_block_scalar($context, $chomp, \@lines);
my @eol = splice @tokens, -3;
$self->push_subtokens( { name => 'BLOCK_SCALAR', value => $value }, \@tokens );
$self->_push_tokens([ @eol ]);
return 0;
}
sub fetch_quoted {
my ($self, $indent, $context) = @_;
my $next_line = $self->next_line;
my $yaml = \$next_line->[1];
my $spaces = $next_line->[0];
my $token_name = $TOKEN_NAMES{ $context };
$$yaml =~ s/\A\Q$context// or die "Unexpected";;
my @tokens = ( $token_name => $context, $self->line );
my $start = 1;
my @values;
while (1) {
unless ($start) {
$next_line = $self->_fetch_next_line or do {
for (my $i = 0; $i < @tokens; $i+= 3) {
my $token = $tokens[ $i + 1 ];
if (ref $token) {
$tokens[ $i + 1 ] = $token->{orig};
}
}
$self->_push_tokens(\@tokens);
$self->exception("Missing closing quote <$context> at EOF");
};
$start = 0;
$spaces = $next_line->[0];
$yaml = \$next_line->[1];
if (not length $$yaml) {
push @tokens, ( EOL => $spaces . $next_line->[2], $self->line );
$self->set_next_line(undef);
push @values, { value => '', orig => '' };
next;
}
elsif (not $spaces and $$yaml =~ m/\A(---|\.\.\.)(?=$RE_WS|\z)/) {
for (my $i = 0; $i < @tokens; $i+= 3) {
my $token = $tokens[ $i + 1 ];
if (ref $token) {
$tokens[ $i + 1 ] = $token->{orig};
}
}
$self->_push_tokens(\@tokens);
$self->exception("Missing closing quote <$context> or invalid document marker");
}
elsif ((length $spaces) < $indent) {
for (my $i = 0; $i < @tokens; $i+= 3) {
my $token = $tokens[ $i + 1 ];
if (ref $token) {
$tokens[ $i + 1 ] = $token->{orig};
}
}
$self->_push_tokens(\@tokens);
$self->exception("Wrong indendation or missing closing quote <$context>");
}
if ($$yaml =~ s/\A($RE_WS+)//) {
$spaces .= $1;
}
push @tokens, ( WS => $spaces, $self->line );
}
my $v = $self->_read_quoted_tokens($start, $context, $yaml, \@tokens);
push @values, $v;
if ($tokens[-3] eq $token_name) {
if ($start) {
$self->push_subtokens(
{ name => 'QUOTED', value => $v->{value} }, \@tokens
);
}
else {
my $value = YAML::PP::Render->render_quoted($context, \@values);
$self->push_subtokens(
{ name => 'QUOTED_MULTILINE', value => $value }, \@tokens
);
}
$self->set_context(1) if $self->flowcontext;
if (length $$yaml) {
my $partial = $self->_fetch_next_tokens($next_line);
if (not $partial) {
$self->set_next_line(undef);
}
return 0;
}
else {
@tokens = ();
push @tokens, ( EOL => $next_line->[2], $self->line );
$self->_push_tokens(\@tokens);
$self->set_next_line(undef);
return;
}
}
$tokens[-2] .= $next_line->[2];
$self->set_next_line(undef);
$start = 0;
}
}
sub _read_quoted_tokens {
my ($self, $start, $first, $yaml, $tokens) = @_;
my $quoted = '';
my $decoded = '';
my $token_name = $TOKEN_NAMES{ $first };
my $eol = '';
if ($first eq "'") {
my $regex = $REGEXES{SINGLEQUOTED};
if ($$yaml =~ s/\A($regex)//) {
$quoted .= $1;
$decoded .= $1;
$decoded =~ s/''/'/g;
}
unless (length $$yaml) {
if ($quoted =~ s/($RE_WS+)\z//) {
$eol = $1;
$decoded =~ s/($eol)\z//;
}
}
}
else {
($quoted, $decoded, $eol) = $self->_read_doublequoted($yaml);
}
my $value = { value => $decoded, orig => $quoted };
if ($$yaml =~ s/\A$first//) {
if ($start) {
push @$tokens, ( $token_name . 'D' => $value, $self->line );
}
else {
push @$tokens, ( $token_name . 'D_LINE' => $value, $self->line );
}
push @$tokens, ( $token_name => $first, $self->line );
return $value;
}
if (length $$yaml) {
push @$tokens, ( $token_name . 'D' => $value->{orig}, $self->line );
$self->_push_tokens($tokens);
$self->exception("Invalid quoted <$first> string");
}
push @$tokens, ( $token_name . 'D_LINE' => $value, $self->line );
push @$tokens, ( EOL => $eol, $self->line );
return $value;
}
sub _read_doublequoted {
my ($self, $yaml) = @_;
my $quoted = '';
my $decoded = '';
my $eol = '';
while (1) {
my $last = 1;
if ($$yaml =~ s/\A([^"\\ \t]+)//) {
$quoted .= $1;
$decoded .= $1;
$last = 0;
}
if ($$yaml =~ s/\A($RE_ESCAPES)//) {
$quoted .= $1;
my $dec = defined $2 ? $CONTROL{ $2 }
: defined $3 ? chr hex $3
: defined $4 ? chr hex $4
: chr hex $5;
$decoded .= $dec;
$last = 0;
}
if ($$yaml =~ s/\A([ \t]+)//) {
my $spaces = $1;
if (length $$yaml) {
$quoted .= $spaces;
$decoded .= $spaces;
$last = 0;
}
else {
$eol = $spaces;
last;
}
}
if ($$yaml =~ s/\A(\\)\z//) {
$quoted .= $1;
$decoded .= $1;
last;
}
last if $last;
}
return ($quoted, $decoded, $eol);
}
sub _fetch_next_tokens_directive {
my ($self, $yaml, $eol) = @_;
my @tokens;
my $trailing_ws = '';
my $warn = $ENV{YAML_PP_RESERVED_DIRECTIVE} || 'warn';
if ($$yaml =~ s/\A(\s*%YAML[ \t]+([0-9]+\.[0-9]+))//) {
my $dir = $1;
my $version = $2;
if ($$yaml =~ s/\A($RE_WS+)//) {
$trailing_ws = $1;
}
elsif (length $$yaml) {
push @tokens, ( 'Invalid directive' => $dir.$$yaml.$eol, $self->line );
$self->_push_tokens(\@tokens);
return;
}
if ($version !~ m/^1\.[12]$/) {
if ($warn eq 'warn') {
warn "Unsupported YAML version '$dir'";
}
elsif ($warn eq 'fatal') {
push @tokens, ( 'Unsupported YAML version' => $dir, $self->line );
$self->_push_tokens(\@tokens);
return;
}
}
push @tokens, ( YAML_DIRECTIVE => $dir, $self->line );
}
elsif ($$yaml =~ s/\A(\s*%TAG[ \t]+(!$RE_NS_WORD_CHAR*!|!)[ \t]+(tag:\S+|!$RE_URI_CHAR+))($RE_WS*)//) {
push @tokens, ( TAG_DIRECTIVE => $1, $self->line );
# TODO
my $tag_alias = $2;
my $tag_url = $3;
$trailing_ws = $4;
}
elsif ($$yaml =~ s/\A(\s*\A%(?:\w+).*)//) {
push @tokens, ( RESERVED_DIRECTIVE => $1, $self->line );
if ($warn eq 'warn') {
warn "Found reserved directive '$1'";
}
elsif ($warn eq 'fatal') {
die "Found reserved directive '$1'";
}
}
else {
push @tokens, ( 'Invalid directive' => $$yaml, $self->line );
push @tokens, ( EOL => $eol, $self->line );
$self->_push_tokens(\@tokens);
return;
}
if (not length $$yaml) {
push @tokens, ( EOL => $eol, $self->line );
}
elsif ($trailing_ws and $$yaml =~ s/\A(#.*)?\z//) {
push @tokens, ( EOL => "$trailing_ws$1$eol", $self->line );
$self->_push_tokens(\@tokens);
return;
}
elsif ($$yaml =~ s/\A([ \t]+#.*)?\z//) {
push @tokens, ( EOL => "$1$eol", $self->line );
$self->_push_tokens(\@tokens);
return;
}
else {
push @tokens, ( 'Invalid directive' => $trailing_ws.$$yaml, $self->line );
push @tokens, ( EOL => $eol, $self->line );
}
$self->_push_tokens(\@tokens);
return;
}
sub _push_tokens {
my ($self, $new_tokens) = @_;
my $next = $self->next_tokens;
my $line = $self->line;
my $column = $self->offset;
for (my $i = 0; $i < @$new_tokens; $i += 3) {
my $value = $new_tokens->[ $i + 1 ];
my $name = $new_tokens->[ $i ];
my $line = $new_tokens->[ $i + 2 ];
my $push = {
name => $name,
line => $line,
column => $column,
value => $value,
};
$column += length $value unless $name eq 'CONTEXT';
push @$next, $push;
if ($name eq 'EOL') {
$column = 0;
}
}
$self->set_offset($column);
return $next;
}
sub push_subtokens {
my ($self, $token, $subtokens) = @_;
my $next = $self->next_tokens;
my $line = $self->line;
my $column = $self->offset;
$token->{column} = $column;
$token->{subtokens} = \my @sub;
for (my $i = 0; $i < @$subtokens; $i+=3) {
my $name = $subtokens->[ $i ];
my $value = $subtokens->[ $i + 1 ];
my $line = $subtokens->[ $i + 2 ];
my $push = {
name => $subtokens->[ $i ],
line => $line,
column => $column,
};
if (ref $value eq 'HASH') {
%$push = ( %$push, %$value );
$column += length $value->{orig};
}
else {
$push->{value} = $value;
$column += length $value;
}
if ($push->{name} eq 'EOL') {
$column = 0;
}
push @sub, $push;
}
$token->{line} = $sub[0]->{line};
push @$next, $token;
$self->set_offset($column);
return $next;
}
sub exception {
my ($self, $msg) = @_;
my $next = $self->next_tokens;
$next = [];
my $line = @$next ? $next->[0]->{line} : $self->line;
my @caller = caller(0);
my $yaml = '';
if (my $nl = $self->next_line) {
$yaml = join '', @$nl;
$yaml = $nl->[1];
}
my $e = YAML::PP::Exception->new(
line => $line,
column => $self->offset + 1,
msg => $msg,
next => $next,
where => $caller[1] . ' line ' . $caller[2],
yaml => $yaml,
);
croak $e;
}
1;
YAML-PP-v0.41.0/lib/YAML/PP/PaxHeaders/Perl.pm 0000644 0000000 0000000 00000000130 15214605475 015215 x ustar 00 29 mtime=1781730109.60031515
30 atime=1781730109.600170997
29 ctime=1781730109.60031515
YAML-PP-v0.41.0/lib/YAML/PP/Perl.pm 0000644 0001750 0001750 00000002767 15214605475 014665 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Perl;
our $VERSION = 'v0.41.0'; # VERSION
use base 'Exporter';
use base 'YAML::PP';
our @EXPORT_OK = qw/ Load Dump LoadFile DumpFile /;
use YAML::PP;
use YAML::PP::Schema::Perl;
sub new {
my ($class, %args) = @_;
$args{schema} ||= [qw/ Core Perl /];
$class->SUPER::new(%args);
}
sub Load {
my ($yaml) = @_;
__PACKAGE__->new->load_string($yaml);
}
sub LoadFile {
my ($file) = @_;
__PACKAGE__->new->load_file($file);
}
sub Dump {
my (@data) = @_;
__PACKAGE__->new->dump_string(@data);
}
sub DumpFile {
my ($file, @data) = @_;
__PACKAGE__->new->dump_file($file, @data);
}
1;
__END__
=pod
=encoding utf-8
=head1 NAME
YAML::PP::Perl - Convenience module for loading and dumping Perl objects
=head1 SYNOPSIS
use YAML::PP::Perl;
my @docs = YAML::PP::Perl->new->load_string($yaml);
my @docs = YAML::PP::Perl::Load($yaml);
# same as
use YAML::PP;
my $yp = YAML::PP->new( schema => [qw/ Core Perl /] );
my @docs = $yp->load_string($yaml);
=head1 DESCRIPTION
This is just for convenience. It will create a YAML::PP object using the
default schema (C) and the L schema.
See L for documentation.
=head1 METHODS
=over
=item Load, Dump, LoadFile, DumpFile
These work like the functions in L, just adding the C schema.
=item new
Constructor, works like in L, just adds the C schema to the
list of arguments.
=back
YAML-PP-v0.41.0/lib/YAML/PaxHeaders/PP.pm 0000644 0000000 0000000 00000000132 15214605475 014315 x ustar 00 30 mtime=1781730109.593613081
30 atime=1781730109.593554484
30 ctime=1781730109.593613081
YAML-PP-v0.41.0/lib/YAML/PP.pm 0000644 0001750 0001750 00000113113 15214605475 013747 0 ustar 00tina tina # ABSTRACT: YAML 1.2 Processor
use strict;
use warnings;
package YAML::PP;
our $VERSION = 'v0.41.0'; # VERSION
use YAML::PP::Schema;
use YAML::PP::Schema::JSON;
use YAML::PP::Loader;
use YAML::PP::Dumper;
use Scalar::Util qw/ blessed /;
use Carp qw/ croak /;
use base 'Exporter';
our @EXPORT_OK = qw/ Load LoadFile Dump DumpFile /;
my %YAML_VERSIONS = ('1.1' => 1, '1.2' => 1);
sub new {
my ($class, %args) = @_;
my $bool = delete $args{boolean};
$bool = 'perl' unless defined $bool;
my $schemas = delete $args{schema} || ['+'];
my $cyclic_refs = delete $args{cyclic_refs} || 'fatal';
my $indent = delete $args{indent};
my $width = delete $args{width};
my $writer = delete $args{writer};
my $header = delete $args{header};
my $footer = delete $args{footer};
my $require_footer = delete $args{require_footer};
my $duplicate_keys = delete $args{duplicate_keys};
my $max_depth = delete $args{max_depth};
my $yaml_version = $class->_arg_yaml_version(delete $args{yaml_version});
my $default_yaml_version = $yaml_version->[0];
my $version_directive = delete $args{version_directive};
my $preserve = delete $args{preserve};
my $parser = delete $args{parser};
my $emitter = delete $args{emitter} || {
indent => $indent,
width => $width,
writer => $writer,
};
if (keys %args) {
die "Unexpected arguments: " . join ', ', sort keys %args;
}
my %schemas;
for my $v (@$yaml_version) {
my $schema;
if (blessed($schemas) and $schemas->isa('YAML::PP::Schema')) {
$schema = $schemas;
}
else {
$schema = YAML::PP::Schema->new(
boolean => $bool,
yaml_version => $v,
);
$schema->load_subschemas(@$schemas);
}
$schemas{ $v } = $schema;
}
my $default_schema = $schemas{ $default_yaml_version };
my $loader = YAML::PP::Loader->new(
schemas => \%schemas,
cyclic_refs => $cyclic_refs,
parser => $parser,
default_yaml_version => $default_yaml_version,
preserve => $preserve,
duplicate_keys => $duplicate_keys,
require_footer => $require_footer,
max_depth => $max_depth,
);
my $dumper = YAML::PP::Dumper->new(
schema => $default_schema,
emitter => $emitter,
header => $header,
footer => $footer,
version_directive => $version_directive,
preserve => $preserve,
);
my $self = bless {
schema => \%schemas,
loader => $loader,
dumper => $dumper,
}, $class;
return $self;
}
sub clone {
my ($self) = @_;
my $clone = {
schema => $self->schema,
loader => $self->loader->clone,
dumper => $self->dumper->clone,
};
return bless $clone, ref $self;
}
sub _arg_yaml_version {
my ($class, $version) = @_;
my @versions = ('1.2');
if (defined $version) {
@versions = ();
if (not ref $version) {
$version = [$version];
}
for my $v (@$version) {
unless ($YAML_VERSIONS{ $v }) {
croak "YAML Version '$v' not supported";
}
push @versions, $v;
}
}
return \@versions;
}
sub loader {
if (@_ > 1) {
$_[0]->{loader} = $_[1]
}
return $_[0]->{loader};
}
sub dumper {
if (@_ > 1) {
$_[0]->{dumper} = $_[1]
}
return $_[0]->{dumper};
}
sub schema {
if (@_ > 1) { $_[0]->{schema}->{'1.2'} = $_[1] }
return $_[0]->{schema}->{'1.2'};
}
sub default_schema {
my ($self, %args) = @_;
my $schema = YAML::PP::Schema->new(
boolean => $args{boolean},
);
$schema->load_subschemas(qw/ Core /);
return $schema;
}
sub load_string {
my ($self, $yaml) = @_;
return $self->loader->load_string($yaml);
}
sub load_file {
my ($self, $file) = @_;
return $self->loader->load_file($file);
}
sub dump {
my ($self, @data) = @_;
return $self->dumper->dump(@data);
}
sub dump_string {
my ($self, @data) = @_;
return $self->dumper->dump_string(@data);
}
sub dump_file {
my ($self, $file, @data) = @_;
return $self->dumper->dump_file($file, @data);
}
# legagy interface
sub Load {
my ($yaml) = @_;
YAML::PP->new->load_string($yaml);
}
sub LoadFile {
my ($file) = @_;
YAML::PP->new->load_file($file);
}
sub Dump {
my (@data) = @_;
YAML::PP->new->dump_string(@data);
}
sub DumpFile {
my ($file, @data) = @_;
YAML::PP->new->dump_file($file, @data);
}
sub preserved_scalar {
my ($self, $value, %args) = @_;
my $scalar = YAML::PP::Preserve::Scalar->new(
value => $value,
%args,
);
return $scalar;
}
sub preserved_mapping {
my ($self, $hash, %args) = @_;
my $data = {};
tie %$data, 'YAML::PP::Preserve::Hash';
%$data = %$hash;
my $t = tied %$data;
$t->{style} = $args{style};
$t->{alias} = $args{alias};
return $data;
}
sub preserved_sequence {
my ($self, $array, %args) = @_;
my $data = [];
tie @$data, 'YAML::PP::Preserve::Array';
push @$data, @$array;
my $t = tied @$data;
$t->{style} = $args{style};
$t->{alias} = $args{alias};
return $data;
}
package YAML::PP::Preserve::Hash;
# experimental
use Tie::Hash;
use base qw/ Tie::StdHash /;
use Scalar::Util qw/ reftype blessed /;
sub TIEHASH {
my ($class, %args) = @_;
my $self = bless {
keys => [keys %args],
data => { %args },
}, $class;
}
sub STORE {
my ($self, $key, $val) = @_;
my $keys = $self->{keys};
unless (exists $self->{data}->{ $key }) {
push @$keys, $key;
}
if (ref $val and not blessed($val)) {
if (reftype($val) eq 'HASH' and not tied %$val) {
tie %$val, 'YAML::PP::Preserve::Hash', %$val;
}
elsif (reftype($val) eq 'ARRAY' and not tied @$val) {
tie @$val, 'YAML::PP::Preserve::Array', @$val;
}
}
$self->{data}->{ $key } = $val;
}
sub FIRSTKEY {
my ($self) = @_;
return $self->{keys}->[0];
}
sub NEXTKEY {
my ($self, $last) = @_;
my $keys = $self->{keys};
for my $i (0 .. $#$keys) {
if ("$keys->[ $i ]" eq "$last") {
return $keys->[ $i + 1 ];
}
}
return;
}
sub FETCH {
my ($self, $key) = @_;
my $val = $self->{data}->{ $key };
}
sub DELETE {
my ($self, $key) = @_;
@{ $self->{keys} } = grep { "$_" ne "$key" } @{ $self->{keys} };
delete $self->{data}->{ $key };
}
sub EXISTS {
my ($self, $key) = @_;
return exists $self->{data}->{ $key };
}
sub CLEAR {
my ($self) = @_;
$self->{keys} = [];
$self->{data} = {};
}
sub SCALAR {
my ($self) = @_;
return scalar %{ $self->{data} };
}
package YAML::PP::Preserve::Array;
# experimental
use Tie::Array;
use base qw/ Tie::StdArray /;
use Scalar::Util qw/ reftype blessed /;
sub TIEARRAY {
my ($class, @items) = @_;
my $self = bless {
data => [@items],
}, $class;
return $self;
}
sub FETCH {
my ($self, $i) = @_;
return $self->{data}->[ $i ];
}
sub FETCHSIZE {
my ($self) = @_;
return $#{ $self->{data} } + 1;
}
sub _preserve {
my ($val) = @_;
if (ref $val and not blessed($val)) {
if (reftype($val) eq 'HASH' and not tied %$val) {
tie %$val, 'YAML::PP::Preserve::Hash', %$val;
}
elsif (reftype($val) eq 'ARRAY' and not tied @$val) {
tie @$val, 'YAML::PP::Preserve::Array', @$val;
}
}
return $val;
}
sub STORE {
my ($self, $i, $val) = @_;
_preserve($val);
$self->{data}->[ $i ] = $val;
}
sub PUSH {
my ($self, @args) = @_;
push @{ $self->{data} }, map { _preserve $_ } @args;
}
sub STORESIZE {
my ($self, $i) = @_;
$#{ $self->{data} } = $i - 1;
}
sub DELETE {
my ($self, $i) = @_;
delete $self->{data}->[ $i ];
}
sub EXISTS {
my ($self, $i) = @_;
return exists $self->{data}->[ $i ];
}
sub CLEAR {
my ($self) = @_;
$self->{data} = [];
}
sub SHIFT {
my ($self) = @_;
shift @{ $self->{data} };
}
sub UNSHIFT {
my ($self, @args) = @_;
unshift @{ $self->{data} }, map { _preserve $_ } @args;
}
sub SPLICE {
my ($self, $offset, $length, @args) = @_;
splice @{ $self->{data} }, $offset, $length, map { _preserve $_ } @args;
}
sub EXTEND {}
package YAML::PP::Preserve::Scalar;
use overload
fallback => 1,
'+' => \&value,
'""' => \&value,
'bool' => \&value,
;
sub new {
my ($class, %args) = @_;
my $self = {
%args,
};
bless $self, $class;
}
sub value { $_[0]->{value} }
sub tag { $_[0]->{tag} }
sub style { $_[0]->{style} || 0 }
sub alias { $_[0]->{alias} }
1;
__END__
=pod
=encoding utf-8
=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);
# 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 and C. See L.
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
=head1 METHODS
=head2 new
my $ypp = YAML::PP->new;
# 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'] );
# Die when detecting cyclic references
my $ypp = YAML::PP->new( cyclic_refs => 'fatal' );
my $ypp = YAML::PP->new(
boolean => 'perl',
schema => ['Core'],
cyclic_refs => 'fatal',
indent => 4,
header => 1,
footer => 0,
version_directive => 0,
require_footer => 0,
max_depth => 512,
);
Options:
=over
=item boolean
Values: C (currently default), C, C, C
This option is for loading and dumping.
In case of perl 5.36 and later, builtin booleans should work out of the box
(since YAML::PP >= 0.38.0).
print YAML::PP->new->dump_string([ builtin::true, !1 ]);
# ---
# - true
# - false
For earlier perl versions, you can use "pseudo" booleans like documented
in the following examples.
# load/dump booleans via boolean.pm
my $ypp = YAML::PP->new( boolean => 'boolean' );
# load/dump booleans via JSON::PP::true/false
my $ypp = YAML::PP->new( boolean => 'JSON::PP' );
You can also specify more than one class, comma separated.
This is important for dumping.
boolean => 'JSON::PP,boolean'
Booleans will be loaded as JSON::PP::Booleans, but when dumping, also
'boolean' objects will be recognized
boolean => 'JSON::PP,*'
Booleans will be loaded as JSON::PP::Booleans, but when dumping, all
currently supported boolean classes will be recognized
boolean => '*'
Booleans will be loaded as perl booleans, but when dumping, all
currently supported boolean classes will be recognized
boolean => ''
Booleans will be loaded as perl booleans, but when dumping, nothing
will be recognized as booleans.
This option is for backwards compatibility for perl versions < 5.36,
if you rely on [!!1, !1] being dumped as [1, ''].
The option C was introduced when experimental boolean
support was added to perl 5.36. Since it will not be experimental anymore
in perl 5.40 \o/ the option is deprecated and the same as C.
=item schema
Default: C<['Core']>
This option is for loading and dumping.
Array reference. Here you can define what schema to use.
Supported standard Schemas are: C, C, C, C.
To get an overview how the different Schemas behave, see
L
Additionally you can add further schemas, for example C.
=item cyclic_refs
Default: C (since 0.037)
Before the default was C, but this can lead to memory leaks
when loading on untrusted data, so it was changed to C by default.
This option is for loading only.
Defines what to do when a cyclic reference is detected when loading.
# fatal - die
# warn - Just warn about them and replace with undef
# ignore - replace with undef
# allow - Default
=item duplicate_keys
Default: 0
Since version 0.027
This option is for loading.
The YAML Spec says duplicate mapping keys should be forbidden.
When set to true, duplicate keys in mappings are allowed (and will overwrite
the previous key).
When set to false, duplicate keys will result in an error when loading.
This is especially useful when you have a longer mapping and don't see
the duplicate key in your editor:
---
a: 1
b: 2
# .............
a: 23 # error
=item indent
Default: 2
This option is for dumping.
Use that many spaces for indenting
=item width
Since version 0.025
Default: 80
This option is for dumping.
Maximum columns when dumping.
This is only respected when dumping flow collections right now.
in the future it will be used also for wrapping long strings.
=item header
Default: 1
This option is for dumping.
Print document header C<--->
=item footer
Default: 0
Since version v0.39
This option is for dumping.
Print document footer C<...>
=item require_footer
Default: 0
Will require a C<...> at the end of each document.
This can be useful in a context where you want to make sure you received
the complete content, for example over network.
# Good
---
a: 1
...
---
a: 2
...
# Bad
---
a: 1
---
a: 2
=item max_depth
Since version v0.40
default: 512
Loading deeply nested, but still small YAML documents, like
[[[[[[[[[[...]]]]]]]]]]
can be significantly slower than a "normal" document with the same size.
By default the depth is limited to 512, which should be more than enough
for 99% of the use cases.
=item yaml_version
Since version 0.020
This option is for loading and dumping.
Default: C<1.2>
Note that in this case, a directive C<%YAML 1.1> will basically be ignored
and everything loaded with the C<1.2 Core> Schema.
If you want to support both YAML 1.1 and 1.2, you have to specify that, and the
schema (C or C) will be chosen automatically.
my $yp = YAML::PP->new(
yaml_version => ['1.2', '1.1'],
);
This is the same as
my $yp = YAML::PP->new(
schema => ['+'],
yaml_version => ['1.2', '1.1'],
);
because the C<+> stands for the default schema per version.
When loading, and there is no C<%YAML> directive, C<1.2> will be considered
as default, and the C schema will be used.
If there is a C<%YAML 1.1> directive, the C schema will be used.
Of course, you can also make C<1.1> the default:
my $yp = YAML::PP->new(
yaml_version => ['1.1', '1.2'],
);
You can also specify C<1.1> only:
my $yp = YAML::PP->new(
yaml_version => ['1.1'],
);
In this case also documents with C<%YAML 1.2> will be loaded with the C
schema.
=item version_directive
Since version 0.020
This option is for dumping.
Default: 0
Print Version Directive C<%YAML 1.2> (or C<%YAML 1.1>) on top of each YAML
document. It will use the first version specified in the C option.
=item preserve
Since version 0.021
Default: false
This option is for loading and dumping.
Preserving scalar styles is still experimental.
use YAML::PP::Common qw/ :PRESERVE /;
# Preserve the order of hash keys
my $yp = YAML::PP->new( preserve => PRESERVE_ORDER );
# Preserve the quoting style of scalars
my $yp = YAML::PP->new( preserve => PRESERVE_SCALAR_STYLE );
# Preserve block/flow style (since 0.024)
my $yp = YAML::PP->new( preserve => PRESERVE_FLOW_STYLE );
# Preserve alias names (since 0.027)
my $yp = YAML::PP->new( preserve => PRESERVE_ALIAS );
# Combine, e.g. preserve order and scalar style
my $yp = YAML::PP->new( preserve => PRESERVE_ORDER | PRESERVE_SCALAR_STYLE );
Do NOT rely on the internal implementation of it.
If you load the following input:
---
z: 1
a: 2
---
- plain
- 'single'
- "double"
- |
literal
- >
folded
---
block mapping: &alias
flow sequence: [a, b]
same mapping: *alias
flow mapping: {a: b}
with this code:
my $yp = YAML::PP->new(
preserve => PRESERVE_ORDER | PRESERVE_SCALAR_STYLE
| PRESERVE_FLOW_STYLE | PRESERVE_ALIAS
);
my ($hash, $styles, $flow) = $yp->load_file($file);
$yp->dump_file($hash, $styles, $flow);
Then dumping it will return the same output.
Note that YAML allows repeated definition of anchors. They cannot be preserved
with YAML::PP right now. Example:
---
- &seq [a]
- *seq
- &seq [b]
- *seq
Because the data could be shuffled before dumping again, the anchor definition
could be broken. In this case repeated anchor names will be discarded when
loading and dumped with numeric anchors like usual.
Implementation:
When loading, hashes will be tied to an internal class
(C) that keeps the key order.
Scalars will be returned as objects of an internal class
(C) with overloading. If you assign to such
a scalar, the object will be replaced by a simple scalar.
# assignment, style gets lost
$styles->[1] .= ' append';
You can also pass C<1> as a value. In this case all preserving options will be
enabled, also if there are new options added in the future.
There are also methods to create preserved nodes from scratch. See the
C L<"METHODS"> below.
=back
=head2 load_string
my $doc = $ypp->load_string("foo: bar");
my @docs = $ypp->load_string("foo: bar\n---\n- a");
Input should be Unicode characters.
So if you read from a file, you should decode it, for example with
C.
Note that in scalar context, C and C return the first
document (like L), while L and L return the
last.
=head2 load_file
my $doc = $ypp->load_file("file.yaml");
my @docs = $ypp->load_file("file.yaml");
Strings will be loaded as unicode characters.
=head2 dump_string
my $yaml = $ypp->dump_string($doc);
my $yaml = $ypp->dump_string($doc1, $doc2);
my $yaml = $ypp->dump_string(@docs);
Input strings should be Unicode characters.
Output will return Unicode characters.
So if you want to write that to a file (or pass to YAML::XS, for example),
you typically encode it via C.
=head2 dump_file
$ypp->dump_file("file.yaml", $doc);
$ypp->dump_file("file.yaml", $doc1, $doc2);
$ypp->dump_file("file.yaml", @docs);
Input data should be Unicode characters.
=head2 dump
This will dump to a predefined writer. By default it will just use the
L and output a string.
my $writer = MyWriter->new(\my $output);
my $yp = YAML::PP->new(
writer => $writer,
);
$yp->dump($data);
=head2 preserved_scalar
Since version 0.024
Experimental. Please report bugs or let me know this is useful and works.
You can define a certain scalar style when dumping data.
Figuring out the best style is a hard task and practically impossible to get
it right for all cases. It's also a matter of taste.
use YAML::PP::Common qw/ PRESERVE_SCALAR_STYLE YAML_LITERAL_SCALAR_STYLE /;
my $yp = YAML::PP->new(
preserve => PRESERVE_SCALAR_STYLE,
);
# a single linebreak would normally be dumped with double quotes: "\n"
my $scalar = $yp->preserved_scalar("\n", style => YAML_LITERAL_SCALAR_STYLE );
my $data = { literal => $scalar };
my $dump = $yp->dump_string($data);
# output
---
literal: |+
...
=head2 preserved_mapping, preserved_sequence
Since version 0.024
Experimental. Please report bugs or let me know this is useful and works.
With this you can define which nodes are dumped with the more compact flow
style instead of block style.
If you add C to the C option, it will also keep the
order of the keys in a hash.
use YAML::PP::Common qw/
PRESERVE_ORDER PRESERVE_FLOW_STYLE
YAML_FLOW_MAPPING_STYLE YAML_FLOW_SEQUENCE_STYLE
/;
my $yp = YAML::PP->new(
preserve => PRESERVE_FLOW_STYLE | PRESERVE_ORDER
);
my $hash = $yp->preserved_mapping({}, style => YAML_FLOW_MAPPING_STYLE);
# Add values after initialization to preserve order
%$hash = (z => 1, a => 2, y => 3, b => 4);
my $array = $yp->preserved_sequence([23, 24], style => YAML_FLOW_SEQUENCE_STYLE);
my $data = $yp->preserved_mapping({});
%$data = ( map => $hash, seq => $array );
my $dump = $yp->dump_string($data);
# output
---
map: {z: 1, a: 2, y: 3, b: 4}
seq: [23, 24]
=head2 loader
Returns or sets the loader object, by default L
=head2 dumper
Returns or sets the dumper object, by default L
=head2 schema
Returns or sets the schema object
=head2 default_schema
Creates and returns the default schema
=head1 FUNCTIONS
The functions C, C, C and C are provided
as a drop-in replacement for other existing YAML processors.
No function is exported by default.
Note that in scalar context, C and C return the first
document (like L), while L and L return the
last.
=over
=item Load
use YAML::PP qw/ Load /;
my $doc = Load($yaml);
my @docs = Load($yaml);
Works like C.
=item LoadFile
use YAML::PP qw/ LoadFile /;
my $doc = LoadFile($file);
my @docs = LoadFile($file);
my @docs = LoadFile($filehandle);
Works like C.
=item Dump
use YAML::PP qw/ Dump /;
my $yaml = Dump($doc);
my $yaml = Dump(@docs);
Works like C.
=item DumpFile
use YAML::PP qw/ DumpFile /;
DumpFile($file, $doc);
DumpFile($file, @docs);
DumpFile($filehandle, @docs);
Works like C.
=back
=head1 PLUGINS
You can alter the behaviour of YAML::PP by using the following schema
classes:
=over
=item L
One of the three YAML 1.2 official schemas
=item L
One of the three YAML 1.2 official schemas.
=item L
One of the three YAML 1.2 official schemas. Default
=item L
Schema implementing the most common YAML 1.1 types
=item L
Serializing Perl objects and types
=item L
Serializing binary data
=item L
YAML 1.1 merge keys for mappings
=item L
Experimental.
It was accidentally added in 0.38.1, and unknown tags forbidden.
This was reverted in 0.39.0
By default they will result in an error.
=item L
Include other YAML files via C tags
=item L
Deprecated. See option C
=back
To make the parsing process faster, you can plugin the libyaml parser
with L.
=head1 IMPLEMENTATION
The process of loading and dumping is split into the following steps:
Load:
YAML Stream Tokens Event List Data Structure
---------> ---------> --------->
lex parse construct
Dump:
Data Structure Event List YAML Stream
---------> --------->
represent emit
You can dump basic perl types like hashes, arrays, scalars (strings, numbers).
For dumping blessed objects and things like coderefs have a look at
L/L.
=over
=item L
The Lexer is reading the YAML stream into tokens. This makes it possible
to generate syntax highlighted YAML output.
Note that the API to retrieve the tokens will change.
=item L
The Parser retrieves the tokens from the Lexer. The main YAML content is then
parsed with the Grammar.
=item L
=item L
The Constructor creates a data structure from the Parser events.
=item L
The Loader combines the constructor and parser.
=item L
The Dumper will delegate to the Representer
=item L
The Representer will create Emitter events from the given data structure.
=item L
The Emitter creates a YAML stream.
=back
=head2 YAML::PP::Parser
Still TODO:
=over 4
=item Implicit collection keys
---
[ a, b, c ]: value
=item Implicit mapping in flow style sequences
This is supported since 0.029 (except some not relevant cases):
---
[ a, b, c: d ]
# equals
[ a, b, { c: d } ]
=item Plain mapping keys ending with colons
---
key ends with two colons::: value
This was implemented in 0.037.
=item Supported Characters
If you have valid YAML that's not parsed, or the other way round, please
create an issue.
=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.
Too see what strings are resolved as booleans, numbers, null etc. look at
L.
You can choose the Schema like this:
my $ypp = YAML::PP->new(schema => ['JSON']); # default is 'Core'
The Tags C and C are still ignored for now.
It supports:
=over 4
=item Handling of Anchors/Aliases
Like in modules like L, the Constructor will use references for mappings and
sequences, but obviously not for scalars.
L 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 or L, 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 instead of just returning something like
C.
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,
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 flag will be recognized as numbers and not
as strings:
my $int = 23;
say "int: $int"; # $int will now also have a PV flag
That means that if you accidentally use a string in numeric context, it will
also be recognized as a number:
my $string = "23";
my $something = $string + 0;
print $yp->dump_string($string);
# will be emitted as an integer without quotes!
The layout is like libyaml output:
key:
- a
- b
- c
---
- key1: 1
key2: 2
key3: 3
---
- - a1
- a2
- - b1
- b2
=head1 FAQ - Frequently Asked Questions
=over
=item Are C<<<> merge keys supported?
Yes, this can be enabled optionally, see L
=item Is there a linter / formatter for YAML
There is the widely used L<"yamllint"|https://yamllint.readthedocs.io/>, based on
python's PyYAML. It is very configurable and will report errors or warnings.
It cannot format.
Now there is also L, which will format the given file according
to your configuration. So far only a few configuration options exist, but
they can already be quite helpful.
=back
=head1 Which YAML module should I use?
There are many YAML modules on CPAN. For historical reasons some of them
aren't handling YAML correctly.
Most of them are not compatible with the YAML spec and with each other, meaning
they can interpret the same YAML differently.
The behaviours we are discussing here can be divided into parsing issues
(syntax) and loading/constructing issues (for example type resolving which
decides what is a number, boolean or null).
See also L (parsing) and
L (loading).
=over
=item L<"YAML.pm"|YAML>
It was written even before the YAML 1.0 spec was finished and by that enabled
perl users to process YAML very early. It might work for you if you have simple
data, but it's missing quite some features and can also produce YAML that
doesn't roundtrip. Nowadays it might be a good idea to switch.
=item L
A libyaml binding that is robust and widely used. However, there are two
things to consider.
1. (syntax) libyaml diverged from the spec in several aspects. They are rare though.
2. The type resolving does not adhere to YAML 1.1 or YAML 1.2, meaning it is
incompatible with other YAML libraries in perl or other languages.
=item L
It implements both a tiny subset of YAML, but also a superset. Meaning
it will happily accept some YAML documents that are not officially valid.
Type resolving is also not implemented according to the spec.
=item L