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   52259 use strict;
  5         16  
  5         162  
3 5     5   31 use warnings;
  5         27  
  5         131  
4              
5 5     5   29 use Moo::Role;
  5         10  
  5         30  
6              
7 5     5   2202 use Types::Standard qw(:all);
  5         14  
  5         47  
8 5     5   244257 use Scalar::Util qw(blessed);
  5         15  
  5         449  
9 5     5   44 use List::MoreUtils qw(uniq);
  5         11  
  5         64  
10 5     5   6173 use Array::Diff;
  5         18  
  5         63  
11 5     5   4548 use JSON;
  5         52255  
  5         30  
12 5     5   2458 use Path::Class qw(file);
  5         155471  
  5         4375  
13              
14 31     31   2517 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   14681 my ($self, $old, $new) = @_;
54            
55 7953         26930 my %old_keys = map {$_=>1} keys %$old;
  24189         51907  
56              
57 7953         16559 my $nh = {};
58              
59 7953         26192 for my $k (keys %$new) {
60 24189 50       46739 if (exists $old->{$k}) {
61 24189         37753 delete $old_keys{$k};
62 24189 100       45695 if(ref $new->{$k} eq 'HASH') {
63 3795 50       7966 if(ref $old->{$k} eq 'HASH') {
64 3795 100       8277 my $diff = $self->_info_diff($old->{$k},$new->{$k}) or next;
65 22         63 $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       41016 $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         17101 $nh->{$_} = $old->{$_} for (keys %old_keys);
84              
85 7953 100       109511 return undef unless (keys %$nh > 0);
86 90         324 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   45692 my ($self, $old, $new) = @_;
94            
95             # if both undef, they are equal:
96 21472 0 33     41619 return 1 if(!defined $old && !defined $new);
97            
98 21472         36831 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     68935 return 0 if ($n_ref && !$o_ref || $o_ref && !$n_ref);
      66        
      33        
102            
103             # both refs:
104 21472 100 66     41564 if($o_ref && $n_ref) {
105             # If they are not the same kind of ref, they obviously aren't equal:
106 605 50       1416 return 0 unless ($o_ref eq $n_ref);
107            
108 605 50 33     2764 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       1606 return 0 unless (scalar @$new == scalar @$old);
120            
121             # If they are both empty, they are equal:
122 594 50 33     1519 return 1 if (scalar @$new == 0 && scalar @$old == 0);
123            
124             # iterate both sides:
125 594         995 my $i = 0;
126 594         1343 for my $n_el (@$new) {
127 1078         2403 my $o_el = $old->[$i++];
128             # Return 0 as soon as the first element is not equal:
129 1078 100       2256 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         1913 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     107490 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   388 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   7544 blessed $_[0] ? $_[0] : DBIx::Class::Schema::Diff::Schema->new($_[0]);
167             }
168              
169              
170             sub _coerce_schema_data {
171 48     48   14498 my ($v) = @_;
172 48         175 my $rt = ref($v);
173 48 100       188 if($rt) {
174 32 100 100     394 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         47 return DBIx::Class::Schema::Diff::SchemaData->new({ data => $v });
179             }
180             else {
181             # Assume all other ref types are schema instances:
182 29         673 return DBIx::Class::Schema::Diff::SchemaData->new({ schema => $v });
183             }
184             }
185             else {
186 16 100       116 unless(Module::Runtime::is_module_name($v)) {
187 4         105 my $file = file($v)->absolute;
188 4 50       1008 if(-f $file) {
189             # Assume it is a json file and try to decode it:
190 4         334 local $/;
191 4 50       133 open( my $fh, '<', $file ) or die "Could not open $file: $!";
192 4         1211 my $json_text = <$fh>;
193 4         71 close $fh;
194 4         4145 my $data = JSON::decode_json($json_text);
195 4         183 return DBIx::Class::Schema::Diff::SchemaData->new({ data => $data });
196             }
197             }
198 12         496 return DBIx::Class::Schema::Diff::SchemaData->new({ schema => $v });
199             }
200             }
201              
202              
203             1;
204              
205              
206             __END__