File Coverage

blib/lib/DBIx/Class/AuditAny/AuditContext/ChangeSet.pm
Criterion Covered Total %
statement 37 39 94.8
branch 5 8 62.5
condition n/a
subroutine 12 13 92.3
pod 5 6 83.3
total 59 66 89.3


line stmt bran cond sub pod time code
1             package DBIx::Class::AuditAny::AuditContext::ChangeSet;
2 13     13   7514 use strict;
  13         22  
  13         384  
3 13     13   48 use warnings;
  13         23  
  13         340  
4              
5             # ABSTRACT: Default 'ChangeSet' context object class for DBIx::Class::AuditAny
6              
7 13     13   46 use Moo;
  13         17  
  13         77  
8 13     13   16642 use MooX::Types::MooseLike::Base qw(:all);
  13         20  
  13         4516  
9             extends 'DBIx::Class::AuditAny::AuditContext';
10              
11             =head1 NAME
12              
13             DBIx::Class::AuditAny::AuditContext::ChangeSet - Default 'ChangeSet' context object
14             class for DBIx::Class::AuditAny
15              
16             =head1 DESCRIPTION
17              
18             This object class represents a "set" of changes grouped together, typically all applied within
19             the scope of a single transaction. The changes can span across multiple individual changes,
20             which can also represent changes to multiple different columns.
21              
22             This class is used internally and should not be used directly.
23              
24             =cut
25              
26 13     13   64 use Time::HiRes qw(gettimeofday tv_interval);
  13         18  
  13         98  
27              
28 30     30   972 sub _build_tiedContexts { [] }
29             sub _build_local_datapoint_data {
30 40     40   329 my $self = shift;
31 40         173 return { map { $_->name => $_->get_value($self) } $self->get_context_datapoints('set') };
  75         406  
32             }
33              
34             =head1 ATTRIBUTES
35              
36             Docs regarding the API/purpose of the attributes and methods in this class still TBD...
37              
38             =head2 changes
39              
40             =head2 finished
41              
42             =head2 changeset_ts
43              
44             =head2 start_timeofday
45              
46             =head2 changeset_finish_ts
47              
48             =head2 changeset_elapsed
49              
50             =cut
51              
52             has 'changes', is => 'ro', isa => ArrayRef, default => sub {[]};
53             has 'finished', is => 'rw', isa => Bool, default => sub{0}, init_arg => undef;
54              
55             has 'changeset_ts', is => 'ro', isa => InstanceOf['DateTime'], lazy => 1, default => sub { (shift)->get_dt };
56             has 'start_timeofday', is => 'ro', default => sub { [gettimeofday] };
57              
58             has 'changeset_finish_ts', is => 'rw', isa => Maybe[InstanceOf['DateTime']], default => sub{undef};
59             has 'changeset_elapsed', is => 'rw', default => sub{undef};
60              
61             sub BUILD {
62 47     47 0 368 my $self = shift;
63            
64             # Init
65 47         852 $self->changeset_ts;
66             }
67              
68             =head1 METHODS
69              
70             =head2 all_changes
71              
72             =head2 count_changes
73              
74             =head2 all_column_changes
75              
76             =head2 add_changes
77              
78             =head2 finish
79              
80             =cut
81              
82 45     45 1 203 sub all_changes { @{(shift)->changes} }
  45         190  
83 0     0 1 0 sub count_changes { scalar(@{(shift)->changes}) }
  0         0  
84 5     5 1 658 sub all_column_changes { map { $_->all_column_changes } (shift)->all_changes }
  5         16  
85              
86             sub add_changes {
87 94     94 1 524 my ($self, @ChangeContexts) = @_;
88            
89 94 50       1410 die "Cannot add_changes to finished ChangeSet!" if ($self->finished);
90            
91 94         632 foreach my $ChangeContext (@ChangeContexts) {
92            
93             # New: It is now possible that there is no attached ChangeSet yet, since ChangeContext
94             # is now created -before- the action operation is executed, and thus before
95             # a changeset is automatically started (we do this so we don't have to worry
96             # about exceptions). But by the time ->record() is called, we know the operation
97             # has succeeded, and we also know that a new changeset has been created if the
98             # operation was not already wrapped in a transaction. Se we just set it now:
99 94 100       1358 $ChangeContext->ChangeSetContext($self) unless ($ChangeContext->ChangeSetContext);
100            
101             # Extra check for good measure:
102 94 50       3788 die "Attempted to add changes attached to a different changeset!"
103             unless ($self == $ChangeContext->ChangeSetContext);
104            
105 94         436 push @{$self->changes}, $ChangeContext;
  94         672  
106             }
107             }
108              
109              
110             sub finish {
111 45     45 1 305 my $self = shift;
112 45 50       669 return if ($self->finished);
113            
114 45         386 $self->changeset_finish_ts($self->get_dt);
115 45         41792 $self->changeset_elapsed(tv_interval($self->start_timeofday));
116            
117 45         1556 return $self->finished(1);
118             }
119              
120             1;
121              
122             __END__
123              
124             =head1 SEE ALSO
125              
126             =over
127              
128             =item *
129              
130             L<DBIx::Class::AuditAny>
131              
132             =item *
133              
134             L<DBIx::Class>
135              
136             =back
137              
138             =head1 SUPPORT
139            
140             IRC:
141            
142             Join #rapidapp on irc.perl.org.
143              
144             =head1 AUTHOR
145              
146             Henry Van Styn <vanstyn@cpan.org>
147              
148             =head1 COPYRIGHT AND LICENSE
149              
150             This software is copyright (c) 2012-2015 by IntelliTree Solutions llc.
151              
152             This is free software; you can redistribute it and/or modify it under
153             the same terms as the Perl 5 programming language system itself.
154              
155             =cut