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   143243 use strict;
  5         11  
  5         195  
2 5     5   16 use warnings;
  5         7  
  5         391  
3             package YAML::PP::Schema::Catchall;
4              
5             our $VERSION = 'v0.40.1'; # TRIAL VERSION
6              
7 5     5   30 use Carp qw/ croak /;
  5         9  
  5         296  
8              
9 5     5   348 use YAML::PP::Common qw/ YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE /;
  5         9  
  5         1922  
10              
11             sub register {
12 589     589 0 1857 my ($self, %args) = @_;
13 589         956 my $schema = $args{schema};
14 589         951 my $options = $args{options};
15 589         828 my $empty_null = 0;
16 589         1088 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   70 my ($constructor, $event) = @_;
31 38         52 my $value = $event->{value};
32 38         99 return $value;
33 589         4071 }],
34             implicit => 0,
35             );
36             $schema->add_sequence_resolver(
37             tag => qr{^(?:!|tag:)},
38             on_data => sub {
39 14     14   24 my ($constructor, $ref, $list) = @_;
40 14         40 push @$$ref, @$list;
41             },
42 589         3059 );
43             $schema->add_mapping_resolver(
44             tag => qr{^(?:!|tag:)},
45             on_data => sub {
46 28     28   55 my ($constructor, $ref, $list) = @_;
47 28         91 for (my $i = 0; $i < @$list; $i += 2) {
48 54         182 $$ref->{ $list->[ $i ] } = $list->[ $i + 1 ];
49             }
50             },
51 589         2789 );
52              
53 589         2647 return;
54             }
55              
56             1;
57              
58             __END__