\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.43.0/etc/PaxHeaders/generate-examples.pl 0000644 0000000 0000000 00000000132 15263373362 016651 x ustar 00 30 mtime=1791882994.992710984
30 atime=1791882994.992616069
30 ctime=1791882994.992710984
YAML-PP-v0.43.0/etc/generate-examples.pl 0000644 0001750 0001750 00000002627 15263373362 016312 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.43.0/etc/PaxHeaders/generate-grammar.pl 0000644 0000000 0000000 00000000132 15263373362 016461 x ustar 00 30 mtime=1791882994.992339356
30 atime=1791882994.992237667
30 ctime=1791882994.992339356
YAML-PP-v0.43.0/etc/generate-grammar.pl 0000755 0001750 0001750 00000003122 15263373362 016114 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.43.0/etc/PaxHeaders/test-suite-html.pl 0000644 0000000 0000000 00000000132 15263373362 016313 x ustar 00 30 mtime=1791882994.990452304
30 atime=1791882994.990343281
30 ctime=1791882994.990452304
YAML-PP-v0.43.0/etc/test-suite-html.pl 0000755 0001750 0001750 00000023333 15263373362 015754 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.43.0/etc/PaxHeaders/json-numbers.pl 0000644 0000000 0000000 00000000132 15263373362 015665 x ustar 00 30 mtime=1791882994.983322657
30 atime=1791882994.983229209
30 ctime=1791882994.983322657
YAML-PP-v0.43.0/etc/json-numbers.pl 0000644 0001750 0001750 00000002226 15263373362 015321 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.43.0/etc/PaxHeaders/yaml-numbers.pl 0000644 0000000 0000000 00000000132 15263373362 015656 x ustar 00 30 mtime=1791882994.983229209
30 atime=1791882994.983124376
30 ctime=1791882994.983229209
YAML-PP-v0.43.0/etc/yaml-numbers.pl 0000644 0001750 0001750 00000002167 15263373362 015316 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.43.0/etc/PaxHeaders/grammar.yaml 0000644 0000000 0000000 00000000131 15263373362 015217 x ustar 00 30 mtime=1791882994.980404811
29 atime=1791882994.98030815
30 ctime=1791882994.980404811
YAML-PP-v0.43.0/etc/grammar.yaml 0000644 0001750 0001750 00000040501 15263373362 014652 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.43.0/etc/PaxHeaders/get-tags.pl 0000644 0000000 0000000 00000000132 15263373362 014756 x ustar 00 30 mtime=1791882994.976919921
30 atime=1791882994.976777933
30 ctime=1791882994.976919921
YAML-PP-v0.43.0/etc/get-tags.pl 0000644 0001750 0001750 00000001174 15263373362 014413 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.43.0/PaxHeaders/bin 0000644 0000000 0000000 00000000132 15263373362 012626 x ustar 00 30 mtime=1791882994.988205428
30 atime=1791882994.976634618
30 ctime=1791882994.988205428
YAML-PP-v0.43.0/bin/ 0000755 0001750 0001750 00000000000 15263373362 012335 5 ustar 00tina tina YAML-PP-v0.43.0/bin/PaxHeaders/yamlpp-parse-emit 0000644 0000000 0000000 00000000130 15263373362 016172 x ustar 00 29 mtime=1791882994.98831033
30 atime=1791882994.988205428
29 ctime=1791882994.98831033
YAML-PP-v0.43.0/bin/yamlpp-parse-emit 0000755 0001750 0001750 00000006262 15263373362 015637 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.43.0/bin/PaxHeaders/yamlpp-load-dump 0000644 0000000 0000000 00000000131 15263373362 016007 x ustar 00 30 mtime=1791882994.986154527
29 atime=1791882994.98605193
30 ctime=1791882994.986154527
YAML-PP-v0.43.0/bin/yamlpp-load-dump 0000755 0001750 0001750 00000021273 15263373362 015452 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.43.0/bin/PaxHeaders/yamlpp-highlight 0000644 0000000 0000000 00000000130 15263373362 016073 x ustar 00 29 mtime=1791882994.98605193
30 atime=1791882994.985958481
29 ctime=1791882994.98605193
YAML-PP-v0.43.0/bin/yamlpp-highlight 0000755 0001750 0001750 00000001757 15263373362 015544 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.43.0/bin/PaxHeaders/yamlpp-events 0000644 0000000 0000000 00000000132 15263373362 015432 x ustar 00 30 mtime=1791882994.980838249
30 atime=1791882994.980743823
30 ctime=1791882994.980838249
YAML-PP-v0.43.0/bin/yamlpp-events 0000755 0001750 0001750 00000002374 15263373362 015075 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.43.0/bin/PaxHeaders/yamlpp-load 0000644 0000000 0000000 00000000132 15263373362 015045 x ustar 00 30 mtime=1791882994.976777933
30 atime=1791882994.976634618
30 ctime=1791882994.976777933
YAML-PP-v0.43.0/bin/yamlpp-load 0000755 0001750 0001750 00000007314 15263373362 014507 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.43.0/PaxHeaders/CONTRIBUTING.md 0000644 0000000 0000000 00000000132 15263373362 014364 x ustar 00 30 mtime=1791882994.976449608
30 atime=1791882994.976341702
30 ctime=1791882994.976449608
YAML-PP-v0.43.0/CONTRIBUTING.md 0000644 0001750 0001750 00000002636 15263373362 014025 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.43.0/PaxHeaders/lib 0000644 0000000 0000000 00000000132 15263373362 012624 x ustar 00 30 mtime=1791882994.976281149
30 atime=1791882994.976089294
30 ctime=1791882994.976281149
YAML-PP-v0.43.0/lib/ 0000755 0001750 0001750 00000000000 15263373362 012333 5 ustar 00tina tina YAML-PP-v0.43.0/lib/PaxHeaders/YAML 0000644 0000000 0000000 00000000132 15263373362 013366 x ustar 00 30 mtime=1791882994.982976382
30 atime=1791882994.976089294
30 ctime=1791882994.982976382
YAML-PP-v0.43.0/lib/YAML/ 0000755 0001750 0001750 00000000000 15263373362 013075 5 ustar 00tina tina YAML-PP-v0.43.0/lib/YAML/PaxHeaders/PP 0000644 0000000 0000000 00000000132 15263373362 013705 x ustar 00 30 mtime=1791882994.994905828
30 atime=1791882994.982976382
30 ctime=1791882994.994905828
YAML-PP-v0.43.0/lib/YAML/PP/ 0000755 0001750 0001750 00000000000 15263373362 013414 5 ustar 00tina tina YAML-PP-v0.43.0/lib/YAML/PP/PaxHeaders/Type 0000644 0000000 0000000 00000000132 15263373362 014626 x ustar 00 30 mtime=1791882994.994905828
30 atime=1791882994.994905828
30 ctime=1791882994.994905828
YAML-PP-v0.43.0/lib/YAML/PP/Type/ 0000755 0001750 0001750 00000000000 15263373362 014335 5 ustar 00tina tina YAML-PP-v0.43.0/lib/YAML/PP/Type/PaxHeaders/MergeKey.pm 0000644 0000000 0000000 00000000130 15263373362 016747 x ustar 00 29 mtime=1791882994.99507268
30 atime=1791882994.994905828
29 ctime=1791882994.99507268
YAML-PP-v0.43.0/lib/YAML/PP/Type/MergeKey.pm 0000644 0001750 0001750 00000000603 15263373362 016402 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Type::MergeKey;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/PaxHeaders/Schema 0000644 0000000 0000000 00000000132 15263373362 015105 x ustar 00 30 mtime=1791882994.996148242
30 atime=1791882994.993917918
30 ctime=1791882994.996148242
YAML-PP-v0.43.0/lib/YAML/PP/Schema/ 0000755 0001750 0001750 00000000000 15263373362 014614 5 ustar 00tina tina YAML-PP-v0.43.0/lib/YAML/PP/Schema/PaxHeaders/Tie 0000644 0000000 0000000 00000000132 15263373362 015626 x ustar 00 30 mtime=1791882994.996148242
30 atime=1791882994.996148242
30 ctime=1791882994.996148242
YAML-PP-v0.43.0/lib/YAML/PP/Schema/Tie/ 0000755 0001750 0001750 00000000000 15263373362 015335 5 ustar 00tina tina YAML-PP-v0.43.0/lib/YAML/PP/Schema/Tie/PaxHeaders/IxHash.pm 0000644 0000000 0000000 00000000132 15263373362 017425 x ustar 00 30 mtime=1791882994.996296376
30 atime=1791882994.996148242
30 ctime=1791882994.996296376
YAML-PP-v0.43.0/lib/YAML/PP/Schema/Tie/IxHash.pm 0000644 0001750 0001750 00000004632 15263373362 017064 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::Tie::IxHash;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/Schema/PaxHeaders/Catchall.pm 0000644 0000000 0000000 00000000132 15263373362 017233 x ustar 00 30 mtime=1791882994.996044806
30 atime=1791882994.995952755
30 ctime=1791882994.996044806
YAML-PP-v0.43.0/lib/YAML/PP/Schema/Catchall.pm 0000644 0001750 0001750 00000003155 15263373362 016671 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::Catchall;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/Schema/PaxHeaders/Failsafe.pm 0000644 0000000 0000000 00000000132 15263373362 017232 x ustar 00 30 mtime=1791882994.995952755
30 atime=1791882994.995858469
30 ctime=1791882994.995952755
YAML-PP-v0.43.0/lib/YAML/PP/Schema/Failsafe.pm 0000644 0001750 0001750 00000002566 15263373362 016675 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::Failsafe;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/Schema/PaxHeaders/Include.pm 0000644 0000000 0000000 00000000132 15263373362 017103 x ustar 00 30 mtime=1791882994.995763554
30 atime=1791882994.995666055
30 ctime=1791882994.995763554
YAML-PP-v0.43.0/lib/YAML/PP/Schema/Include.pm 0000644 0001750 0001750 00000014556 15263373362 016550 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::Include;
our $VERSION = 'v0.43.0'; # VERSION
use Carp qw/ croak /;
use Scalar::Util qw/ weaken /;
use File::Basename qw/ dirname /;
use File::Spec;
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.43.0/lib/YAML/PP/Schema/PaxHeaders/YAML1_1.pm 0000644 0000000 0000000 00000000132 15263373362 016563 x ustar 00 30 mtime=1791882994.995666055
30 atime=1791882994.995570302
30 ctime=1791882994.995666055
YAML-PP-v0.43.0/lib/YAML/PP/Schema/YAML1_1.pm 0000644 0001750 0001750 00000015225 15263373362 016222 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::YAML1_1;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/Schema/PaxHeaders/Binary.pm 0000644 0000000 0000000 00000000131 15263373362 016743 x ustar 00 30 mtime=1791882994.995180027
29 atime=1791882994.99507268
30 ctime=1791882994.995180027
YAML-PP-v0.43.0/lib/YAML/PP/Schema/Binary.pm 0000644 0001750 0001750 00000005036 15263373362 016402 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::Binary;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/Schema/PaxHeaders/Merge.pm 0000644 0000000 0000000 00000000132 15263373362 016557 x ustar 00 30 mtime=1791882994.994531966
30 atime=1791882994.994435305
30 ctime=1791882994.994531966
YAML-PP-v0.43.0/lib/YAML/PP/Schema/Merge.pm 0000644 0001750 0001750 00000004674 15263373362 016224 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::Merge;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/Schema/PaxHeaders/Core.pm 0000644 0000000 0000000 00000000132 15263373362 016410 x ustar 00 30 mtime=1791882994.994286682
30 atime=1791882994.994182478
30 ctime=1791882994.994286682
YAML-PP-v0.43.0/lib/YAML/PP/Schema/Core.pm 0000644 0001750 0001750 00000010027 15263373362 016042 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::Core;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/Schema/PaxHeaders/Perl.pm 0000644 0000000 0000000 00000000132 15263373362 016422 x ustar 00 30 mtime=1791882994.994182478
30 atime=1791882994.994068636
30 ctime=1791882994.994182478
YAML-PP-v0.43.0/lib/YAML/PP/Schema/Perl.pm 0000644 0001750 0001750 00000060042 15263373362 016056 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::Perl;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/Schema/PaxHeaders/JSON.pm 0000644 0000000 0000000 00000000132 15263373362 016271 x ustar 00 30 mtime=1791882994.994068636
30 atime=1791882994.993917918
30 ctime=1791882994.994068636
YAML-PP-v0.43.0/lib/YAML/PP/Schema/JSON.pm 0000644 0001750 0001750 00000014232 15263373362 015725 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema::JSON;
our $VERSION = 'v0.43.0'; # VERSION
use Exporter 'import';
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.43.0/lib/YAML/PP/PaxHeaders/Writer 0000644 0000000 0000000 00000000132 15263373362 015161 x ustar 00 30 mtime=1791882994.993762171
30 atime=1791882994.993762171
30 ctime=1791882994.993762171
YAML-PP-v0.43.0/lib/YAML/PP/Writer/ 0000755 0001750 0001750 00000000000 15263373362 014670 5 ustar 00tina tina YAML-PP-v0.43.0/lib/YAML/PP/Writer/PaxHeaders/File.pm 0000644 0000000 0000000 00000000132 15263373362 016453 x ustar 00 30 mtime=1791882994.993917918
30 atime=1791882994.993762171
30 ctime=1791882994.993917918
YAML-PP-v0.43.0/lib/YAML/PP/Writer/File.pm 0000644 0001750 0001750 00000003511 15263373362 016105 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Writer::File;
our $VERSION = 'v0.43.0'; # VERSION
use Scalar::Util qw/ openhandle /;
use YAML::PP::Writer;
our @ISA = 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.43.0/lib/YAML/PP/PaxHeaders/Constructor.pm 0000644 0000000 0000000 00000000132 15263373362 016645 x ustar 00 30 mtime=1791882994.993762171
30 atime=1791882994.993662926
30 ctime=1791882994.993762171
YAML-PP-v0.43.0/lib/YAML/PP/Constructor.pm 0000644 0001750 0001750 00000032577 15263373362 016315 0 ustar 00tina tina # ABSTRACT: Construct data structure from Parser Events
use strict;
use warnings;
package YAML::PP::Constructor;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/PaxHeaders/Representer.pm 0000644 0000000 0000000 00000000132 15263373362 016616 x ustar 00 30 mtime=1791882994.993662926
30 atime=1791882994.993567452
30 ctime=1791882994.993662926
YAML-PP-v0.43.0/lib/YAML/PP/Representer.pm 0000644 0001750 0001750 00000015734 15263373362 016262 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Representer;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/PaxHeaders/Highlight.pm 0000644 0000000 0000000 00000000131 15263373362 016226 x ustar 00 30 mtime=1791882994.992616069
29 atime=1791882994.99252297
30 ctime=1791882994.992616069
YAML-PP-v0.43.0/lib/YAML/PP/Highlight.pm 0000644 0001750 0001750 00000014247 15263373362 015671 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Highlight;
our $VERSION = 'v0.43.0'; # VERSION
our @EXPORT_OK = qw/ Dump /;
use Exporter 'import';
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.43.0/lib/YAML/PP/PaxHeaders/Exception.pm 0000644 0000000 0000000 00000000130 15263373362 016254 x ustar 00 29 mtime=1791882994.99252297
30 atime=1791882994.992431338
29 ctime=1791882994.99252297
YAML-PP-v0.43.0/lib/YAML/PP/Exception.pm 0000644 0001750 0001750 00000003605 15263373362 015714 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Exception;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/PaxHeaders/Grammar.pm 0000644 0000000 0000000 00000000132 15263373362 015706 x ustar 00 30 mtime=1791882994.990343281
30 atime=1791882994.990235865
30 ctime=1791882994.990343281
YAML-PP-v0.43.0/lib/YAML/PP/Grammar.pm 0000644 0001750 0001750 00000136107 15263373362 015350 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Grammar;
our $VERSION = 'v0.43.0'; # VERSION
use Exporter 'import';
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.43.0/lib/YAML/PP/PaxHeaders/Emitter.pm 0000644 0000000 0000000 00000000132 15263373362 015731 x ustar 00 30 mtime=1791882994.990235865
30 atime=1791882994.990115178
30 ctime=1791882994.990235865
YAML-PP-v0.43.0/lib/YAML/PP/Emitter.pm 0000644 0001750 0001750 00000075147 15263373362 015401 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Emitter;
our $VERSION = 'v0.43.0'; # VERSION
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;
if (DEBUG) { require Data::Dumper }
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.43.0/lib/YAML/PP/PaxHeaders/Common.pm 0000644 0000000 0000000 00000000132 15263373362 015550 x ustar 00 30 mtime=1791882994.989172246
30 atime=1791882994.989052887
30 ctime=1791882994.989172246
YAML-PP-v0.43.0/lib/YAML/PP/Common.pm 0000644 0001750 0001750 00000015733 15263373362 015213 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Common;
our $VERSION = 'v0.43.0'; # VERSION
use Exporter 'import';
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.43.0/lib/YAML/PP/PaxHeaders/Parser.pm 0000644 0000000 0000000 00000000132 15263373362 015554 x ustar 00 30 mtime=1791882994.989052887
30 atime=1791882994.988960416
30 ctime=1791882994.989052887
YAML-PP-v0.43.0/lib/YAML/PP/Parser.pm 0000644 0001750 0001750 00000121264 15263373362 015214 0 ustar 00tina tina # ABSTRACT: YAML Parser
use strict;
use warnings;
package YAML::PP::Parser;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/PaxHeaders/Dumper.pm 0000644 0000000 0000000 00000000132 15263373362 015554 x ustar 00 30 mtime=1791882994.988960416
30 atime=1791882994.988866898
30 ctime=1791882994.988960416
YAML-PP-v0.43.0/lib/YAML/PP/Dumper.pm 0000644 0001750 0001750 00000020323 15263373362 015206 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Dumper;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/PaxHeaders/Loader.pm 0000644 0000000 0000000 00000000132 15263373362 015526 x ustar 00 30 mtime=1791882994.988866898
30 atime=1791882994.988775336
30 ctime=1791882994.988866898
YAML-PP-v0.43.0/lib/YAML/PP/Loader.pm 0000644 0001750 0001750 00000005154 15263373362 015165 0 ustar 00tina tina # ABSTRACT: Load YAML into data with Parser and Constructor
use strict;
use warnings;
package YAML::PP::Loader;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/PaxHeaders/Render.pm 0000644 0000000 0000000 00000000132 15263373362 015537 x ustar 00 30 mtime=1791882994.988775336
30 atime=1791882994.988683773
30 ctime=1791882994.988775336
YAML-PP-v0.43.0/lib/YAML/PP/Render.pm 0000644 0001750 0001750 00000007061 15263373362 015175 0 ustar 00tina tina # ABSTRACT: YAML::PP Rendering functions
use strict;
use warnings;
package YAML::PP::Render;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/PaxHeaders/Reader.pm 0000644 0000000 0000000 00000000132 15263373362 015522 x ustar 00 30 mtime=1791882994.988683773
30 atime=1791882994.988589417
30 ctime=1791882994.988683773
YAML-PP-v0.43.0/lib/YAML/PP/Reader.pm 0000644 0001750 0001750 00000003012 15263373362 015150 0 ustar 00tina tina # ABSTRACT: Reader class for YAML::PP representing input data
use strict;
use warnings;
package YAML::PP::Reader;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/PaxHeaders/Schema.pm 0000644 0000000 0000000 00000000131 15263373362 015517 x ustar 00 30 mtime=1791882994.988589417
29 atime=1791882994.98849548
30 ctime=1791882994.988589417
YAML-PP-v0.43.0/lib/YAML/PP/Schema.pm 0000644 0001750 0001750 00000031120 15263373362 015147 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Schema;
our $VERSION = 'v0.43.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' => sub { require YAML::PP::Schema::Core; return 'YAML::PP::Schema::Core' },
'1.1' => sub { require YAML::PP::Schema::YAML1_1; return 'YAML::PP::Schema::YAML1_1' },
);
my %AVAILABLE_SCHEMAS = (
'Core' => sub { require YAML::PP::Schema::Core; return 'YAML::PP::Schema::Core' },
'JSON' => sub { require YAML::PP::Schema::JSON; return 'YAML::PP::Schema::JSON' },
'Failsafe' => sub { require YAML::PP::Schema::Failsafe; return 'YAML::PP::Schema::Failsafe' },
'Merge' => sub { require YAML::PP::Schema::Merge; return 'YAML::PP::Schema::Merge' },
'Perl' => sub { require YAML::PP::Schema::Perl; return 'YAML::PP::Schema::Perl' },
);
sub load_subschemas {
my ($self, @schemas) = @_;
my $yaml_version = $self->yaml_version;
my $i = 0;
while ($i < @schemas) {
my $item = $schemas[ $i ];
$i++;
my $class;
if ($item eq '+') {
my $code = $DEFAULT_SCHEMA{ $yaml_version };
$class = $code->();
}
elsif ($AVAILABLE_SCHEMAS{ $item }) {
my $code = $AVAILABLE_SCHEMAS{ $item };
$class = $code->();
}
elsif (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++;
}
unless ($class) {
require Module::Load;
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.43.0/lib/YAML/PP/PaxHeaders/Writer.pm 0000644 0000000 0000000 00000000130 15263373362 015572 x ustar 00 29 mtime=1791882994.98849548
30 atime=1791882994.988402521
29 ctime=1791882994.98849548
YAML-PP-v0.43.0/lib/YAML/PP/Writer.pm 0000644 0001750 0001750 00000002352 15263373362 015230 0 ustar 00tina tina # ABSTRACT: Writer class for YAML::PP representing output data
use strict;
use warnings;
package YAML::PP::Writer;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/PaxHeaders/Lexer.pm 0000644 0000000 0000000 00000000132 15263373362 015377 x ustar 00 30 mtime=1791882994.986411195
30 atime=1791882994.986311042
30 ctime=1791882994.986411195
YAML-PP-v0.43.0/lib/YAML/PP/Lexer.pm 0000644 0001750 0001750 00000073474 15263373362 015050 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Lexer;
our $VERSION = 'v0.43.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.43.0/lib/YAML/PP/PaxHeaders/Perl.pm 0000644 0000000 0000000 00000000132 15263373362 015222 x ustar 00 30 mtime=1791882994.983124376
30 atime=1791882994.982976382
30 ctime=1791882994.983124376
YAML-PP-v0.43.0/lib/YAML/PP/Perl.pm 0000644 0001750 0001750 00000002771 15263373362 014663 0 ustar 00tina tina use strict;
use warnings;
package YAML::PP::Perl;
our $VERSION = 'v0.43.0'; # VERSION
use Exporter 'import';
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.43.0/lib/YAML/PaxHeaders/PP.pm 0000644 0000000 0000000 00000000132 15263373362 014320 x ustar 00 30 mtime=1791882994.976341702
30 atime=1791882994.976281149
30 ctime=1791882994.976341702
YAML-PP-v0.43.0/lib/YAML/PP.pm 0000644 0001750 0001750 00000113246 15263373362 013761 0 ustar 00tina tina # ABSTRACT: YAML 1.2 Processor
use strict;
use warnings;
package YAML::PP;
our $VERSION = 'v0.43.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 Exporter 'import';
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; # provides Tie::StdHash, our parent below
our @ISA = 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; # provides Tie::StdArray, our parent below
our @ISA = 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