File Coverage

blib/lib/Cfn/YAML/Schema.pm
Criterion Covered Total %
statement 41 81 50.6
branch 6 36 16.6
condition n/a
subroutine 9 14 64.2
pod 0 2 0.0
total 56 133 42.1


line stmt bran cond sub pod time code
1             package Cfn::YAML::Schema;
2 2     2   1359 use base 'YAML::PP::Schema';
  2         5  
  2         204  
3 2     2   15 use strict;
  2         3  
  2         40  
4 2     2   11 use warnings;
  2         3  
  2         3026  
5              
6             sub new {
7 0     0 0 0 my ($class, %args) = @_;
8 0         0 my $self = bless {}, $class;
9 0         0 return $self;
10             }
11              
12             our $tag_subs = {
13             '!Ref' => sub { { Ref => $_[0] } },
14             '!Condition' => sub { { Condition => $_[0] } },
15             '!Base64' => sub { { 'Fn::Base64' => $_[0] } },
16             '!Sub' => sub { { 'Fn::Sub' => $_[0] } },
17             '!GetAZs' => sub { { 'Fn::GetAZs' => $_[0] } },
18             '!ImportValue' => sub { { 'Fn::ImportValue' => $_[0] } },
19             '!GetAtt' => sub {
20             my $value = shift;
21             my @parts = split /\./, $value, 2;
22             { 'Fn::GetAtt' => [ $parts[0], $parts[1] ] }
23             },
24             };
25              
26             our $sequence_tags = {
27             GetAtt => 1, Cidr => 1, Join => 1, FindInMap => 1, Split => 1,
28             Sub => 1, Equals => 1, Or => 1, And => 1, If => 1, Not => 1,
29             Select => 1,
30             };
31              
32             our $mapping_tags = {
33             Transform => 1,
34             Base64 => 1,
35             };
36              
37             sub register {
38 13     13 0 1886 my ($self, %args) = @_;
39 13         43 my $schema = $args{schema};
40              
41             $schema->add_resolver(
42             tag => qr/^!.*/,
43             implicit => 0,
44             match => [ regex => qr{^(.*)$} => sub {
45 92     92   725443 my ($self, $event) = @_;
46 92         202 my $tag = $event->{ tag };
47 92 100       323 die "Unsupported scalar tag '$tag'" if (not defined $tag_subs->{ $tag });
48 91         267 return $tag_subs->{ $tag }->($event->{ value });
49 13         162 } ]
50             );
51              
52             $schema->add_sequence_resolver(
53             tag => qr/^!.*/,
54             on_create => sub {
55 51     51   141496 my ($constructor, $event) = @_;
56 51         122 my $tag = $event->{ tag };
57 51         189 $tag =~ s/^!//;
58 51 100       272 die "Unsupported sequence tag '$event->{ tag }'" if (not defined $sequence_tags->{ $tag });
59 50         205 return { "Fn::$tag" => [ ] };
60             },
61             on_data => sub {
62 50     50   36961 my ($constructor, $ref, $items) = @_;
63 50         92 my $struct = $$ref;
64 50         202 my $key = [ keys %$struct ]->[ 0 ];
65 50         107 push @{ $struct->{ $key } }, @$items;
  50         165  
66             },
67 13         658 );
68              
69             $schema->add_mapping_resolver(
70             tag => qr/^!.*/,
71             on_create => sub {
72 3     3   2671 my ($constructor, $event) = @_;
73 3         12 my $tag = $event->{ tag };
74 3         14 $tag =~ s/^!//;
75 3 100       28 die "Unsupported mapping tag '$event->{ tag }'" if (not defined $mapping_tags->{ $tag });
76 2         11 return { "Fn::$tag" => { } };
77             },
78             on_data => sub {
79 2     2   3944 my ($constructor, $ref, $items) = @_;
80 2         7 my $struct = $$ref;
81 2         10 my $key = [ keys %$struct ]->[ 0 ];
82 2         11 $struct->{ $key } = { @$items };
83             }
84 13         452 );
85            
86             $schema->add_representer(
87             class_equals => 'Cfn',
88             code => sub {
89 0     0   0 my ($representer, $node) = @_;
90 0         0 my $self = $node->{ value };
91             $node->{ data } = {
92             (defined $self->AWSTemplateFormatVersion)?(AWSTemplateFormatVersion => $self->AWSTemplateFormatVersion):(),
93             (defined $self->Description)?(Description => $self->Description):(),
94             (defined $self->Transform) ? (Transform => $self->Transform) : (),
95 0         0 (defined $self->Mappings)?(Mappings => { map { ($_ => $self->Mappings->{ $_ }->Value) } keys %{ $self->Mappings } }):(),
  0         0  
96 0         0 (defined $self->Parameters)?(Parameters => { map { ($_ => $self->Parameters->{ $_ }->Value) } keys %{ $self->Parameters } }):(),
  0         0  
97 0         0 (defined $self->Outputs)?(Outputs => { map { ($_ => $self->Outputs->{ $_ }->Value) } keys %{ $self->Outputs } }):(),
  0         0  
98 0         0 (defined $self->Conditions)?(Conditions => { map { ($_ => $self->Condition($_)->Value) } $self->ConditionList }):(),
99 0         0 (defined $self->Metadata)?(Metadata => { map { ($_ => $self->Metadata->{ $_ }->Value) } $self->MetadataList }):(),
100 0 0       0 Resources => { map { ($_ => $self->Resource($_)) } $self->ResourceList },
  0 0       0  
    0          
    0          
    0          
    0          
    0          
    0          
101             };
102 0         0 return 1;
103             },
104 13         317 );
105            
106             $schema->add_representer(
107             class_equals => 'Cfn::DynamicValue',
108 0     0   0 code => sub { die "Implement me" },
109 13         294 );
110            
111             $schema->add_representer(
112             class_equals => 'Cfn::Value::TypedValue',
113 0     0   0 code => sub { die "Implement me" },
114 13         213 );
115            
116             $schema->add_representer(
117             class_matches => 1,
118             code => sub {
119 0     0     my ($representer, $node) = @_;
120 0           my $value = $node->{ value };
121 0 0         if ($value->isa('Cfn::Resource')) {
    0          
    0          
    0          
    0          
122 0           my $self = $value;
123             $node->{ data } = {
124             (defined $self->Properties) ? (Properties => $self->Properties) : (),
125 0           (map { $_ => $self->$_->Value }
126 0           grep { defined $self->$_ } qw/Metadata UpdatePolicy/),
127 0           (map { $_ => $self->$_ }
128 0 0         grep { defined $self->$_ } qw/Type DeletionPolicy DependsOn CreationPolicy Condition/),
  0            
129             };
130 0           return 1;
131             } elsif ($value->isa('Cfn::Resource::Properties')) {
132 0           my $self = $value;
133 0 0         $node->{ data } = { map { my $name = $_->name; (defined $self->$name)?($name => $self->$name):() } $self->meta->get_all_attributes };
  0            
  0            
134 0           return 1;
135             } elsif ($value->isa('Cfn::Value::Function::Ref')) {
136             #$node->{ tag } = '!Ref';
137 0           $node->{ data } = { 'Ref' => $value->LogicalId };
138             } elsif ($value->isa('Cfn::Value::Function')) {
139 0           my $value = $node->{ value };
140             #$node->{ tag } = sprintf '!%s', $value->Function;
141 0           $node->{ data } = { $value->Function => $value->Value->Value };
142 0           return 1;
143             } elsif ($value->isa('Cfn::Value')) {
144 0           $node->{ data } = $value->Value;
145 0           return 1;
146             } else {
147 0           die "Don't know how to serialize a $value";
148             }
149             }
150 13         228 );
151             }
152             1;