File Coverage

blib/lib/DBIx/Class/Schema/Diff.pm
Criterion Covered Total %
statement 70 79 88.6
branch 11 14 78.5
condition 10 21 47.6
subroutine 17 21 80.9
pod 3 5 60.0
total 111 140 79.2


line stmt bran cond sub pod time code
1             package DBIx::Class::Schema::Diff;
2 5     5   639130 use strict;
  5         46  
  5         150  
3 5     5   28 use warnings;
  5         9  
  5         193  
4              
5             # ABSTRACT: Simple Diffing of DBIC Schemas
6              
7             our $VERSION = 1.12;
8              
9 5     5   2820 use Moo;
  5         47643  
  5         27  
10             with 'DBIx::Class::Schema::Diff::Role::Common';
11              
12 5     5   10657 use Types::Standard qw(:all);
  5         410775  
  5         59  
13 5     5   247910 use Module::Runtime;
  5         14  
  5         58  
14 5     5   2426 use Try::Tiny;
  5         4732  
  5         353  
15 5     5   39 use List::Util;
  5         13  
  5         460  
16 5     5   3220 use Hash::Layout 2.00;
  5         776955  
  5         197  
17 5     5   2418 use Array::Diff;
  5         56485  
  5         34  
18 5     5   3552 use Data::Dumper;
  5         35376  
  5         348  
19              
20 5     5   2565 use DBIx::Class::Schema::Diff::Schema;
  5         38  
  5         335  
21 5     5   2983 use DBIx::Class::Schema::Diff::Filter;
  5         24  
  5         235  
22 5     5   2995 use DBIx::Class::Schema::Diff::State;
  5         22  
  5         6111  
23              
24             sub state {
25 0 0 0 0 0 0 shift if ($_[0] && (try{ $_[0]->isa(__PACKAGE__) } || $_[0] eq __PACKAGE__));
  0   0 0   0  
26 0         0 DBIx::Class::Schema::Diff::State->new(@_)
27             }
28              
29              
30             has '_schema_diff', required => 1, is => 'ro', isa => InstanceOf[
31             'DBIx::Class::Schema::Diff::Schema'
32             ], coerce => \&_coerce_schema_diff;
33              
34             has 'diff', is => 'ro', lazy => 1, default => sub {
35             (shift)->_schema_diff->diff
36             }, isa => Maybe[HashRef];
37              
38             has 'MatchLayout', is => 'ro', lazy => 1, default => sub {
39             my $self = shift;
40            
41             Hash::Layout->new({
42             default_key => '*',
43             default_value => 1,
44             levels => [
45             {
46             name => 'source',
47             delimiter => ':',
48             registered_keys => [$self->_schema_diff->all_source_names]
49             },{
50             name => 'type',
51             delimiter => '/',
52             registered_keys => [&_types_list]
53             },{
54             name => 'id',
55             }
56             ]
57             });
58              
59             }, init_arg => undef, isa => InstanceOf['Hash::Layout'];
60              
61              
62             around BUILDARGS => sub {
63             my ($orig, $self, @args) = @_;
64             my %opt = (ref($args[0]) eq 'HASH') ? %{ $args[0] } : @args; # <-- arg as hash or hashref
65            
66             return $opt{_schema_diff} ? $self->$orig(%opt) : $self->$orig( _schema_diff => \%opt );
67             };
68              
69              
70             sub filter {
71 76     76 1 88510 my ($self,@args) = @_;
72 76         360 my $params = $self->_coerce_filter_args(@args);
73            
74 76         97644 my $Filter = DBIx::Class::Schema::Diff::Filter->new( $params ) ;
75 76         3512 my $diff = $Filter->filter( $self->diff );
76            
77             # Make a second pass, using the actual matched paths to filter out
78             # the intermediate paths that didn't actually match anything:
79             # (update: unless this is an empty match, in which case we will just
80             # return the whole diff as-is)
81 76 100 100     1401 if($Filter->mode eq 'limit' && ! $Filter->empty_match) {
82 52 100       540 if(scalar(@{$Filter->matched_paths}) > 0) {
  52         244  
83             $params->{match} = $Filter->match->clone->reset->load( map {
84 284         5440 $Filter->match->path_to_composite_key(@$_)
85 51         269 } @{$Filter->matched_paths} );
  51         8868  
86 51         128988 $Filter = DBIx::Class::Schema::Diff::Filter->new( $params ) ;
87 51         2569 $diff = $Filter->filter( $diff );
88             }
89             else {
90             # If nothing was matched, in limit mode, the diff is undef:
91 1         8 $diff = undef;
92             }
93             }
94            
95 76         592 return $self->chain_new($diff)
96             }
97              
98             sub chain_new {
99 76     76 0 216 my ($self, $diff) = @_;
100 76         2038 return __PACKAGE__->new({
101             _schema_diff => $self->_schema_diff,
102             diff => $diff
103             });
104             }
105              
106             sub filter_out {
107 19     19 1 8378 my ($self,@args) = @_;
108 19         75 my $params = $self->_coerce_filter_args(@args);
109 19         55327 $params->{mode} = 'ignore';
110 19         92 return $self->filter( $params );
111             }
112              
113              
114             sub _coerce_filter_args {
115 95     95   289 my ($self,@args) = @_;
116            
117             # This is the cleanest solution for wildcards to match as expected, not requiring the
118             # user to append a trailing '*' since they don't have to when doing an exact match
119             @args = map {
120 95 100 66     286 my ($one,$two) = ($_ && ! ref($_)) ? split (/\:/,$_,2) : ();
  127         988  
121             (
122 127 50 33     1026 $one && $two && $one ne '*' && ($one =~ /\*/)
123             && ($two eq 'columns' || $two eq 'relationships' || $two eq 'constraints')
124             ) ? $_.'*' : $_
125             } @args;
126            
127 95 100 66     881 my $params = (
128             scalar(@args) > 1
129             || ! ref($args[0])
130             || ref($args[0]) ne 'HASH'
131             ) ? { match => \@args } : $args[0];
132            
133 95 100       338 unless (exists $params->{match}) {
134 10         30 my $n = { match => $params };
135 10         32 my @othr = qw(events source_events);
136 10   66     72 exists $n->{match}{$_} and $n->{$_} = delete $n->{match}{$_} for (@othr);
137 10         28 $params = $n;
138             }
139              
140             return {
141             %$params,
142             match => $self->MatchLayout->coerce($params->{match})
143 95         3030 };
144             }
145              
146              
147              
148             sub fingerprint {
149 0     0 1   my $self = shift;
150 0           my $sum = Digest::SHA1->new->add( $self->_string_for_signature )->hexdigest;
151 0           join('-', 'diffsum', substr($sum,0,15) )
152             }
153              
154              
155             # So far this is the only thing I could find to produce a consistent string value across all
156             # Travis tested perls (5.10,5.12,5.14,5.16,5.18,5.20,5.22,5.24,5.26)
157             sub _string_for_signature {
158 0     0     my $self = shift;
159            
160 0           local $Data::Dumper::Maxdepth = 0;
161 0           Data::Dumper->new([ $self->diff ])
162             ->Purity(0)
163             ->Terse(1)
164             ->Indent(0)
165             ->Useqq(1)
166             ->Sortkeys(1)
167             ->Dump()
168             }
169              
170              
171             1;
172              
173              
174             __END__