File Coverage

blib/lib/YAML/PP/Schema/Catchall.pm
Criterion Covered Total %
statement 29 32 90.6
branch 0 4 0.0
condition n/a
subroutine 8 8 100.0
pod 0 1 0.0
total 37 45 82.2


line stmt bran cond sub pod time code
1 5     5   148898 use strict;
  5         9  
  5         165  
2 5     5   22 use warnings;
  5         5  
  5         426  
3             package YAML::PP::Schema::Catchall;
4              
5             our $VERSION = 'v0.40.0'; # VERSION
6              
7 5     5   27 use Carp qw/ croak /;
  5         8  
  5         314  
8              
9 5     5   402 use YAML::PP::Common qw/ YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE /;
  5         8  
  5         2232  
10              
11             sub register {
12 589     589 0 1558 my ($self, %args) = @_;
13 589         1062 my $schema = $args{schema};
14 589         746 my $options = $args{options};
15 589         676 my $empty_null = 0;
16 589         995 for my $opt (@$options) {
17 0 0       0 if ($opt eq 'empty=str') {
    0          
18             }
19             elsif ($opt eq 'empty=null') {
20 0         0 $empty_null = 1;
21             }
22             else {
23 0         0 croak "Invalid option for JSON Schema: '$opt'";
24             }
25             }
26              
27             $schema->add_resolver(
28             tag => qr{^(?:!|tag:)},
29             match => [ all => sub {
30 38     38   66 my ($constructor, $event) = @_;
31 38         56 my $value = $event->{value};
32 38         99 return $value;
33 589         3891 }],
34             implicit => 0,
35             );
36             $schema->add_sequence_resolver(
37             tag => qr{^(?:!|tag:)},
38             on_data => sub {
39 14     14   21 my ($constructor, $ref, $list) = @_;
40 14         34 push @$$ref, @$list;
41             },
42 589         3009 );
43             $schema->add_mapping_resolver(
44             tag => qr{^(?:!|tag:)},
45             on_data => sub {
46 28     28   44 my ($constructor, $ref, $list) = @_;
47 28         63 for (my $i = 0; $i < @$list; $i += 2) {
48 54         173 $$ref->{ $list->[ $i ] } = $list->[ $i + 1 ];
49             }
50             },
51 589         2688 );
52              
53 589         2389 return;
54             }
55              
56             1;
57              
58             __END__