File Coverage

blib/lib/DBIx/Class/AuditAny.pm
Criterion Covered Total %
statement 242 295 82.0
branch 68 126 53.9
condition 13 49 26.5
subroutine 39 64 60.9
pod 18 19 94.7
total 380 553 68.7


line stmt bran cond sub pod time code
1             package DBIx::Class::AuditAny;
2 13     13   6363816 use strict;
  13         23  
  13         374  
3 13     13   60 use warnings;
  13         20  
  13         531  
4              
5             # ABSTRACT: Flexible change tracking framework for DBIx::Class
6              
7             our $VERSION = '0.200100';
8              
9 13     13   281 use 5.010;
  13         42  
10              
11 13     13   1270 use Moo;
  13         25275  
  13         100  
12 13     13   25209 use MooX::Types::MooseLike::Base 0.19 qw(:all);
  13         58310  
  13         3821  
13              
14 13     13   2487 use Class::MOP;
  13         380059  
  13         479  
15 13     13   77 use Class::MOP::Class;
  13         17  
  13         400  
16 13     13   10075 use DateTime;
  13         4203454  
  13         654  
17 13     13   7965 use DBIx::Class::AuditAny::Util;
  13         42  
  13         1118  
18 13     13   5884 use DBIx::Class::AuditAny::Util::BuiltinDatapoints;
  13         28  
  13         375  
19 13     13   4832 use DBIx::Class::AuditAny::Role::Schema;
  13         34  
  13         456  
20              
21 13     13   80 use Term::ANSIColor qw(:constants);
  13         16  
  13         44720  
22              
23             has 'time_zone', is => 'ro', isa => Str, default => sub{'local'};
24 196     196 1 1406 sub get_dt { DateTime->now( time_zone => (shift)->time_zone ) }
25              
26             has 'schema', is => 'ro', required => 1, isa => InstanceOf['DBIx::Class::Schema']; #<--- This won't go back to Moose
27             has 'track_immutable', is => 'ro', isa => Bool, default => sub{0};
28             has 'track_actions', is => 'ro', isa => ArrayRef, default => sub { [qw(insert update delete)] };
29             has 'allow_multiple_auditors', is => 'ro', isa => Bool, default => sub{0};
30              
31             has 'source_context_class', is => 'ro', default => sub{'AuditContext::Source'};
32             has 'change_context_class', is => 'ro', default => sub{'AuditContext::Change'};
33             has 'changeset_context_class', is => 'ro', default => sub{'AuditContext::ChangeSet'};
34             has 'column_context_class', is => 'ro', default => sub{'AuditContext::Column'};
35             has 'default_datapoint_class', is => 'ro', default => sub{'DataPoint'};
36             has 'collector_class', is => 'ro', isa => Str;
37              
38             around $_ => sub {
39             my $orig = shift; my $self = shift;
40             resolve_localclass $self->$orig(@_);
41             } for qw(
42             source_context_class change_context_class
43             changeset_context_class column_context_class
44             default_datapoint_class collector_class
45             );
46              
47             has 'collector_params', is => 'ro', isa => HashRef, default => sub {{}};
48             has 'primary_key_separator', is => 'ro', isa => Str, default => sub{'|~|'};
49             has 'datapoint_configs', is => 'ro', isa => ArrayRef[HashRef], default => sub {[]};
50             has 'auto_include_user_defined_datapoints', is => 'ro', isa => Bool, default => sub{1};
51             has 'rename_datapoints', is => 'ro', isa => Maybe[HashRef[Str]], default => sub{undef};
52             has 'disable_datapoints', is => 'ro', isa => ArrayRef, default => sub {[]};
53             has 'record_empty_changes', is => 'ro', isa => Bool, default => sub{0};
54              
55             has 'datapoints', is => 'ro', isa => ArrayRef[Str],
56             default => sub{[qw(
57             change_ts
58             action
59             source
60             pri_key_value
61             column_name
62             old_value
63             new_value
64             )]};
65              
66             has 'collector', is => 'ro', lazy => 1, default => sub {
67             my $self = shift;
68             return ($self->collector_class)->new(
69             %{$self->collector_params},
70             AuditObj => $self
71             );
72             };
73              
74             # Any sources within the tracked schema that the collector is writing to; these
75             # sources are not allowed to be tracked because it would create infinite recursion:
76             has 'log_sources', is => 'ro', isa => ArrayRef[Str], lazy => 1, init_arg => undef, default => sub {
77             my $self = shift;
78             return $self->collector->writes_bound_schema_sources;
79             };
80              
81             has 'tracked_action_functions', is => 'ro', isa => HashRef, default => sub {{}};
82             has 'tracked_sources', is => 'ro', isa => HashRef[Str], default => sub {{}};
83             has 'calling_action_function', is => 'ro', isa => HashRef[Bool], default => sub {{}};
84             has 'active_changeset', is => 'rw', isa => Maybe[Object], default => sub{undef};
85             has 'auto_finish', is => 'rw', isa => Bool, default => sub{0};
86              
87             has 'track_init_args', is => 'ro', isa => Maybe[HashRef], default => sub{undef};
88             has 'build_init_args', is => 'ro', isa => HashRef, required => 1;
89              
90             around BUILDARGS => sub {
91             my $orig = shift;
92             my $class = shift;
93             my %opts = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref
94              
95             die 'Cannot specify build_init_args in new()' if (exists $opts{build_init_args});
96             $opts{build_init_args} = { %opts };
97             return $class->$orig(%opts);
98             };
99              
100             sub track {
101 14     14 1 1935909 my $class = shift;
102 14 50       92 my %opts = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref
  0         0  
103 14 50       57 die "track cannot be called on object instances" if (ref $class);
104            
105             # Record the track init arguments:
106 14         57 $opts{track_init_args} = { %opts };
107            
108 14 50       53 my $sources = exists $opts{track_sources} ? delete $opts{track_sources} : undef;
109 14 50 33     82 die 'track_sources must be an arrayref' if ($sources and ! ref($sources) eq 'ARRAY');
110 14 50       55 my $track_all = exists $opts{track_all_sources} ? delete $opts{track_all_sources} : undef;
111 14 50 33     62 die "track_sources and track_all_sources are incompatible" if ($sources && $track_all);
112            
113 14 50       40 my $init_sources = exists $opts{init_sources} ? delete $opts{init_sources} : undef;
114 14 50 33     48 die 'init_sources must be an arrayref' if ($init_sources and ! ref($init_sources) eq 'ARRAY');
115 14 50       40 my $init_all = exists $opts{init_all_sources} ? delete $opts{init_all_sources} : undef;
116 14 50 33     46 die "init_sources and init_all_sources are incompatible" if ($init_sources && $init_all);
117            
118 14 100       77 my $collect = exists $opts{collect} ? delete $opts{collect} : undef;
119 14 100       41 if ($collect) {
120             die "'collect' cannot be used with 'collector_params', 'collector_class' or 'collector'"
121 2 50 33     12 if ($opts{collector_params} || $opts{collector_class} || $opts{collector});
      33        
122            
123 2         3 $opts{collector_class} = 'Collector::Code';
124 2         5 $opts{collector_params} = { collect_coderef => $collect };
125             }
126            
127 14 50       47 if($opts{collector}) {
128             die "'collector' cannot be used with 'collector_params', 'collector_class' or 'collect'"
129 0 0 0     0 if ($opts{collector_params} || $opts{collector_class} || $opts{collect});
      0        
130             }
131            
132 14         89 my $self = $class->new(%opts);
133            
134 14 50       3421 $self->track_sources(@$sources) if ($sources);
135 14 50       87 $self->track_all_sources if ($track_all);
136            
137 14 50       70 $self->init_sources(@$init_sources) if ($init_sources);
138 14 50       53 $self->init_all_sources if ($init_all);
139 14         145 return $self;
140             }
141              
142              
143             sub _get_datapoint_configs {
144 14     14   22 my $self = shift;
145            
146 14         159 my @configs = DBIx::Class::AuditAny::Util::BuiltinDatapoints->all_configs;
147            
148             # strip out any being redefined:
149 14         35 my %cust = map {$_->{name}=>1} @{$self->datapoint_configs};
  4         12  
  14         84  
150 14         30 @configs = grep { !$cust{$_->{name}} } @configs;
  308         314  
151            
152             # Set flag to mark the configs that were user defined
153 14         25 $_->{user_defined} = 1 for (@{$self->datapoint_configs});
  14         60  
154            
155 14         31 push @configs, @{$self->datapoint_configs};
  14         40  
156            
157 14         55 return @configs;
158             }
159              
160             has '_datapoints', is => 'ro', isa => HashRef, default => sub {{}};
161             has '_datapoints_context', is => 'ro', isa => HashRef, default => sub {{}};
162              
163             # Also index datapoints by 'original_name' which will be different from 'name'
164             # whenever 'rename_datapoints' has been applied
165             has '_datapoints_orig_names', is => 'ro', isa => HashRef, default => sub {{}};
166 10     10 1 86 sub get_datapoint_orig { (shift)->_datapoints_orig_names->{(shift)} }
167              
168             sub add_datapoints {
169 143     143 1 139 my $self = shift;
170 143         2457 my $class = $self->default_datapoint_class;
171 143         260 foreach my $cnf (@_) {
172 143 50       284 die "'$cnf' not expected ref" unless (ref $cnf);
173 143 50       335 $class = delete $cnf->{class} if ($cnf->{class});
174 143 50       2261 my $DataPoint = ref($cnf) eq $class ? $cnf : $class->new($cnf);
175 143 50       3905 die "Error creating datapoint object" unless (ref($DataPoint) eq $class);
176 143 50       575 die "Duplicate datapoint name '" . $DataPoint->name . "'" if ($self->_datapoints->{$DataPoint->name});
177 143         297 $self->_datapoints->{$DataPoint->name} = $DataPoint;
178 143         397 $self->_datapoints_context->{$DataPoint->context}->{$DataPoint->name} = $DataPoint;
179 143         2046 $self->_datapoints_orig_names->{$DataPoint->original_name} = $DataPoint;
180             }
181             }
182 0     0 1 0 sub all_datapoints { values %{(shift)->_datapoints} }
  0         0  
