File Coverage

blib/lib/Pinto/Difference.pm
Criterion Covered Total %
statement 62 65 95.3
branch 3 4 75.0
condition n/a
subroutine 13 14 92.8
pod 0 2 0.0
total 78 85 91.7


line stmt bran cond sub pod time code
1             # ABSTRACT: Compute difference between two revisions
2              
3             package Pinto::Difference;
4              
5 7     7   92984 use Moose;
  7         740727  
  7         78  
6 7     7   51499 use MooseX::StrictConstructor;
  7         49356  
  7         68  
7 7     7   35667 use MooseX::Types::Moose qw(ArrayRef Bool);
  7         88303  
  7         116  
8 7     7   36724 use MooseX::MarkAsMethods ( autoclean => 1 );
  7         15662  
  7         75  
9              
10 7     7   37016 use Pinto::DifferenceEntry;
  7         32  
  7         223  
11 7     7   1214 use Pinto::Constants qw(:diff);
  7         23  
  7         613  
12 7     7   1837 use Pinto::Types qw(DiffStyle);
  7         20  
  7         89  
13 7     7   40179 use Pinto::Util qw(itis default_diff_style);
  7         25  
  7         409  
14              
15 7     7   535 use overload ( q{""} => 'to_string' );
  7         16  
  7         59  
