File Coverage

blib/lib/DBIx/Class/AuditAny/AuditContext/Change.pm
Criterion Covered Total %
statement 61 67 91.0
branch 10 18 55.5
condition 2 3 66.6
subroutine 15 21 71.4
pod 13 13 100.0
total 101 122 82.7


line stmt bran cond sub pod time code
1             package DBIx::Class::AuditAny::AuditContext::Change;
2 14     14   10279 use strict;
  14         41  
  14         527  
3 14     14   81 use warnings;
  14         37  
  14         518  
4              
5             # ABSTRACT: Default 'Change' context object class for DBIx::Class::AuditAny
6              
7 14     14   90 use Moo;
  14         33  
  14         128  
8 14     14   25268 use MooX::Types::MooseLike::Base 0.19 qw(:all);
  14         461  
  14         5837  
9             extends 'DBIx::Class::AuditAny::AuditContext';
10              
11 14     14   8785 use Time::HiRes qw(gettimeofday tv_interval);
  14         22396  
  14         78  
12 14     14   2627 use DBIx::Class::AuditAny::Util;
  14         42  
  14         26876  
13              
14             =head1 NAME
15              
16             DBIx::Class::AuditAny::AuditContext::Change - Default 'Change' context object for DBIC::AuditAny
17              
18             =head1 DESCRIPTION
19              
20             This is the class which represents a single captured change event, which could involve multiple
21             columns.
22              
23             =head1 ATTRIBUTES
24              
25             Docs regarding the API/purpose of the attributes and methods in this class still TBD...
26              
27             =head2 SourceContext
28              
29             The Source context
30              
31             =cut
32             has 'SourceContext', is => 'ro', isa => Object, required => 1;
33              
34             =head2 ChangeSetContext
35              
36             The parent ChangeSet
37              
38             =cut
39             has 'ChangeSetContext', is => 'rw', isa => Maybe[Object], default => sub{undef};
40              
41              
42             =head2 action
43              
44             The type of action which triggered this change: insert, update or delete, or the special
45             action 'select' which is used to initialize tracked rows in the audit database
46              
47             =cut
48             has 'action', is => 'ro', isa => Enum[qw(insert update delete select)], required => 1;
49              
50              
51             =head2 old_columns
52              
53             The column values of the row, -according to the db- *before* the change happens.
54             This should be an empty hashref in the case of 'insert'
55              
56             =cut
57             has 'old_columns', is => 'ro', isa => HashRef, lazy => 1, default => sub {{}};
58              
59             =head2 to_columns
60              
61             The column changes specified -by the change- (specified by
62             the client/query). Note that this is different from 'new_columns' and
63             probably doesn't contain all the columns. This should be an empty
64             hashref in the case of 'delete'
65             (TODO: would 'change_columns' a better name than 'to_columns'?)
66              
67             =cut
68             has 'to_columns', is => 'ro', isa => HashRef, lazy => 1, default => sub{{}};
69              
70             =head2 new_columns
71              
72             The column values of the row, -according to the db- *after* the change happens.
73             This should be an empty hashref in the case of 'delete'
74              
75             =cut
76             has 'new_columns', is => 'ro', isa => HashRef, lazy => 1, default => sub {{}};
77              
78             =head2 condition
79              
80             The condition associated with this change, applies to 'update' and 'delete'
81              
82             =cut
83             has 'condition', is => 'ro', isa => Ref, lazy => 1, default => sub {{}};
84              
85             =head2 recorded
86              
87             Boolean flag set to true once the change data has been recorded
88              
89             =cut
90             has 'recorded', is => 'rw', isa => Bool, default => sub{0}, init_arg => undef;
91              
92              
93             =head2 pri_key_value
94              
95             =cut
96             has 'pri_key_value', is => 'ro', isa => Maybe[Str], lazy => 1, default => sub {
97             my $self = shift;
98             $self->enforce_recorded;
99            
100             # TEMP: this is a bridge for converting away from needing Row objects...
101             my $merge_cols = { %{$self->old_columns}, %{$self->new_columns} };
102             return $self->get_pri_key_value($merge_cols);
103            
104             #my $Row = $self->Row || $self->origRow;
105             #return $self->get_pri_key_value($Row);
106             };
107              
108             =head2 orig_pri_key_value
109              
110             =cut
111             has 'orig_pri_key_value', is => 'ro', isa => Maybe[Str], lazy => 1, default => sub {
112             my $self = shift;
113            
114             # TEMP: this is a bridge for converting away from needing Row objects...
115             my $merge_cols = { %{$self->new_columns},%{$self->old_columns} };
116             return $self->get_pri_key_value($merge_cols);
117            
118             #return $self->get_pri_key_value($self->origRow);
119             };
120              
121              
122             =head2 change_ts
123              
124             =cut
125             has 'change_ts', is => 'ro', isa => InstanceOf['DateTime'], lazy => 1, default => sub {
126             my $self = shift;
127             $self->enforce_unrecorded;
128             return $self->get_dt;
129             };
130              
131             =head2 start_timeofday
132              
133             =cut
134             has 'start_timeofday', is => 'ro', default => sub { [gettimeofday] };
135              
136             =head2 change_elapsed
137              
138             =cut
139             has 'change_elapsed', is => 'rw', default => sub{undef};
140              
141             =head2 column_changes
142              
143             =cut
144             has 'column_changes', is => 'ro', isa => HashRef[Object], lazy => 1, default => sub {
145             my $self = shift;
146             $self->enforce_recorded;
147            
148             my $old = $self->old_columns;
149             my $new = $self->new_columns;
150            
151             # This logic is duplicated in DbicLink2. Not sure how to avoid it, though,
152             # and keep a clean API
153             my @changed = ();
154             foreach my $col (uniq(keys %$new,keys %$old)) {
155             next if (!(defined $new->{$col}) and !(defined $old->{$col}));
156             next if (
157             defined $new->{$col} and defined $old->{$col} and
158             $new->{$col} eq $old->{$col}
159             );
160             push @changed, $col;
161             }
162            
163             my %col_context = ();
164             my $class = $self->AuditObj->column_context_class;
165             foreach my $column (@changed) {
166             my $ColumnContext = $class->new(
167             AuditObj => $self->AuditObj,
168             ChangeContext => $self,
169             column_name => $column,
170             old_value => $old->{$column},
171             new_value => $new->{$column},
172             );
173             $col_context{$ColumnContext->column_name} = $ColumnContext;
174             }
175            
176             return \%col_context;
177             };
178              
179             has 'column_datapoint_values', is => 'ro', isa => HashRef, lazy => 1, default => sub {
180             my $self = shift;
181             #my @Contexts = $self->all_column_changes;
182             my @Contexts = values %{$self->column_changes};
183             return { map { $_->column_name => $_->local_datapoint_data } @Contexts };
184             };
185              
186              
187             has 'column_changes_ascii', is => 'ro', isa => Str, lazy => 1, default => sub {
188             my $self = shift;
189             my $table = $self->column_changes_arr_arr_table;
190             return $self->arr_arr_ascii_table($table);
191             };
192              
193             has 'column_changes_json', is => 'ro', isa => Str, lazy => 1, default => sub {
194             my $self = shift;
195             my $table = $self->column_changes_arr_arr_table;
196             require JSON;
197             return JSON::encode_json($table);
198             };
199              
200              
201             has 'column_changes_arr_arr_table', is => 'ro', isa => ArrayRef,
202             lazy => 1, default => sub {
203             my $self = shift;
204             my @cols = $self->get_context_datapoint_names('column');
205            
206             my @col_datapoints = values %{$self->column_datapoint_values};
207            
208             my $table = [\@cols];
209             foreach my $col_data (@col_datapoints) {
210             my @row = map { $col_data->{$_} || undef } @cols;
211             push @$table, \@row;
212             }
213            
214             return $table;
215             };
216              
217              
218              
219             =head1 METHODS
220              
221             =head2 class
222              
223             =head2 ResultSource
224              
225             =head2 source
226              
227             =head2 pri_key_column
228              
229             =head2 pri_key_count
230              
231             =head2 primary_columns
232              
233             =head2 get_pri_key_value
234              
235             =head2 record
236              
237             =head2 action_id
238              
239             =head2 enforce_recorded
240              
241             =head2 enforce_unrecorded
242              
243             =head2 all_column_changes
244              
245             =head2 arr_arr_ascii_table
246              
247             =cut
248 0     0 1 0 sub class { (shift)->SourceContext->class }
249 0     0 1 0 sub ResultSource { (shift)->SourceContext->ResultSource }
250 0     0 1 0 sub source { (shift)->SourceContext->source }
251 0     0 1 0 sub pri_key_column { (shift)->SourceContext->pri_key_column }
252 0     0 1 0 sub pri_key_count { (shift)->SourceContext->pri_key_column }
253 0     0 1 0 sub primary_columns { (shift)->SourceContext->primary_columns }
254 149     149 1 725 sub get_pri_key_value { (shift)->SourceContext->get_pri_key_value(@_) }
255              
256             sub _build_tiedContexts {
257 93     93   969 my $self = shift;
258 93         385 my @Contexts = ( $self->SourceContext );
259 93 50       1524 unshift @Contexts, $self->ChangeSetContext if ($self->ChangeSetContext);
260 93         3596 return \@Contexts;
261             }
262             sub _build_local_datapoint_data {
263 93     93   956 my $self = shift;
264 93         308 $self->enforce_recorded;
265 93         920 return { map { $_->name => $_->get_value($self) } $self->get_context_datapoints('change') };
  347         8921  
266             }
267              
268             sub record {
269 98     98 1 325 my $self = shift;
270 98         200 my $new_columns = shift;
271 98         392 $self->enforce_unrecorded;
272 98         2680 $self->change_ts;
273 98         138902 $self->change_elapsed(sprintf('%.8g',tv_interval($self->start_timeofday)));
274            
275 98 100 66     3392 %{$self->new_columns} = %$new_columns if (
  89         2008  
276             ref($new_columns) eq 'HASH' and
277             scalar(keys %$new_columns) > 0
278             );
279            
280 98         5239 $self->recorded(1);
281             }
282              
283              
284             # action_id exists so collectors can store the action as a shorter id
285             # instead of the full name.
286             sub action_id {
287 3     3 1 7 my $self = shift;
288 3 50       19 my $action = $self->action or return undef;
289 3 50       17 my $id = $self->_action_id_map->{$action} or die "Error looking up action_id";
290 3         9 return $id;
291             }
292              
293             has '_action_id_map', is => 'ro', default => sub {{
294             insert => 1,
295             update => 2,
296             delete => 3
297             }}, isa => HashRef[Int];
298              
299              
300              
301             sub enforce_unrecorded {
302 196     196 1 392 my $self = shift;
303 196 50       4188 die "Error: Audit action already recorded!" if ($self->recorded);
304             }
305              
306             sub enforce_recorded {
307 284     284 1 745 my $self = shift;
308 284 50       4634 die "Error: Audit action not recorded yet!" unless ($self->recorded);
309             }
310              
311 196     196 1 4753 sub all_column_changes { values %{(shift)->column_changes} }
  196         3392  
