File Coverage

blib/lib/YAML/PP/Schema/Core.pm
Criterion Covered Total %
statement 43 43 100.0
branch 2 2 100.0
condition n/a
subroutine 9 9 100.0
pod 1 1 100.0
total 55 55 100.0


line stmt bran cond sub pod time code
1 25     25   14274 use strict;
  25         57  
  25         782  
2 25     25   126 use warnings;
  25         49  
  25         1535  
3             package YAML::PP::Schema::Core;
4              
5             our $VERSION = '0.036_001'; # TRIAL VERSION
6              
7 25         1895 use YAML::PP::Schema::JSON qw/
8             represent_int represent_float represent_literal represent_bool
9             represent_undef
10 25     25   163 /;
  25         80  
11              
12 25     25   155 use B;
  25         68  
  25         1180  
13              
14 25     25   163 use YAML::PP::Common qw/ YAML_PLAIN_SCALAR_STYLE /;
  25         47  
  25         17522  
15              
16             my $RE_INT_CORE = qr{^([+-]?(?:[0-9]+))$};
17             my $RE_FLOAT_CORE = qr{^([+-]?(?:\.[0-9]+|[0-9]+(?:\.[0-9]*)?)(?:[eE][+-]?[0-9]+)?)$};
18             my $RE_INT_OCTAL = qr{^0o([0-7]+)$};
19             my $RE_INT_HEX = qr{^0x([0-9a-fA-F]+)$};
20              
21 6     6   32 sub _from_oct { oct $_[2]->[0] }
22 10     10   72 sub _from_hex { hex $_[2]->[0] }
23              
24             sub register {
25 721     721 1 2662 my ($self, %args) = @_;
26 721         1426 my $schema = $args{schema};
27              
28             $schema->add_resolver(
29             tag => 'tag:yaml.org,2002:null',
30             match => [ equals => $_ => undef ],
31 721         3191 ) for (qw/ null NULL Null ~ /, '');
32             $schema->add_resolver(
33             tag => 'tag:yaml.org,2002:bool',
34             match => [ equals => $_ => $schema->true ],
35 721         2282 ) for (qw/ true TRUE True /);
36             $schema->add_resolver(
37             tag => 'tag:yaml.org,2002:bool',
38             match => [ equals => $_ => $schema->false ],
39 721         2233 ) for (qw/ false FALSE False /);
40 721         2986 $schema->add_resolver(
41             tag => 'tag:yaml.org,2002:int',
42             match => [ regex => $RE_INT_CORE => \&YAML::PP::Schema::JSON::_to_int ],
43             );
44 721         2998 $schema->add_resolver(
45             tag => 'tag:yaml.org,2002:int',
46             match => [ regex => $RE_INT_OCTAL => \&_from_oct ],
47             );
48 721         2781 $schema->add_resolver(
49             tag => 'tag:yaml.org,2002:int',
50             match => [ regex => $RE_INT_HEX => \&_from_hex ],
51             );
52 721         2650 $schema->add_resolver(
53             tag => 'tag:yaml.org,2002:float',
54             match => [ regex => $RE_FLOAT_CORE => \&YAML::PP::Schema::JSON::_to_float ],
55             );
56             $schema->add_resolver(
57             tag => 'tag:yaml.org,2002:float',
58             match => [ equals => $_ => 0 + "inf" ],
59 721         2859 ) for (qw/ .inf .Inf .INF +.inf +.Inf +.INF /);
60             $schema->add_resolver(
61             tag => 'tag:yaml.org,2002:float',
62             match => [ equals => $_ => 0 - "inf" ],
63 721         2773 ) for (qw/ -.inf -.Inf -.INF /);
64             $schema->add_resolver(
65             tag => 'tag:yaml.org,2002:float',
66             match => [ equals => $_ => 0 + "nan" ],
67 721         2698 ) for (qw/ .nan .NaN .NAN /);
68             $schema->add_resolver(
69             tag => 'tag:yaml.org,2002:str',
70 721     3319   4060 match => [ all => sub { $_[1]->{value} } ],
  3319         11002  
71             );
72              
73 721         1400 my $int_flags = B::SVp_IOK;
74 721         1108 my $float_flags = B::SVp_NOK;
75 721         2617 $schema->add_representer(
76             flags => $int_flags,
77             code => \&represent_int,
78             );
79 721         2086 $schema->add_representer(
80             flags => $float_flags,
81             code => \&represent_float,
82             );
83 721         2199 $schema->add_representer(
84             undefined => \&represent_undef,
85             );
86             $schema->add_representer(
87             equals => $_,
88             code => \&represent_literal,
89 721         2826 ) for ("", qw/
90             true TRUE True false FALSE False null NULL Null ~
91             .inf .Inf .INF +.inf +.Inf +.INF -.inf -.Inf -.INF .nan .NaN .NAN
92             /);
93 721         8303 $schema->add_representer(
94             regex => qr{$RE_INT_CORE|$RE_FLOAT_CORE|$RE_INT_OCTAL|$RE_INT_HEX},
95             code => \&represent_literal,
96             );
97              
98 721 100       1803 if ($schema->bool_class) {
99 588         936 for my $class (@{ $schema->bool_class }) {
  588         1190  
100 588         1512 $schema->add_representer(
101             class_equals => $class,
102             code => \&represent_bool,
103             );
104             }
105             }
106              
107 721         4058 return;
108             }
109              
110             1;
111              
112             __END__