File Coverage

blib/lib/Cfn/Diff.pm
Criterion Covered Total %
statement 61 68 89.7
branch 30 42 71.4
condition 3 6 50.0
subroutine 6 6 100.0
pod 0 3 0.0
total 100 125 80.0


line stmt bran cond sub pod time code
1             package Cfn::Diff::Changes {
2 1     1   541 use Moose;
  1         2  
  1         7  
3             has path => (is => 'ro', isa => 'Str');
4             has change => (is => 'ro', isa => 'Str');
5             # to and from are left as rw because diff wants to
6             # reassign these properties to the resolved version
7             # when a DynamicValue is found
8             has from => (is => 'rw');
9             has to => (is => 'rw');
10             }
11              
12             package Cfn::Diff {
13 1     1   6029 use Moose;
  1         2  
  1         4  
14             extends 'Cfn';
15              
16             has changes => (
17             is => 'rw',
18             isa => 'ArrayRef[Cfn::Diff::Changes]',
19             default => sub { [] },
20             traits => [ 'Array' ],
21             handles => {
22             new_addition => 'push',
23             new_deletion => 'push',
24             new_change => 'push',
25             },
26             );
27              
28             has left => (is => 'ro', isa => 'Cfn', required => 1);
29             has right => (is => 'ro', isa => 'Cfn', required => 1);
30              
31             sub diff {
32 10     10 0 10265 my ($self) = @_;
33 10         210 my $old = $self->left;
34 10         216 my $new = $self->right;
35              
36 10         319 my %new_resources = map { ( $_ => 1 ) } $new->ResourceList;
  10         48  
37 10         250 my %old_resources = map { ( $_ => 1 ) } $old->ResourceList;
  10         33  
38 10         23 my %changed = ();
39 10         28 foreach my $res (keys %new_resources) {
40 10 100       31 if (exists $old_resources{ $res }) {
41 9 100       258 if (my @changes = $self->compare_resource($new->Resource($res)->Properties, $old->Resource($res)->Properties, $res)) {
42 6         158 $self->new_change(@changes);
43             }
44 9         27 delete $new_resources{ $res };
45 9         26 delete $old_resources{ $res };
46             } else {
47 1         32 $self->new_addition(Cfn::Diff::Changes->new(path => "Resources.$res", change => 'Resource Added', from => undef, to => $new->Resource($res)));
48 1         3 delete $new_resources{ $res };
49             }
50             }
51 10         44 foreach my $res (keys %old_resources) {
52 1         31 $self->new_deletion(Cfn::Diff::Changes->new(path => "Resources.$res", change => 'Resource Deleted', from => $old->Resource($res), to => undef));
53             }
54             }
55              
56             sub compare_resource {
57 9     9 0 32 my ($self, $new, $old, $res) = @_;
58 9         21 my @changes = ();
59 9         43 foreach my $p ($new->meta->get_all_attributes) {
60 145         1120 my $meth = $p->name;
61 145         4117 my $new_val = $new->$meth;
62 145         3688 my $old_val = $old->$meth;
63              
64 145 50 66     469 next if (not defined $new_val and not defined $old_val);
65              
66 24 50       58 if (not defined $new_val) {
67 0         0 push @changes, Cfn::Diff::Changes->new(path => "Resources.$res.Properties.$meth", change => 'Property Deleted', from => $old_val, to => undef);
68 0         0 next;
69             }
70 24 100       62 if (not defined $old_val) {
71 1         10 push @changes, Cfn::Diff::Changes->new(path => "Resources.$res.Properties.$meth", change => 'Property Added', from => undef, to => $new_val);
72 1         992 next;
73             }
74 23 100       84 if (not $self->properties_equal($new_val, $old_val, "$res.$meth")) {
75 6         147 push @changes, Cfn::Diff::Changes->new(path => "Resources.$res.Properties.$meth", change => 'Property Changed', from => $old_val, to => $new_val);
76 6         6056 next;
77             }
78             }
79 9         46 return @changes;
80             }
81              
82 1     1   5919 use Scalar::Util;
  1         5  
  1         335  
83             sub properties_equal {
84 93     93 0 167 my ($self, $new, $old) = @_;
85              
86 93 100       298 if (blessed($new)){
87 74 50       185 if (blessed($old)){
88             # See if old and new are of the same class
89 74 100       207 return 0 if ($new->meta->name ne $old->meta->name);
90              
91             # Old and new are guaranteed to be the same type now, so just go on with new
92 71 100       2439 if ($new->isa('Cfn::Value::Primitive')) {
    100          
    50          
93 35         727 return ($new->Value eq $old->Value);
94             } elsif ($new->isa('Cfn::Value::Function')) {
95 18   33     398 return (($new->Function eq $old->Function) and $self->properties_equal($new->Value, $old->Value));
96             } elsif ($new->isa('Cfn::Value')) {
97 18         375 return $self->properties_equal($new->Value, $old->Value);
98             } else {
99 0         0 die "Don't know how to compare $new";
100             }
101             } else {
102 0         0 return 0;
103             }
104             } else {
105 19 50       46 if (blessed($old)) {
106 0         0 return 0;
107             } else {
108 19 50       54 return 0 if (ref($old) ne ref($new));
109 19 50       59 if (not ref($new)){
    100          
    50          
110 0         0 return ($new eq $old);
111             } elsif (ref($new) eq 'ARRAY') {
112 18 50       45 return 0 if (@$new != @$old);
113 18         46 for (my $i = 0; $i < @$new; $i++) {
114 33 50       80 return 0 if (not $self->properties_equal($new->[$i], $old->[$i]));
115             }
116 18         89 return 1;
117             } elsif (ref($new) eq 'HASH') {
118 1 50       5 return 0 if ((keys %$new) != (keys %$old));
119 1         3 foreach my $key (keys %$new) {
120 1 50       4 return 0 if (not $self->properties_equal($new->{ $key }, $old->{ $key }));
121             }
122 1         4 return 1;
123             } else {
124 0           die "Don't know how to non-blessed compare " . ref($new);
125             }
126             }
127             }
128             }
129             }
130              
131             1;