16              
17             #------------------------------------------------------------------------------
18              
19             our $VERSION = '0.13'; # VERSION
20              
21             #------------------------------------------------------------------------------
22              
23             has left => (
24             is => 'ro',
25             isa => 'Pinto::Schema::Result::Revision',
26             required => 1,
27             );
28              
29             has right => (
30             is => 'ro',
31             isa => 'Pinto::Schema::Result::Revision',
32             required => 1,
33             );
34              
35             has entries => (
36             traits => [qw(Array)],
37             handles => { entries => 'elements' },
38             isa => ArrayRef ['Pinto::DifferenceEntry'],
39             builder => '_build_diffs',
40             init_arg => undef,
41             lazy => 1,
42             );
43              
44             has additions => (
45             traits => [qw(Array)],
46             handles => { additions => 'elements' },
47             isa => ArrayRef ['Pinto::DifferenceEntry'],
48             default => sub { [ grep { $_->op eq '+' } shift->entries ] },
49             init_arg => undef,
50             lazy => 1,
51             );
52              
53             has deletions => (
54             traits => [qw(Array)],
55             handles => { deletions => 'elements' },
56             isa => ArrayRef ['Pinto::DifferenceEntry'],
57             default => sub { [ grep { $_->op eq '-' } shift->entries ] },
58             init_arg => undef,
59             lazy => 1,
60             );
61              
62             has is_different => (
63             is => 'ro',
64             isa => Bool,
65             init_arg => undef,
66             default => sub { shift->entries > 0 },
67             lazy => 1,
68             );
69              
70             has style => (
71             is => 'ro',
72             isa => DiffStyle,
73             default => \&default_diff_style,
74             );
75              
76             #------------------------------------------------------------------------------
77              
78             around BUILDARGS => sub {
79             my $orig = shift;
80             my $class = shift;
81             my $args = $class->$orig(@_);
82              
83             # The left and right attributes can also be Stack objects.
84             # In those cases, we just use the head revision of the Stack
85              
86             for my $side (qw(left right)) {
87             if ( $args->{$side}->isa('Pinto::Schema::Result::Stack') ) {
88             $args->{$side} = $args->{$side}->head;
89             }
90             }
91              
92             return $args;
93             };
94              
95             #------------------------------------------------------------------------------
96              
97             sub _build_diffs {
98 17     17   46 my ($self) = @_;
99              
100             # We want to find the registrations that are "different" in either
101             # side. Two registrations are the same if they have the same values in
102             # the package, distribution, and is_pinned columns. So we use these
103             # columns to construct the keys of a hash. The value is the id of
104             # the registration. For a concise diff, we just use the distribution
105             # and is_pinned columns, which effectively groups the records so there
106             # is only one diff entry per distribution. In that case, the package
107             # referenced by the registration won't be meaningful.
108              
109 17 100       416 my @fields = $self->style eq $PINTO_DIFF_STYLE_DETAILED
110             ? qw(distribution package is_pinned)
111             : qw(distribution is_pinned);
112              
113             my $cb = sub {
114 45     45   1123 my $value = $_[0]->id;
115 45         684 my $key = join '|', map { $_[0]->get_column($_) } @fields;
  98         465  
116 45         491 return ( $key => $value );
117 17         250 };
118              
119 17         84 my $attrs = { select => [ 'id', @fields ] };
120 17         435 my %left = $self->left->registrations( {}, $attrs )->as_hash($cb);
121 17         3032 my %right = $self->right->registrations( {}, $attrs )->as_hash($cb);
122              
123             # Now that we have hashes representing the left and right, we use
124             # the keys as "sets" and compute the difference between them. Keys
125             # present on the right but not on the left have been added. And
126             # those present on left but not on the right have been deleted.
127              
128 17         3425 my @add_ids = @right{ grep { not exists $left{$_} } keys %right };
  18         689  
129 17         157 my @del_ids = @left{ grep { not exists $right{$_} } keys %left };
  14         47  
130              
131             # Now we have the ids of all the registrations that were added or
132             # deleted between the left and right revisions. We use those ids to
133             # requery the database and construct full objects for each of them.
134              
135 17         521 my @adds = $self->_create_entries( '+', $self->right, \@add_ids );
136 17         2615 my @dels = $self->_create_entries( '-', $self->left, \@del_ids );
137              
138             # Strictly speaking, the registrations are an unordered list. But
139             # the diff is more readable if we group registrations together by
140             # distribution name.
141              
142 17         2064 my @diffs = sort @dels, @adds;
143              
144 17         6142 return \@diffs;
145             }
146              
147             #------------------------------------------------------------------------------
148              
149             sub _create_entries {
150 34     34   148 my ( $self, $type, $side, $ids ) = @_;
151              
152             # The number of ids is potentially pretty big (1000's) and we
153             # can't use that many values in an IN clause. So we insert all
154             # those ids into a temporary table.
155              
156 34         157 my $tmp_tbl = "__diff_${$}__";
157 34         846 my $dbh = $self->right->result_source->schema->storage->dbh;
158 34         11432 $dbh->do("CREATE TEMP TABLE $tmp_tbl (reg INTEGER NOT NULL)");
159              
160 34         6746 my $sth = $dbh->prepare("INSERT INTO $tmp_tbl VALUES( ? )");
161 34         2458 $sth->execute($_) for @{$ids};
  34         635  
162              
163             # Now fetch the actual Registration objects (with all their
164             # related objects) for each id in the temp table. Finally,
165             # map all the Registrations into DifferenceEntry objects.
166              
167 34         269 my $where = { 'me.id' => { in => \"SELECT reg from $tmp_tbl" } };
168 34         907 my $reg_rs = $side->registrations($where)->with_distribution->with_package;
169              
170 34         13029 my @entries = map { Pinto::DifferenceEntry->new( op => $type,
  32         438100  
171             registration => $_ ) } $reg_rs->all;
172              
173 34         79549 $dbh->do("DROP TABLE $tmp_tbl");
174              
175 34         4896 return @entries;
176             }
177              
178             #------------------------------------------------------------------------------
179              
180             sub foreach {
181 0     0 0 0 my ( $self, $cb ) = @_;
182              
183 0         0 $cb->($_) for $self->entries;
184              
185 0         0 return $self;
186             }
187              
188             #------------------------------------------------------------------------------
189              
190             sub to_string {
191 12     12 0 459 my ($self) = @_;
192              
193 12 50       320 my $format = $self->style eq $PINTO_DIFF_STYLE_CONCISE
194             ? '%o[%F] %a/%f'
195             : '';
196              
197 12         461 return join("\n", map {$_->to_string($format) } $self->entries) . "\n";
  15         263  
198             }
199              
200             #------------------------------------------------------------------------------
201              
202             __PACKAGE__->meta->make_immutable;
203              
204             #------------------------------------------------------------------------------
205             1;
206              
207             __END__
208              
209             =pod
210              
211             =encoding UTF-8
212              
213             =for :stopwords Jeffrey Ryan Thalhammer
214              
215             =head1 NAME
216              
217             Pinto::Difference - Compute difference between two revisions
218              
219             =head1 VERSION
220              
221             version 0.13
222              
223             =head1 AUTHOR
224              
225             Jeffrey Ryan Thalhammer <jeff@stratopan.com>
226              
227             =head1 COPYRIGHT AND LICENSE
228              
229             This software is copyright (c) 2015 by Jeffrey Ryan Thalhammer.
230              
231             This is free software; you can redistribute it and/or modify it under
232             the same terms as the Perl 5 programming language system itself.
233              
234             =cut