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   146894 use strict;
  5         11  
  5         145  
2 5     5   16 use warnings;
  5         8  
  5         324  
3             package YAML::PP::Schema::Catchall;
4              
5             our $VERSION = 'v0.41.1'; # TRIAL VERSION
6              
7 5     5   21 use Carp qw/ croak /;
  5         8  
  5         273  
8              
9 5     5   401 use YAML::PP::Common qw/ YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE /;
  5         8  
  5         1811  
10              
11             sub register {
12 589     589 0 2174 my ($self, %args) = @_;
13 589         1004 my $schema = $args{schema};
14 589         912 my $options = $args{options};
15 589         913 my $empty_null = 0;
16 589         1070 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   78 my ($constructor, $event) = @_;
31 38         65 my $value = $event->{value};
32 38         99 return $value;
33 589         4259 }],
34             implicit => 0,
35             );
36             $schema->add_sequence_resolver(
37             tag => qr{^(?:!|tag:)},
38             on_data => sub {
39 14     14   32 my ($constructor, $ref, $list) = @_;
40 14         36 push @$$ref, @$list;
41             },
42 589         3826 );
43             $schema->add_mapping_resolver(
44             tag => qr{^(?:!|tag:)},
45             on_data => sub {
46 28     28   57 my ($constructor, $ref, $list) = @_;
47 28         82 for (my $i = 0; $i < @$list; $i += 2) {
48 54         185 $$ref->{ $list->[ $i ] } = $list->[ $i + 1 ];
49             }
50             },
51 589         3219 );
52              
53 589         3083 return;
54             }
55              
56             1;
57              
58             __END__