312              
313             sub arr_arr_ascii_table {
314 3     3 1 7 my $self = shift;
315 3         8 my $table = shift;
316 3 50       13 die "Supplied table is not an arrayref" unless (ref($table) eq 'ARRAY');
317            
318 3         1334 require Text::TabularDisplay;
319 3         2260 require Text::Wrap;
320            
321 3         2770 my $t = Text::TabularDisplay->new;
322            
323 3         49 local $Text::Wrap::columns = 52;
324            
325 3         8 my $header = shift @$table;
326 3 50       13 die "Encounted non-arrayref table row" unless (ref($header) eq 'ARRAY');
327            
328 3         17 $t->add(@$header);
329 3         306 $t->add('');
330            
331 3         108 foreach my $row (@$table) {
332 7 50       676 die "Encounted non-arrayref table row" unless (ref($row) eq 'ARRAY');
333 7         19 $t->add( map { Text::Wrap::wrap('','',$_) } @$row );
  21         1816  
334             }
335            
336 3         526 return $t->render;
337             }
338              
339             1;
340              
341             __END__
342              
343             =head1 SEE ALSO
344              
345             =over
346              
347             =item *
348              
349             L<DBIx::Class::AuditAny>
350              
351             =item *
352              
353             L<DBIx::Class>
354              
355             =back
356              
357             =head1 SUPPORT
358            
359             IRC:
360            
361             Join #rapidapp on irc.perl.org.
362              
363             =head1 AUTHOR
364              
365             Henry Van Styn <vanstyn@cpan.org>
366              
367             =head1 COPYRIGHT AND LICENSE
368              
369             This software is copyright (c) 2012-2015 by IntelliTree Solutions llc.
370              
371             This is free software; you can redistribute it and/or modify it under
372             the same terms as the Perl 5 programming language system itself.
373              
374             =cut