File Coverage

blib/lib/DBIx/Class/Schema/Diff/Role/Common.pm
Criterion Covered Total %
statement 79 86 91.8
branch 38 56 67.8
condition 17 30 56.6
subroutine 15 15 100.0
pod n/a
total 149 187 79.6


line stmt bran cond sub pod time code
1             package DBIx::Class::Schema::Diff::Role::Common;
2 5     5   51918 use strict;
  5         16  
  5         161  
3 5     5   35 use warnings;
  5         11  
  5         141  
4              
5 5     5   28 use Moo::Role;
  5         11  
  5         32  
6              
7 5     5   2139 use Types::Standard qw(:all);
  5         14  
  5         52  
8 5     5   245972 use Scalar::Util qw(blessed);
  5         15  
  5         392  
9 5     5   39 use List::MoreUtils qw(uniq);
  5         12  
  5         62  
10 5     5   5933 use Array::Diff;
  5         12  
  5         59  
11 5     5   4150 use JSON;
  5         51906  
  5         28  
12 5     5   2590 use Path::Class qw(file);
  5         154428  
  5         4444  
13              
14 31     31   2521 sub _types_list { qw(
15             columns
16             relationships
17             constraints
18             table_name
19             isa
20             )}
21              
22             #has '__types_list', is => 'ro', lazy => 1, default => sub {
23             # my $self = shift;
24             # my @list = qw(
25             # columns
26             # relationships
27             # constraints
28             # table_name
29             # isa
30             # );
31             # $self->split_db_schema_from_table_name and push @list, 'db_schema';
32             # \@list
33             #}, isa => ArrayRef;
34             #
35             #sub _types_list { @{(shift)->__types_list} }
36             #
37             #
38             #has 'split_db_schema_from_table_name',
39             # is => 'ro',
40             # is => Bool,
41             # default => sub { 0 };
42             #
43             #has 'null_db_schema_value',
44             # is => 'ro',
45             # isa => Str,
46             # default => sub { '' };
47              
48              
49              
50             # Adapted from Hash::Diff, but heavily modified and specific to
51             # the unique needs of this module...
52             sub _info_diff {
53 7953     7953   14779 my ($self, $old, $new) = @_;
54            
55 7953         29888 my %old_keys = map {$_=>1} keys %$old;
  24189         55363  
56              
57 7953         17162 my $nh = {};
58              
59 7953         28304 for my $k (keys %$new) {
60 24189 50       48060 if (exists $old->{$k}) {
61 24189         38023 delete $old_keys{$k};
62 24189 100       47328 if(ref $new->{$k} eq 'HASH') {
63 3795 50       8075 if(ref $old->{$k} eq 'HASH') {
64 3795 100       8684 my $diff = $self->_info_diff($old->{$k},$new->{$k}) or next;
65 22         67 $nh->{$k} = $diff;
66             }
67             else {
68 0         0 $nh->{$k} = $new->{$k};
69             }
70             }
71             else {
72             # Test if the non hash values are determined to be "equal"
73 20394 100       41972 $nh->{$k} = $new->{$k} unless ($self->_is_eq($old->{$k},$new->{$k}));
74             }
75             }
76             else {
77 0         0 $nh->{$k} = $new->{$k};
78             }
79             }
80            
81             # fill back in any left over, old keys (i.e. weren't in $new):
82             # TODO: track these separately
83 7953         17699 $nh->{$_} = $old->{$_} for (keys %old_keys);
84              
85 7953 100       111348 return undef unless (keys %$nh > 0);
86 90         300 return $nh;
87             }
88              
89             # test non-hash
90             # Note: since 'SchemaData' was introduced (Github Issue #1) most of
91             # this logic is now redundant/not needed...
92             sub _is_eq {
93 21472     21472   49166 my ($self, $old, $new) = @_;
94            
95             # if both undef, they are equal:
96 21472 0 33     42156 return 1 if(!defined $old && !defined $new);
97            
98 21472         37851 my ($o_ref,$n_ref) = (ref $old,ref $new);
99            
100             # one is a ref and the other isn't, obviously not equal:
101 21472 50 66     71553 return 0 if ($n_ref && !$o_ref || $o_ref && !$n_ref);
      66        
      33        
102            
103             # both refs:
104 21472 100 66     42355 if($o_ref && $n_ref) {
105             # If they are not the same kind of ref, they obviously aren't equal:
106 605 50       1399 return 0 unless ($o_ref eq $n_ref);
107            
108 605 50 33     2891 if($n_ref eq 'CODE') {
    50          
    50          
    0          
    0          
109             # We can't tell the difference between CodeRefs, but we don't want
110             # those cases to show up as changed, so we call them equal:
111 0         0 return 1;
112             }
113             elsif($n_ref eq 'SCALAR' || $n_ref eq 'REF') {
114             # For ScalarRefs, compare their referants:
115 0         0 return $self->_is_eq($$old,$$new);
116             }
117             elsif($n_ref eq 'ARRAY') {
118             # If they don't have the same number of elements, they aren't equal:
119 605 100       1677 return 0 unless (scalar @$new == scalar @$old);
120            
121             # If they are both empty, they are equal:
122 594 50 33     1526 return 1 if (scalar @$new == 0 && scalar @$old == 0);
123            
124             # iterate both sides:
125 594         953 my $i = 0;
126 594         1341 for my $n_el (@$new) {
127 1078         2474 my $o_el = $old->[$i++];
128             # Return 0 as soon as the first element is not equal:
129 1078 100       2271 return 0 unless ($self->_is_eq($o_el,$n_el));
130             }
131            
132             # If we made it here, then all the elements were equal above:
133 572         2043 return 1;
134             }
135             elsif($n_ref eq 'HASH') {
136             # This case will only be called by us for HashRef elements of ArrayRef
137             # (case above). The main _info_diff() function handles HashRef's itself.
138             # Also note that from this point it is a true/false equality -- there
139             # is no more selective merging of hashes, showing only different keys
140             #
141             # If the hashes are equal, the diff should be undef:
142 0 0       0 return $self->_info_diff($old,$new) ? 0 : 1;
143             }
144             elsif(blessed $new) {
145             # If this is an object reference, just compare the classes, since we don't
146             # know how to compare object data and won't try:
147 0         0 return $self->_is_eq(blessed($old),blessed($new));
148             }
149             else {
150 0         0 die "Unexpected ref type '$n_ref'";
151             }
152             }
153              
154             # simple scalar value comparison:
155 20867   66     110569 return (defined $old && defined $new && "$old" eq "$new");
156             }
157              
158              
159             sub _coerce_list_hash {
160             $_[0] && ! ref($_[0]) ? { $_[0] => 1 } :
161 7 100 66 7   377 ref($_[0]) eq 'ARRAY' ? { map {$_=>1} @{$_[0]} } : $_[0];
  2 100       24  
  1         5  
162             }
163              
164              
165             sub _coerce_schema_diff {
166 100 100   100   7649 blessed $_[0] ? $_[0] : DBIx::Class::Schema::Diff::Schema->new($_[0]);
167             }
168              
169              
170             sub _coerce_schema_data {
171 48     48   14844 my ($v) = @_;
172 48         172 my $rt = ref($v);
173 48 100       168 if($rt) {
174 32 100 100     404 if(blessed($v) && blessed($v) eq 'DBIx::Class::Schema::Diff::SchemaData') {
    100          
175 1         22 return $v;
176             }
177             elsif($rt eq 'HASH') {
178 2         45 return DBIx::Class::Schema::Diff::SchemaData->new({ data => $v });
179             }
180             else {
181             # Assume all other ref types are schema instances:
182 29         718 return DBIx::Class::Schema::Diff::SchemaData->new({ schema => $v });
183             }
184             }
185             else {
186 16 100       117 unless(Module::Runtime::is_module_name($v)) {
187 4         107 my $file = file($v)->absolute;
188 4 50       1019 if(-f $file) {
189             # Assume it is a json file and try to decode it:
190 4         359 local $/;
191 4 50       118 open( my $fh, '<', $file ) or die "Could not open $file: $!";
192 4         1544 my $json_text = <$fh>;
193 4         125 close $fh;
194 4         3509 my $data = JSON::decode_json($json_text);
195 4         177 return DBIx::Class::Schema::Diff::SchemaData->new({ data => $data });
196             }
197             }
198 12         507 return DBIx::Class::Schema::Diff::SchemaData->new({ schema => $v });
199             }
200             }
201              
202              
203             1;
204              
205              
206             __END__