File Coverage

blib/lib/DBIx/Class/AuditAny/Collector/DBIC.pm
Criterion Covered Total %
statement 45 66 68.1
branch 4 12 33.3
condition 1 10 10.0
subroutine 10 12 83.3
pod 7 8 87.5
total 67 108 62.0


line stmt bran cond sub pod time code
1             package DBIx::Class::AuditAny::Collector::DBIC;
2 12     12   8157 use strict;
  12         37  
  12         394  
3 12     12   67 use warnings;
  12         43  
  12         349  
4              
5             # ABSTRACT: Collector class for recording AuditAny changes in DBIC schemas
6              
7 12     12   85 use Moo;
  12         31  
  12         78  
8 12     12   17850 use MooX::Types::MooseLike::Base qw(:all);
  12         34  
  12         23615  
9             with 'DBIx::Class::AuditAny::Role::Collector';
10              
11             =head1 NAME
12              
13             DBIx::Class::AuditAny::Collector::DBIC - Collector class for recording AuditAny
14             changes in DBIC schemas
15              
16             =head1 DESCRIPTION
17              
18             This Collector facilitates recording ChangeSets, Changes, and Column Changes within a
19             clean relational structure into a DBIC schema.
20              
21             If you don't want to handle the details of configuring this yourself, see
22             L<DBIx::Class::AuditAny::Collector::AutoDBIC> which is a subclass of us, but handles
23             most of the defaults for you w/o fuss.
24              
25             =head1 ATTRIBUTES
26              
27             Docs regarding the API/purpose of the attributes and methods in this class still TBD...
28              
29             =head2 target_schema
30              
31             =head2 target_source
32              
33             =head2 change_data_rel
34              
35             =head2 column_data_rel
36              
37             =cut
38              
39             has 'target_schema', is => 'ro', isa => Object, lazy => 1, default => sub { (shift)->AuditObj->schema };
40             has 'target_source', is => 'ro', isa => Str, required => 1;
41             has 'change_data_rel', is => 'ro', isa => Maybe[Str];
42             has 'column_data_rel', is => 'ro', isa => Maybe[Str];
43              
44              
45             # the top level source; could be either change or changeset
46             has 'targetSource', is => 'ro', isa => Object,
47             lazy => 1, init_arg => undef, default => sub {
48             my $self = shift;
49             my $Source = $self->target_schema->source($self->target_source)
50             or die "Bad target_source name '" . $self->target_source . "'";
51             return $Source;
52             };
53              
54             has 'changesetSource', is => 'ro', isa => Maybe[Object],
55             lazy => 1, init_arg => undef, default => sub {
56             my $self = shift;
57             return $self->change_data_rel ? $self->targetSource : undef;
58             };
59              
60             has 'changeSource', is => 'ro', isa => Object,
61             lazy => 1, init_arg => undef, default => sub {
62             my $self = shift;
63             my $SetSource = $self->changesetSource or return $self->targetSource;
64             my $Source = $SetSource->related_source($self->change_data_rel)
65             or die "Bad change_data_rel name '" . $self->change_data_rel . "'";
66             return $Source;
67             };
68              
69             has 'columnSource', is => 'ro', isa => Maybe[Object],
70             lazy => 1, init_arg => undef, default => sub {
71             my $self = shift;
72             return undef unless ($self->column_data_rel);
73             my $Source = $self->changeSource->related_source($self->column_data_rel)
74             or die "Bad column_data_rel name '" . $self->column_data_rel . "'";
75             return $Source;
76             };
77              
78             has 'changeset_datapoints', is => 'ro', isa => ArrayRef[Str],
79             lazy => 1, default => sub {
80             my $self = shift;
81             return [] unless ($self->changesetSource);
82             my @DataPoints = $self->AuditObj->get_context_datapoints(qw(base set));
83             my @names = map { $_->name } @DataPoints;
84             $self->enforce_source_has_columns($self->changesetSource,@names);
85             return \@names;
86             };
87              
88             has 'change_datapoints', is => 'ro', isa => ArrayRef[Str],
89             lazy => 1, default => sub {
90             my $self = shift;
91             my @contexts = qw(source change);
92             push @contexts,(qw(base set)) unless ($self->changesetSource);
93             my @DataPoints = $self->AuditObj->get_context_datapoints(@contexts);
94             my @names = map { $_->name } @DataPoints;
95             $self->enforce_source_has_columns($self->changeSource,@names);
96             return \@names;
97             };
98              
99             has 'column_datapoints', is => 'ro', isa => ArrayRef[Str],
100             lazy => 1, default => sub {
101             my $self = shift;
102             return [] unless ($self->columnSource);
103             my @DataPoints = $self->AuditObj->get_context_datapoints(qw(column));
104             my @names = map { $_->name } @DataPoints;
105             $self->enforce_source_has_columns($self->columnSource,@names);
106             return \@names;
107             };
108              
109             has 'write_sources', is => 'ro', isa => ArrayRef[Str], lazy => 1, default => sub {
110             my $self = shift;
111             my @sources = ();
112             push @sources, $self->changesetSource->source_name if ($self->changesetSource);
113             push @sources, $self->changeSource->source_name if ($self->changeSource);
114             push @sources, $self->columnSource->source_name if ($self->columnSource);
115             return \@sources;
116             };
117              
118             has '+writes_bound_schema_sources', default => sub {
119             my $self = shift;
120             return $self->target_schema == $self->AuditObj->schema ?
121             $self->write_sources : [];
122             };
123              
124             sub BUILD {
125 13     13 0 5453 my $self = shift;
126            
127 13         95 $self->validate_target_schema;
128              
129             }
130              
131             =head1 METHODS
132              
133             =head2 validate_target_schema
134              
135             =cut
136             sub validate_target_schema {
137 13     13 1 36 my $self = shift;
138            
139 13         279 $self->changeset_datapoints;
140 13         1457 $self->change_datapoints;
141 13         1409 $self->column_datapoints;
142            
143             }
144              
145             =head2 enforce_source_has_columns
146              
147             =cut
148             sub enforce_source_has_columns {
149 39     39 1 1068 my $self = shift;
150 39         86 my $Source = shift;
151 39         131 my @columns = @_;
152            
153 39         89 my @missing = ();
154 39   50     214 $Source->has_column($_) or push @missing, $_ for (@columns);
155            
156 39 50       1005 return 1 unless (scalar(@missing) > 0);
157            
158             die "Source '" . $Source->source_name . "' missing required columns: " .
159 0         0 join(',',map { "'$_'" } @missing);
  0         0  
160             }
161              
162             =head2 get_add_create_change
163              
164             =cut
165             sub get_add_create_change {
166 93     93 1 191 my $self = shift;
167 93         186 my $ChangeContext = shift;
168            
169 93         1784 my $create = $ChangeContext->get_datapoints_data($self->change_datapoints);
170            
171 93         3079 my $relname = $self->column_data_rel;
172 93 50       273 if($relname) {
173 93         343 my @ColChanges = $ChangeContext->all_column_changes;
174             $create->{$relname} = [
175 93         993 map { $_->get_datapoints_data($self->column_datapoints) } @ColChanges
  253         8859  
176             ];
177             }
178            
179 93         3112 return $create;
180             }
181              
182             =head2 add_change_row
183              
184             =cut
185             sub add_change_row {
186 0     0 1 0 my $self = shift;
187 0         0 my $ChangeContext = shift;
188 0         0 my $create = $self->get_add_create_change($ChangeContext);
189 0         0 return $self->changeSource->resultset->create($create);
190             }
191              
192             =head2 add_changeset_row
193              
194             =cut
195             sub add_changeset_row {
196 42     42 1 707 my $self = shift;
197 42         98 my $ChangeSetContext = shift;
198            
199 42         808 my $create = $ChangeSetContext->get_datapoints_data($self->changeset_datapoints);
200            
201 42         1226 my $relname = $self->change_data_rel;
202 42 50       173 if($relname) {
203 42         228 my @Changes = $ChangeSetContext->all_changes;
204 42         143 $create->{$relname} = [ map { $self->get_add_create_change($_) } @Changes ];
  93         355  
205             }
206            
207 42         799 return $self->changesetSource->resultset->create($create);
208             }
209              
210              
211             ######### Public API #########
212              
213             =head2 record_changes
214              
215             =cut
216             sub record_changes {
217 42     42 1 1811 my $self = shift;
218 42         205 my $ChangeSet = shift;
219            
220 42 50       850 return $self->add_changeset_row($ChangeSet) if ($self->changesetSource);
221 0           my @Changes = $ChangeSet->all_changes;
222 0           $self->add_change_row($_) for (@Changes);
223            
224 0           return 1;
225             }
226              
227             =head2 has_full_row_stored
228              
229             =cut
230             sub has_full_row_stored {
231 0     0 1   my $self = shift;
232 0           my $Row = shift;
233            
234 0 0         my $Rs = $self->changeSource->resultset
235             or die "No changeSource in this collector";
236            
237 0           my $source_name = $Row->result_source->source_name;
238 0 0         my $SourceContext = $self->AuditObj->tracked_sources->{$source_name}
239             or die "Source '$source_name' is not being tracked by the Auditor!";
240            
241 0           my $pri_key_value = $SourceContext->get_pri_key_value($Row);
242            
243 0   0       my $rename = $self->AuditObj->rename_datapoints || {};
244            
245 0   0       my $pri_key_row = $rename->{pri_key_value} || 'pri_key_value';
246 0   0       my $source = $rename->{source} || 'source';
247 0   0       my $action = $rename->{action} || 'action';
248            
249 0           $Rs = $Rs->search_rs({
250             $pri_key_row => $pri_key_value,
251             $source => $source_name,
252             $action => [ 'select','insert' ]
253             },{ limit => 1 });
254            
255 0           return $Rs->count;
256             }
257              
258              
259             1;
260              
261              
262             __END__
263              
264             =head1 SEE ALSO
265              
266             =over
267              
268             =item *
269              
270             L<DBIx::Class::AuditAny>
271              
272             =item *
273              
274             L<DBIx::Class>
275              
276             =back
277              
278             =head1 SUPPORT
279            
280             IRC:
281            
282             Join #rapidapp on irc.perl.org.
283              
284             =head1 AUTHOR
285              
286             Henry Van Styn <vanstyn@cpan.org>
287              
288             =head1 COPYRIGHT AND LICENSE
289              
290             This software is copyright (c) 2012-2015 by IntelliTree Solutions llc.
291              
292             This is free software; you can redistribute it and/or modify it under
293             the same terms as the Perl 5 programming language system itself.
294              
295             =cut