App-Dex
view release on metacpan or search on metacpan
scripts/dex view on Meta::CPAN
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) {
$schema->add_representer(
class_equals => $schema->bool_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<TRUE> and C<True> additional to C<true>.
Official Schema:
L<https://yaml.org/spec/1.2/spec.html#id2804923>
Here you can see all Schemas and examples implemented by YAML::PP:
L<https://perlpunk.github.io/YAML-PP-p5/schemas.html>
=head1 METHODS
=over
=item register
Called by YAML::PP::Schema
=back
=cut
YAML_PP_SCHEMA_CORE
$fatpacked{"YAML/PP/Schema/Failsafe.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_FAILSAFE';
use strict;
use warnings;
scripts/dex view on Meta::CPAN
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_SCHEMA_TIE_IXHASH
$fatpacked{"YAML/PP/Schema/YAML1_1.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_PP_SCHEMA_YAML1_1';
use strict;
use warnings;
package YAML::PP::Schema::YAML1_1;
our $VERSION = '0.027'; # 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;
}
scripts/dex view on Meta::CPAN
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) {
$schema->add_representer(
class_equals => $schema->bool_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<https://yaml.org/type/null.html>
scripts/dex view on Meta::CPAN
I<Since version 1.45.>
Filters a list of values to remove subsequent duplicates, as judged by a
DWIM-ish string equality or C<undef> test. Preserves the order of unique
elements, and retains the first value of any duplicate set.
my $count = uniq @values
In scalar context, returns the number of elements that would have been
returned as a list.
The C<undef> value is treated by this function as distinct from the empty
string, and no warning will be produced. It is left as-is in the returned
list. Subsequent C<undef> values are still considered identical to the first,
and will be removed.
=head2 uniqint
my @subset = uniqint @values
I<Since version 1.55.>
Filters a list of values to remove subsequent duplicates, as judged by an
integer numerical equality test. Preserves the order of unique elements, and
retains the first value of any duplicate set. Values in the returned list will
be coerced into integers.
my $count = uniqint @values
In scalar context, returns the number of elements that would have been
returned as a list.
Note that C<undef> is treated much as other numerical operations treat it; it
compares equal to zero but additionally produces a warning if such warnings
are enabled (C<use warnings 'uninitialized';>). In addition, an C<undef> in
the returned list is coerced into a numerical zero, so that the entire list of
values returned by C<uniqint> are well-behaved as integers.
=head2 uniqnum
my @subset = uniqnum @values
I<Since version 1.44.>
Filters a list of values to remove subsequent duplicates, as judged by a
numerical equality test. Preserves the order of unique elements, and retains
the first value of any duplicate set.
my $count = uniqnum @values
In scalar context, returns the number of elements that would have been
returned as a list.
Note that C<undef> is treated much as other numerical operations treat it; it
compares equal to zero but additionally produces a warning if such warnings
are enabled (C<use warnings 'uninitialized';>). In addition, an C<undef> in
the returned list is coerced into a numerical zero, so that the entire list of
values returned by C<uniqnum> are well-behaved as numbers.
Note also that multiple IEEE C<NaN> values are treated as duplicates of
each other, regardless of any differences in their payloads, and despite
the fact that C<< 0+'NaN' == 0+'NaN' >> yields false.
=head2 uniqstr
my @subset = uniqstr @values
I<Since version 1.45.>
Filters a list of values to remove subsequent duplicates, as judged by a
string equality test. Preserves the order of unique elements, and retains the
first value of any duplicate set.
my $count = uniqstr @values
In scalar context, returns the number of elements that would have been
returned as a list.
Note that C<undef> is treated much as other string operations treat it; it
compares equal to the empty string but additionally produces a warning if such
warnings are enabled (C<use warnings 'uninitialized';>). In addition, an
C<undef> in the returned list is coerced into an empty string, so that the
entire list of values returned by C<uniqstr> are well-behaved as strings.
=cut
=head2 head
my @values = head $size, @list;
I<Since version 1.50.>
Returns the first C<$size> elements from C<@list>. If C<$size> is negative, returns
all but the last C<$size> elements from C<@list>.
@result = head 2, qw( foo bar baz );
# foo, bar
@result = head -2, qw( foo bar baz );
# foo
=head2 tail
my @values = tail $size, @list;
I<Since version 1.50.>
Returns the last C<$size> elements from C<@list>. If C<$size> is negative, returns
all but the first C<$size> elements from C<@list>.
@result = tail 2, qw( foo bar baz );
# bar, baz
@result = tail -2, qw( foo bar baz );
# baz
=head2 zip
my @result = zip [1..3], ['a'..'c'];
# [1, 'a'], [2, 'b'], [3, 'c']
I<Since version 1.56.>
( run in 2.029 seconds using v1.01-cache-2.11-cpan-2398b32b56e )