File Coverage

blib/lib/Database/Async/Transaction.pm
Criterion Covered Total %
statement 18 46 39.1
branch 0 16 0.0
condition 0 7 0.0
subroutine 6 17 35.2
pod 1 6 16.6
total 25 92 27.1


line stmt bran cond sub pod time code
1             package Database::Async::Transaction;
2              
3 2     2   16 use strict;
  2         4  
  2         68  
4 2     2   11 use warnings;
  2         5  
  2         89  
5              
6             our $VERSION = '0.017'; # VERSION
7              
8 2     2   14 use parent qw(Database::Async::DB);
  2         3  
  2         11  
9              
10             =head1 NAME
11              
12             Database::Async::Transaction - represents a single database transaction in L
13              
14             =head1 DESCRIPTION
15              
16             =cut
17              
18 2     2   141 use Future;
  2         4  
  2         49  
19 2     2   1075 use Class::Method::Modifiers qw(:all);
  2         3470  
  2         280  
20              
21 2     2   16 use Log::Any qw($log);
  2         4  
  2         11  
22              
23             =head1 METHODS
24              
25             =cut
26              
27             =head2 new
28              
29             Instantiates the transaction. This is not intended to be called directly;
30             that's normally handled by L itself.
31              
32             =cut
33              
34             sub new {
35 0     0 1   my ($class, %args) = @_;
36 0   0       Scalar::Util::weaken($args{database} || die 'expected database parameter');
37 0   0       $args{open} //= 0;
38 0           bless \%args, $class
39             }
40              
41 0     0 0   sub database { shift->{database} }
42              
43             sub begin {
44 0     0 0   my ($self) = @_;
45 0           my $query = Database::Async::Query->new(
46             db => $self->database,
47             sql => 'begin',
48             bind => [],
49             );
50 0           $query->single
51             ->completed
52             }
53              
54 0     0 0   sub pool { shift->{pool} }
55              
56 0     0 0   sub completed { Future->done }
57              
58             #sub do {
59             # my ($self, $sql, %args) = @_;
60             # $self->query($sql => %args);
61             #}
62              
63             fresh commit => sub {
64 0     0     my ($self) = @_;
65 0 0         die 'transaction no longer active' unless $self->{open};
66 0     0     Future->done->on_ready(sub { $self->{open} = 0 });
  0            
67             };
68              
69             fresh rollback => sub {
70 0     0     my ($self) = @_;
71 0 0         return Future->done unless delete $self->{has_activity};
72 0 0         die 'transaction no longer active' unless $self->{open};
73 0     0     Future->done->on_ready(sub { $self->{open} = 0 });
  0            
74             };
75              
76             sub DESTROY {
77 0     0     my ($self) = @_;
78 0 0         return if ${^GLOBAL_PHASE} eq 'DESTRUCT';
79 0 0         return unless $self->{open};
80 0           $self->rollback->retain;
81             }
82              
83             before [@Database::Async::Query::METHODS] => sub {
84             my ($self) = @_;
85             $self->{has_activity} //= 1;
86             $self->{open} //= 1;
87             };
88              
89             sub diagnostics {
90 0     0 0   my ($self) = @_;
91 0 0         die 'need a valid pool instance' unless my $pool = $self->pool;
92 0 0         die 'pool does not appear to be correct type' unless $pool->DOES('Database::Async::Pool');
93 0 0 0       die 'inconsistent activity/open status' if $self->{open} and !$self->{has_activity};
94 0           Future->done;
95             }
96              
97             1;
98              
99             =head1 AUTHOR
100              
101             Tom Molesworth C<< >>
102              
103             =head1 LICENSE
104              
105             Copyright Tom Molesworth 2011-2021. Licensed under the same terms as Perl itself.
106