183              
184             sub get_context_datapoints {
185 468     468 1 493 my $self = shift;
186 468         536 my @contexts = grep { exists $self->_datapoints_context->{$_} } @_;
  512         1675  
187 468         653 return map { values %{$self->_datapoints_context->{$_}} } @contexts;
  484         374  
  484         1919  
188             }
189              
190             sub get_context_datapoint_names {
191 3     3 1 3 my $self = shift;
192 3         7 return map { $_->name } $self->get_context_datapoints(@_);
  9         22  
193             }
194              
195              
196 96     96 1 1867 sub local_datapoint_data { (shift)->base_datapoint_values }
197             has 'base_datapoint_values', is => 'ro', isa => HashRef, lazy => 1, default => sub {
198             my $self = shift;
199             return { map { $_->name => $_->get_value($self) } $self->get_context_datapoints('base') };
200             };
201              
202             sub _init_datapoints {
203 14     14   31 my $self = shift;
204            
205 14         70 my @configs = $self->_get_datapoint_configs;
206            
207 14 100       88 if($self->rename_datapoints) {
208 7         18 my $rename = $self->rename_datapoints;
209            
210 7 100       14 @{$self->datapoints} = map { $rename->{$_} || $_ } @{$self->datapoints};
  7         37  
  75         181  
  7         28  
211            
212 7         24 foreach my $cnf (@configs) {
213 158 100       274 next unless (exists $rename->{$cnf->{name}});
214 42         39 $cnf->{original_name} = $cnf->{name};
215 42         53 $cnf->{name} = $rename->{$cnf->{name}};
216             }
217             }
218            
219 14         36 my %seen = ();
220 14   50     22 $seen{$_}++ and die "Duplicate datapoint name '$_'" for (@{$self->datapoints});
  14         272  
221            
222 14         27 my %disable = map {$_=>1} @{$self->disable_datapoints};
  0         0  
  14         72  
223 14         79 my %activ = map {$_=>1} grep { !$disable{$_} } @{$self->datapoints};
  139         182  
  139         144  
  14         42  
224            
225 14 50       86 if($self->auto_include_user_defined_datapoints) {
226 14 50       28 $activ{$_->{name}} = 1 for(grep { $_->{name} && $_->{user_defined} } @configs);
  312         471  
227             }
228            
229 14         31 foreach my $cnf (@configs) {
230             # Do this just to throw the exception for no name:
231 312 50       3126 $self->add_datapoints($cnf) unless ($cnf->{name});
232            
233 312 100       568 next unless $activ{$cnf->{name}};
234 143         212 delete $activ{$cnf->{name}};
235 143         665 $self->add_datapoints({%$cnf, AuditObj => $self});
236             }
237            
238 14 50       684 die "Unknown datapoint(s) specified (" . join(',',keys %activ) . ')'
239             if (scalar(keys %activ) > 0);
240             }
241              
242              
243             sub BUILD {
244 14     14 0 567 my $self = shift;
245            
246             # init all classes first:
247 14         553 $self->change_context_class;
248 14         373 $self->changeset_context_class;
249 14         351 $self->source_context_class;
250 14         354 $self->column_context_class;
251 14         369 $self->default_datapoint_class;
252            
253 14         70 $self->_init_datapoints;
254 14         59 $self->_bind_schema;
255            
256             # init collector object:
257 14         276 $self->collector;
258             }
259              
260              
261             sub _init_apply_schema_class {
262 14     14   23 my $self = shift;
263 14 50       84 die "schema is not a reference" unless (ref $self->schema);
264            
265             Moo::Role->apply_roles_to_object($self->schema,'DBIx::Class::AuditAny::Role::Schema')
266 14 50   14   126 unless try{$self->schema->does('DBIx::Class::AuditAny::Role::Schema')};
  14         693  
267            
268             # Important!
269 14         38793 $self->schema->_apply_storage_role;
270             }
271              
272              
273              
274              
275              
276             sub _bind_schema {
277 14     14   31 my $self = shift;
278 14         54 $self->_init_apply_schema_class;
279            
280 14 50 33     69736 die "Supplied Schema instance already has a bound Auditor - to allow multple " .
281             "Auditors, set 'allow_multiple_auditors' to true"
282             if($self->schema->auditor_count > 0 and ! $self->allow_multiple_auditors);
283            
284 14   50     144 $_ == $self and return for($self->schema->auditors);
285            
286 14         596 return $self->schema->add_auditor($self);
287             }
288              
289              
290              
291              
292             sub track_sources {
293 14     14 1 49 my ($self,@sources) = @_;
294            
295 14         35 foreach my $name (@sources) {
296 92 50       375 my $Source = $self->schema->source($name) or die "Bad Result Source name '$name'";
297            
298 92         4587 my $class = $self->source_context_class;
299 92         1402 my $AuditSourceContext = $class->new(
300             AuditObj => $self,
301             ResultSource => $Source
302             );
303            
304 92         33108 my $source_name = $AuditSourceContext->source;
305            
306 92         105 my %log_sources = map {$_=>1} @{$self->log_sources};
  9         27  
  92         1191  
307             die "The Log Source (" . $source_name . ") cannot track itself!!"
308 92 50       556 if ($log_sources{$source_name});
309              
310             # Skip sources we've already setup:
311 92 50       243 return if ($self->tracked_sources->{$source_name});
312            
313 92         180 $self->_add_row_trackers_methods($AuditSourceContext);
314 92         420 $self->tracked_sources->{$source_name} = $AuditSourceContext;
315             }
316             }
317              
318             sub track_all_sources {
319 14     14 1 30 my ($self,@exclude) = @_;
320             #$class->_init;
321            
322 14         24 push @exclude, @{$self->log_sources};
  14         243  
323            
324 14         1585 my %excl = map {$_=>1} @exclude;
  3         6  
325 14         334 return $self->track_sources(grep { !$excl{$_} } $self->schema->sources);
  95         730  
326             }
327              
328             # This is the original, Row-based solution for initializing existing data. This
329             # is going to be refactored and replaced, but with what has not been decided yet
330             # See also _add_additional_row_methods() below
331             sub init_sources {
332 0     0 1 0 my ($self,@sources) = @_;
333            
334             $self->schema->txn_do(sub {
335            
336 0     0   0 foreach my $name (@sources) {
337 0 0       0 my $SourceContext = $self->tracked_sources->{$name}
338             or die "Source '$name' is not being tracked";
339            
340 0         0 print STDERR "\n";
341            
342 0         0 my $msg = "Initializing Audit Records for $name: ";
343 0         0 print STDERR $msg . "\r";
344            
345 0         0 my $Rs = $SourceContext->ResultSource->resultset;
346 0         0 my $total = $Rs->count;
347 0         0 my $count = 0;
348 0         0 foreach my $Row ($Rs->all) {
349 0         0 print STDERR $msg . ++$count . '/' . $total . "\r";
350 0         0 $Row->audit_init($self);
351             }
352             }
353            
354 0         0 print STDERR "\n\n";
355 0         0 });
356             }
357              
358             sub init_all_sources {
359 0     0 1 0 my $self = shift;
360 0         0 $self->init_sources(keys %{$self->tracked_sources});
  0         0  
361             }
362              
363              
364             our $NESTED_CALL = 0;
365             sub _add_row_trackers_methods {
366 92     92   92 my $self = shift;
367 92         100 my $AuditSourceContext = shift;
368            
369 92         1147 my $source_name = $AuditSourceContext->source;
370 92         626 my $result_class = $self->schema->class($source_name);
371            
372 92         5105 foreach my $action (@{$self->track_actions}) {
  92         243  
373 276         329 my $func_name = $source_name . '::' . $action;
374 276 50       831 return if $self->tracked_action_functions->{$func_name}++;
375             }
376            
377 92         180 $self->_add_additional_row_methods($result_class);
378             }
379              
380              
381              
382             # TODO/FIXME: This needs to be refactored to use a cleaner API. Probably
383             # totally different (this code is leftover from before the switch to the
384             # Storage Role API)
385             sub _add_additional_row_methods {
386 92     92   96 my $self = shift;
387 92         79 my $result_class = shift;
388            
389 92         390 my $meta = Class::MOP::Class->initialize($result_class);
390 92         30417 my $immutable = $meta->is_immutable;
391            
392 92 50 33     328 die "Won't add tracker/modifier method to immutable Result Class '$result_class' " .
393             '(hint: did you forget to remove __PACKAGE__->meta->make_immutable ??)' .
394             ' - to force/override, set "track_immutable" to true.'
395             if ($immutable && !$self->track_immutable);
396            
397             # Tempory turn mutable back on, saving any immutable_options, first:
398 92         112 my %immut_opts = ();
399 92 50       182 if($immutable) {
400 0         0 %immut_opts = $meta->immutable_options;
401 0         0 $meta->make_mutable;
402             }
403            
404 92 100       412 return if ($meta->has_method('audit_take_snapshot'));
405            
406             $meta->add_method( audit_take_snapshot => sub {
407 0     0   0 my $Row = shift;
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
408 0 0       0 my $AuditObj = shift or die "AuditObj not supplied in argument.";
409            
410 0   0     0 my $Auditors = $Row->result_source->schema->auditors || [];
411 0         0 my $found = 0;
412 0   0     0 $_ == $AuditObj and $found = 1 for (@$Auditors);
413 0 0       0 die "Supplied AuditObj is not an active Auditor on this Row's schema instance"
414             unless ($found);
415            
416 0         0 my $source_name = $Row->result_source->source_name;
417 0 0       0 my $SourceContext = $AuditObj->tracked_sources->{$source_name}
418             or die "Source '$source_name' is not being tracked by the supplied Auditor";
419            
420 0 0       0 unless ($AuditObj->active_changeset) {
421 0         0 $AuditObj->start_changeset;
422 0         0 $AuditObj->auto_finish(1);
423             }
424            
425 0         0 my $class = $AuditObj->change_context_class;
426 0         0 my $ChangeContext = $class->new(
427             AuditObj => $AuditObj,
428             SourceContext => $SourceContext,
429             ChangeSetContext => $AuditObj->active_changeset,
430             Row => $Row,
431             new_columns => { $Row->get_columns },
432             action => 'select'
433             );
434 0         0 $ChangeContext->record;
435 0         0 $AuditObj->record_changes($ChangeContext);
436 0         0 return $Row;
437 89         3950 });
438            
439             $meta->add_method( audit_init => sub {
440 0     0   0 my $Row = shift;
        0      
        0      
        0      
        0      
        0      
        0      
441 0 0       0 my $AuditObj = shift or die "AuditObj not supplied in argument.";
442            
443 0   0     0 my $Auditors = $Row->result_source->schema->auditors || [];
444 0         0 my $found = 0;
445 0   0     0 $_ == $AuditObj and $found = 1 for (@$Auditors);
446 0 0       0 die "Supplied AuditObj is not an active Auditor on this Row's schema instance"
447             unless ($found);
448            
449 0         0 my $Collector = $AuditObj->collector;
450 0 0       0 return $Row->audit_take_snapshot($AuditObj) unless ($Collector->has_full_row_stored($Row));
451 0         0 return $Row;
452 89         3238 });
453            
454             # Restore immutability to the way to was:
455 89 50       2251 $meta->make_immutable(%immut_opts) if ($immutable);
456             }
457              
458              
459             ##########
460             ##########
461              
462             # Starts a new changeset if there isn't one active:
463             sub start_unless_changeset {
464 135     135 1 580 my $self = shift;
465 135 100       1989 return $self->active_changeset ? undef : $self->start_changeset;
466             }
467              
468             sub start_changeset {
469 47     47 1 358 my $self = shift;
470 47 50       663 die "Cannot start_changeset because a changeset is already active" if ($self->active_changeset);
471            
472 47         1038 my $class = $self->changeset_context_class;
473 47         1037 $self->active_changeset($class->new( AuditObj => $self ));
474 47         51937 return $self->active_changeset;
475             }
476              
477             sub finish_if_changeset {
478 27     27 1 256 my $self = shift;
479 27 100       397 return $self->active_changeset ? $self->finish_changeset : undef;
480             }
481              
482             has '_finishing_changeset', is => 'rw', isa => Bool, default => sub{0};
483             sub finish_changeset {
484 48     48 1 237 my $self = shift;
485 48 50       736 die "Cannot finish_changeset because there isn't one active" unless ($self->active_changeset);
486            
487             # Protect against deep recursion. This is needed for cases where the collector
488             # is writing to tables within the tracked schema
489 48 100       1067 return if ($self->_finishing_changeset);
490 47         941 $self->_finishing_changeset(1);
491            
492 47 50       1900 unless($self->record_empty_changes) {
493 47         76 my $count_cols = 0;
494             $count_cols = $count_cols + scalar($_->all_column_changes)
495 47         71 for (@{$self->active_changeset->changes});
  47         675  
496 47 100       2704 unless ($count_cols > 0) {
497 2         6 $self->clear_changeset;
498 2         123 return 1;
499             }
500             }
501            
502 45         727 $self->active_changeset->finish;
503            
504             #####
505 45         2309 $self->collector->record_changes($self->active_changeset);
506             #####
507            
508 45         1359202 $self->clear_changeset;
509 45         2233 return 1;
510             }
511              
512             sub _exception_cleanup {
513 0     0   0 my $self = shift;
514 0         0 my $err = shift;
515 0         0 $self->clear_changeset;
516 0         0 $self->_current_change_group([]);
517             }
518              
519             sub clear_changeset {
520 47     47 1 4833 my $self = shift;
521 47         1961 $self->active_changeset(undef);
522 47         4156 $self->auto_finish(0);
523 47         2785 $self->_finishing_changeset(0);
524             }
525              
526             sub record_changes {
527 89     89 1 682 my ($self, @ChangeContexts) = @_;
528            
529 89         223 my $local_changeset = $self->start_unless_changeset;
530            
531 89         1415 $self->active_changeset->add_changes($_) for (@ChangeContexts);
532            
533 89 100       271 $self->finish_changeset if ($local_changeset);
534             }
535              
536              
537             ## Change 'group' vs Change 'set'
538             #
539             # I am using the term 'group' (to distinguish from 'set') to represent a group
540             # of changes (rows) that are being changed within a single query/sql statement.
541             # (vs. set which is any number of query/sql statements grouped in a transaction)
542             # This should only happen from making changes via ResultSet objects instead of
543             # Row objects, and in these cases we normalize these into individual (row) changes
544             # TODO: should ChangeGroup be made into a 6th Context? For now, I think no because
545             # it is overkill.
546             ##
547              
548             # -- This is a glorified tmp variable used just to allow groups of changes
549             # to be associated with the correct auditor. TODO: This is probably a
550             # poor solution to a complex scoping problem. This exposes us to the
551             # risk of processing stale data, so we have to be sure (manually) to keep
552             # this clear/empty outside its *very* short lifespan, by regularly resetting it
553             has '_current_change_group', is => 'rw', isa => ArrayRef[Object], default => sub{[]};
554             # --
555              
556             sub _start_current_change_group {
557 96     96   226 my ($self, $Source, $nested, $action, @changes) = @_;
558            
559 96   50     1492 my $Group = $self->_current_change_group || [];
560 96 100       685 $Group = [] unless ($nested);
561            
562 96         1322 $self->_current_change_group($Group); # just for good measure
563            
564 96         4716 my $source_name = $Source->source_name;
565 96         226 my $func_name = $source_name . '::' . $action;
566            
567 96 100       470 return () unless ($self->tracked_action_functions->{$func_name});
568            
569             my @ChangeContexts = map {
570 83         145 $self->_new_change_context(
571             AuditObj => $self,
572 94         1973 SourceContext => $self->tracked_sources->{$source_name},
573             ChangeSetContext => $self->active_changeset, # could be undef
574             action => $action,
575             $self->_validated_change_hash($_)
576             )
577             } @changes;
578            
579 83         2505 push @$Group, @ChangeContexts;
580 83         1215 $self->_current_change_group($Group);
581 83         4298 return @ChangeContexts;
582             }
583              
584             sub _validated_change_hash {
585 94     94   501 my ($self, $data) = @_;
586            
587 94         7854 require Data::Dumper::Concise;
588            
589 94 50       3929 die "change data must be a HashRef:\n" .
590             Data::Dumper::Concise::Dumper($data) unless (ref($data) eq 'HASH');
591            
592 94         175 my %allowed_keys = map {$_=>1} qw(old_columns to_columns new_columns);
  282         540  
593            
594             $allowed_keys{$_} && ref($data->{$_}) eq 'HASH' or
595             die "Bad data in change hash:\n" . Data::Dumper::Concise::Dumper($data)
596 94   33     292 for (grep { $_ ne 'condition' } keys %$data);
  159   50     949  
597              
598 94         391 return %$data;
599             }
600              
601              
602             sub _finish_current_change_group {
603 89     89   927 my $self = shift;
604 89 50       112 $self->record_changes(@{$self->_current_change_group || []});
  89         1302  
605 89         1385 $self->_current_change_group([]); #<-- critical to reset!
606             }
607              
608             # factory-like helper:
609             sub _new_change_context {
610 94     94   149 my $self = shift;
611 94         1808 my $class = $self->change_context_class;
612 94         1852 return $class->new(@_);
613             }
614              
615              
616              
617             1;
618              
619              
620             __END__
621              
622             =head1 NAME
623              
624             DBIx::Class::AuditAny - Flexible change tracking framework for L<DBIx::Class>
625              
626             =begin HTML
627              
628             <a href='https://coveralls.io/r/vanstyn/DBIx-Class-AuditAny?branch=master'>
629             <img
630             src='https://coveralls.io/repos/vanstyn/DBIx-Class-AuditAny/badge.svg?branch=master'
631             alt='Coverage Status'
632             />
633             </a>
634              
635             =end HTML
636              
637             =head1 SYNOPSIS
638              
639             my $schema = My::Schema->connect(@connect);
640              
641             use DBIx::Class::AuditAny;
642              
643             my $Auditor = DBIx::Class::AuditAny->track(
644             schema => $schema,
645             track_all_sources => 1,
646             collector_class => 'Collector::AutoDBIC',
647             collector_params => {
648             sqlite_db => 'db/audit.db',
649             }
650             );
651              
652             =head1 DESCRIPTION
653              
654             This module provides a generalized way to track changes to DBIC databases. The aim is
655             to provide quick/turn-key options to be able to hit the ground running, while also
656             being highly flexible and customizable with sane APIs.
657              
658             C<DBIx::Class::AuditAny> wants to be a general framework on top of which other Change
659             Tracking modules for DBIC can be written, while also providing fully fleshed, end-user
660             solutions that can be dropped in and work out-of-the-box.
661              
662             =head2 Background
663              
664             This module was originally written in 2012 for an internal client project, and the process
665             of getting it released open-source as a stand-alone, general-purpose module was started in
666             2013. However, I got busy with other projects and wasn't able to complete a CPAN release at
667             that time (mainly due to missing docs and minor loose ends). I finally came back to this
668             project (May 2015) to actually get a release out to CPAN. So, even though the release date
669             is in 2015, the majority of the code is actually several years old (and has been running
670             perfectly in production for several client apps the whole time).
671              
672              
673             =head2 API and Usage
674              
675             AuditAny uses a different API than typical DBIC components. Instead of loading at the
676             schema/result class level with C<load_components>, AuditAny is used by attaching an
677             "Auditor" to an existing schema I<object> instance:
678              
679             my $schema = My::Schema->connect(@connect);
680            
681             my $Auditor = DBIx::Class::AuditAny->track(
682             schema => $schema,
683             track_all_sources => 1,
684             collector_class => 'Collector::AutoDBIC',
685             collector_params => {
686             sqlite_db => 'db/audit.db',
687             }
688             );
689              
690             The rationale of this approach is that change tracking isn't necessarily something that
691             needs to be, or should be, defined as a built-in attribute of the schema class.
692             Additionally, because of the object-based approach, it is possible to attach multiple
693             Auditors to a single schema object with multiple calls to DBIx::Class::AuditAny->track.
694              
695             =head1 DATAPOINTS
696              
697             As changes occur in the tracked schema, information is collected in the form of
698             I<datapoints> at various stages - or I<contexts> - before being passed to the
699             configured Collector. A datapoint has a globally unique name and code used to calculate
700             its value. Code is called at the stage defined by the I<context> of the datapoint.
701             The available contexts are:
702              
703             =over 4
704              
705             =item set
706              
707             =over 5
708              
709             =item base
710              
711             =back
712              
713             =item change
714              
715             =over 5
716              
717             =item source
718              
719             =back
720              
721             =item column
722              
723              
724             =back
725              
726             B<set> (AKA changeset) datapoints are specific to an entire set of changes - insert/
727             update/delete statements grouped in a transaction. Example changeset datapoints include
728             C<changeset_ts> and other broad items. B<base> datapoints are logically the same as
729             B<set> but only need to be calculated once (instead of with every change set). These
730             include things like C<schema> and C<schema_ver>.
731              
732             B<change> datapoints apply to a specific C<insert>, C<update> or C<delete> statement,
733             and range from simple items such as C<action> (one of 'insert', 'update' or 'delete')
734             to more exotic and complex items like C<column_changes_json>. B<source> datapoints are
735             logically the same as B<change>, but like B<base> datapoints, only need to be
736             calculated once (per source). These include things like C<table_name> and C<source>
737             (source name).
738              
739             Finally, B<column> datapoints cover information specific to an individual column, such
740             as C<column_name>, C<old_value> and C<new_value>.
741              
742             There are a number of built-in datapoints (currently stored in
743             L<DBIx::Class::AuditAny::Util::BuiltinDatapoints> which is likely to change), but custom
744             datapoints can also be defined. The Auditor config defines a specific set of datapoints to
745             be calculated (built-in and/or custom). If no datapoints are specified, the default list is used
746             (currently C<change_ts, action, source, pri_key_value, column_name, old_value, new_value>).
747              
748             The list of datapoints is specified as an ArrayRef in the config. For example:
749              
750             datapoints => [qw(action_id column_name new_value)],
751              
752             =head2 Custom Datapoints
753              
754             Custom datapoints are specified as HashRef configs with 3 parameters:
755              
756             =over 4
757              
758             =item name
759              
760             The unique name of the datapoint. Should be all lowercase letters, numbers and
761             underscore and must be different from all other datapoints (across all contexts).
762              
763             =item context
764              
765             The context of the datapoint: base, source, set, change or column.
766              
767             =item method
768              
769             CodeRef to calculate and return the value. The CodeRef is called according to the
770             context, and a different context object is supplied for each context. Each context has
771             its own context object type except B<base> which is supplied the Auditor object itself.
772             See Audit Context Objects below.
773              
774             =back
775              
776              
777             Custom datapoints are defined in the C<datapoint_configs> param. After defining a new
778             datapoint config it can then be used like any other datapoint. For example:
779              
780             datapoints => [qw(action_id column_name new_value client_ip)],
781             datapoint_configs => [
782             {
783             name => 'client_ip',
784             context => 'set',
785             method => sub {
786             my $contextObj = shift;
787             my $c = some_func(...);
788             return $c->req->address;
789             }
790             }
791             ]
792              
793             =head2 Datapoint Names
794              
795             Datapoint names must be unique, which means all the built-in datapoint names are
796             reserved. However, if you really want to use an existing datapoint name, or if you want
797             a built-in datapoint to use a different name, you can rename any datapoints like so:
798              
799             rename_datapoints => {
800             new_value => 'new',
801             old_value => 'old',
802             column_name => 'column',
803             },
804              
805             =head1 COLLECTORS
806              
807             Once the Auditor calculates the configured datapoints it passes them to the configured
808             I<Collector>. There are several built-in Collectors provided, but writing a custom Collector
809             is a trivial matter. All you need to do is write a L<Moo>-compatible class which consumes
810             the L<DBIx::Class::AuditAny::Role::Collector> role and implement a C<record_changes()> method.
811             This method is called with a L<ChangeSet|DBIx::Class::AuditAny::AuditContext::ChangeSet> object
812             supplied as the argument at the end of every database transaction which performs a write operation.
813              
814             No matter how small or large the transaction, the ChangeSet object provides APIs to a nested
815             structure to be able to access all information regarding what changed during the given transaction.
816             (See L<AUDIT CONTEXT OBJECTS|DBIx::Class::AuditAny#AUDIT_CONTEXT_OBJECTS> below).
817              
818              
819             =head2 Supplied Collector Classes
820              
821             The following built-in collector classes are already provided:
822              
823             =over
824              
825             =item *
826              
827             L<DBIx::Class::AuditAny::Collector::AutoDBIC>
828              
829             =item *
830              
831             L<DBIx::Class::AuditAny::Collector::DBIC>
832              
833             =item *
834              
835             L<DBIx::Class::AuditAny::Collector::Code>
836              
837             =back
838              
839             =head1 AUDIT CONTEXT OBJECTS
840              
841             Inspired in part by the Catalyst Context object design, the internal machinery which captures and
842             organizes the change datapoints associated with a modifying transaction is wrapped in a nested
843             structure of 3 kinds of "context" objects:
844              
845             =over
846              
847             =item *
848              
849             L<DBIx::Class::AuditAny::AuditContext::ChangeSet>
850              
851             =item *
852              
853             L<DBIx::Class::AuditAny::AuditContext::Change>
854              
855             =item *
856              
857             L<DBIx::Class::AuditAny::AuditContext::Column>
858              
859             =back
860              
861             This provides a clean and straightforward API for which Collector classes are able to identify and
862             act on the data in any manner they want, be it recording to a database, logging to a simple file,
863             or taking any kind of programmatic action. Collectors can really be thought of as a structure for
864             powerful external triggers.
865              
866             =head1 ATTRIBUTES
867              
868             Note: Documentation of all the individual attrs and methods of this class (shown below) is still
869             TBD. However, most meaningful scenarios involving interacting with these is already covered above,
870             or is covered further down in the L<Examples|DBIx::Class::AuditAny#EXAMPLES>.
871              
872             =head2 datapoints
873              
874             =head2 allow_multiple_auditors
875              
876             =head2 auto_include_user_defined_datapoints
877              
878             =head2 build_init_args
879              
880             =head2 calling_action_function
881              
882             =head2 change_context_class
883              
884             =head2 changeset_context_class
885              
886             =head2 collector_class
887              
888             =head2 collector_params
889              
890             =head2 column_context_class
891              
892             =head2 datapoint_configs
893              
894             =head2 default_datapoint_class
895              
896             =head2 disable_datapoints
897              
898             =head2 primary_key_separator
899              
900             =head2 record_empty_changes
901              
902             =head2 rename_datapoints
903              
904             =head2 schema
905              
906             =head2 source_context_class
907              
908             =head2 time_zone
909              
910             =head2 track_actions
911              
912             =head2 track_immutable
913              
914             =head2 track_init_args
915              
916             =head2 tracked_action_functions
917              
918             =head2 tracked_sources
919              
920             =head1 METHODS
921              
922             =head2 get_dt
923              
924             =head2 track
925              
926             =head2 get_datapoint_orig
927              
928             =head2 add_datapoints
929              
930             =head2 all_datapoints
931              
932             =head2 get_context_datapoint_names
933              
934             =head2 get_context_datapoints
935              
936             =head2 local_datapoint_data
937              
938             =head2 track_sources
939              
940             =head2 track_all_sources
941              
942             =head2 init_all_sources
943              
944             Calls C<init_sources> with all tracked source names
945              
946             =head2 init_sources
947              
948             Special-purpose method to initialize rows for the case of starting auditing a database with
949             existing data. This will simulate changes with the special C<'select'> action. This is useful
950             to be able to use the audit database to follow changes backward to a starting point, and having
951             that state fully recorded, just as if auditing had been enabled when the rows were inserted.
952              
953             This method accepts a list of source names and makes sure that every row of each source is
954             initialized. So, be careful, as this can be a very heavy operation depending on the number
955             of rows. This is a tool that would generally only be used interactively during a new setup.
956              
957             =head2 start_unless_changeset
958              
959             =head2 start_changeset
960              
961             =head2 finish_changeset
962              
963             =head2 finish_if_changeset
964              
965             =head2 clear_changeset
966              
967             =head2 record_changes
968              
969              
970             =head1 EXAMPLES
971              
972             =head3 simple dedicated audit db
973              
974             Record all changes into a *separate*, auto-generated and initialized SQLite schema/db
975             with default datapoints (Quickest/simplest usage - SYNOPSIS example):
976              
977             Uses the Collector L<DBIx::Class::AuditAny::Collector::AutoDBIC>
978              
979             my $schema = My::Schema->connect(@connect);
980              
981             use DBIx::Class::AuditAny;
982              
983             my $Auditor = DBIx::Class::AuditAny->track(
984             schema => $schema,
985             track_all_sources => 1,
986             collector_class => 'Collector::AutoDBIC',
987             collector_params => {
988             sqlite_db => 'db/audit.db',
989             }
990             );
991              
992             =head3 recording to the same db
993              
994             Record all changes - into specified target sources within the *same*/tracked
995             schema - using specific datapoints:
996              
997             Uses the Collector L<DBIx::Class::AuditAny::Collector::DBIC>
998              
999             DBIx::Class::AuditAny->track(
1000             schema => $schema,
1001             track_all_sources => 1,
1002             collector_class => 'Collector::DBIC',
1003             collector_params => {
1004             target_source => 'MyChangeSet', # ChangeSet source name
1005             change_data_rel => 'changes', # Change source, via rel within ChangeSet
1006             column_data_rel => 'change_columns', # ColumnChange source, via rel within Change
1007             },
1008             datapoints => [ # predefined/built-in named datapoints:
1009             (qw(changeset_ts changeset_elapsed)),
1010             (qw(change_elapsed action source pri_key_value)),
1011             (qw(column_name old_value new_value)),
1012             ],
1013             );
1014            
1015              
1016             =head3 coderef collector to a file
1017              
1018             Dump raw change data for specific sources (Artist and Album) to a file,
1019             ignore immutable flags in the schema/result classes, and allow more than
1020             one DBIx::Class::AuditAny Auditor to be attached to the same schema object:
1021              
1022             Uses 'collect' sugar param to setup a bare-bones CodeRef Collector
1023             (L<DBIx::Class::AuditAny::Role::Collector>)
1024              
1025             my $Auditor = DBIx::Class::AuditAny->track(
1026             schema => $schema,
1027             track_sources => [qw(Artist Album)],
1028             track_immutable => 1,
1029             allow_multiple_auditors => 1,
1030             collect => sub {
1031             my $cntx = shift; # ChangeSet context object
1032             require Data::Dumper;
1033             print $fh Data::Dumper->Dump([$cntx],[qw(changeset)]);
1034            
1035             # Do other custom stuff...
1036             }
1037             );
1038              
1039             =head3 more customizations
1040              
1041             Record all updates (but *not* inserts/deletes) - into specified target sources
1042             within the same/tracked schema - using specific datapoints, including user-defined
1043             datapoints and built-in datapoints with custom names:
1044              
1045             DBIx::Class::AuditAny->track(
1046             schema => CoolCatalystApp->model('Schema')->schema,
1047             track_all_sources => 1,
1048             track_actions => [qw(update)],
1049             collector_class => 'Collector::DBIC',
1050             collector_params => {
1051             target_source => 'MyChangeSet', # ChangeSet source name
1052             change_data_rel => 'changes', # Change source, via rel within ChangeSet
1053             column_data_rel => 'change_columns', # ColumnChange source, via rel within Change
1054             },
1055             datapoints => [
1056             (qw(changeset_ts changeset_elapsed)),
1057             (qw(change_elapsed action_id table_name pri_key_value)),
1058             (qw(column_name old_value new_value)),
1059             ],
1060             datapoint_configs => [
1061             {
1062             name => 'client_ip',
1063             context => 'set',
1064             method => sub {
1065             my $c = some_func(...);
1066             return $c->req->address;
1067             }
1068             },
1069             {
1070             name => 'user_id',
1071             context => 'set',
1072             method => sub {
1073             my $c = some_func(...);
1074             $c->user->id;
1075             }
1076             }
1077             ],
1078             rename_datapoints => {
1079             changeset_elapsed => 'total_elapsed',
1080             change_elapsed => 'elapsed',
1081             pri_key_value => 'row_key',
1082             new_value => 'new',
1083             old_value => 'old',
1084             column_name => 'column',
1085             },
1086             );
1087              
1088              
1089             =head3 user-defined collector
1090              
1091             Record all changes into a user-defined custom Collector class - using
1092             default datapoints:
1093              
1094             my $Auditor = DBIx::Class::AuditAny->track(
1095             schema => $schema,
1096             track_all_sources => 1,
1097             collector_class => '+MyApp::MyCollector',
1098             collector_params => {
1099             foo => 'blah',
1100             anything => $val
1101             }
1102             );
1103              
1104             =head3 query the audit db
1105              
1106             Access/query the audit db of Collector::DBIC and Collector::AutoDBIC collectors:
1107              
1108             my $audit_schema = $Auditor->collector->target_schema;
1109             $audit_schema->resultset('AuditChangeSet')->search({...});
1110            
1111             # Print the ddl that auto-generated and deployed with a Collector::AutoDBIC collector:
1112             print $audit_schema->resultset('DeployInfo')->first->deployed_ddl;
1113              
1114             =head2 more examples
1115              
1116             See the unit tests (which are extensive) for more examples.
1117              
1118              
1119             =head1 TODO
1120              
1121             =over
1122              
1123             =item *
1124              
1125             Enable tracking multi-primary-key sources (code currently disabled)
1126              
1127             =item *
1128              
1129             Write more tests
1130              
1131             =item *
1132              
1133             Write more documentation
1134              
1135             =item *
1136              
1137             Add more built-in datapoints
1138              
1139             =item *
1140              
1141             Expand the Collector API to be able to provide datapoint configs
1142              
1143             =item *
1144              
1145             Separate set/change/column datapoints into 'pre' and 'post' stages
1146              
1147             =item *
1148              
1149             Add mechanism to enable/disable tracking (localizable global?)
1150              
1151             =item *
1152              
1153             Switch to use L<Types::Standard>
1154              
1155             =back
1156              
1157             =head1 SIMILAR MODULES
1158              
1159             =head2 DBIx::Class::Journal
1160              
1161             L<DBIx::Class::Journal> was the first DBIC change tracking module released to CPAN. It works,
1162             but is inflexible and mandates a single mode of operation, which is not ideal in many ways.
1163              
1164             =head2 DBIx::Class::AuditLog
1165              
1166             L<DBIx::Class::AuditLog> takes a more casual approach than L<DBIx::Class::Journal>, which makes
1167             it easier to work with. However, it still forces a narrow and specific manner in which it stores
1168             the change history data which doesn't fit all workflows.
1169              
1170             AuditAny was designed specifically for flexibility. By separating the I<Auditor> - which captures the
1171             change data as it happens - from the I<Collector>, which handles storing the data, all sorts of
1172             different styles and manners of formatting and storing the audit data can be achieved. In fact,
1173             L<DBIx::Class::AuditLog> could be written using AuditAny, and store the data in exactly the same
1174             manner by implementing a custom collector class.
1175              
1176             =head2 DBIx::Class::Shadow
1177              
1178             Shadow is a different animal. It is very sophisticated, and places accuracy above all else, with the
1179             idea of being able to do things such as reliably "revive" the previous state of rows, etc. The
1180             downside of this is that it is also not flexible, in that it handles the entire change life cycle
1181             within its logic. This is different from AuditAny, which is more like a packet capture lib for DBIC
1182             (like tcpdump/libpcap is a packet capture lib for networks). Unlike the others, Shadow could B<not>
1183             be implemented using AuditAny, because the I<way> it captures the change data is specific and
1184             fundamentally different.
1185              
1186             Unfortunately, DBIx::Class::Shadow is unfinished and has never been released to CPAN (as of the time
1187             of this writing, in May 2015). Its current, unfinished status can be seen in GitHub:
1188              
1189             =over
1190              
1191             =item *
1192              
1193             L<https://github.com/ribasushi/preshadow>
1194              
1195             =back
1196              
1197              
1198             =head1 SUPPORT
1199            
1200             IRC:
1201            
1202             Join #rapidapp on irc.perl.org.
1203              
1204             =head1 AUTHOR
1205              
1206             Henry Van Styn <vanstyn@cpan.org>
1207              
1208             =head1 COPYRIGHT AND LICENSE
1209              
1210             This software is copyright (c) 2012-2016 by IntelliTree Solutions llc.
1211              
1212             This is free software; you can redistribute it and/or modify it under
1213             the same terms as the Perl 5 programming language system itself.
1214              
1215             =cut
1216