File Coverage

blib/lib/Mojo/Redis2/Transaction.pm
Criterion Covered Total %
statement 6 31 19.3
branch 0 16 0.0
condition 0 8 0.0
subroutine 2 10 20.0
pod 3 3 100.0
total 11 68 16.1


line stmt bran cond sub pod time code
1             package Mojo::Redis2::Transaction;
2 1     1   510 use Mojo::Base 'Mojo::Redis2';
  1         15  
  1         5  
3              
4             # CPAN failed to index the module, because "Decreasing version number"
5             our $VERSION = '0.01';
6             $VERSION = $Mojo::Redis2::VERSION;
7              
8             sub discard {
9 0     0 1   shift->_execute_if_instructions(DISCARD => @_);
10             }
11              
12             sub exec {
13 0     0 1   my $self = shift;
14 0           $self->{exec} = 1;
15 0           $self->_execute_if_instructions(EXEC => @_);
16             }
17              
18 0     0 1   sub watch { shift->_execute(txn => WATCH => @_); }
19              
20             sub DESTROY {
21 0     0     my $self = shift;
22 0 0 0       $self->discard if $self->{instructions} and !$self->{exec};
23             }
24              
25 0     0     sub _blocking_group {'txn'}
26              
27             sub _execute {
28 0     0     my ($self, $group, $op) = (shift, shift, shift);
29              
30 0 0 0       if (!grep { $op eq $_ } qw( DISCARD EXEC WATCH ) and !$self->{instructions}++) {
  0            
31 0           $self->{exec} = 0;
32 0 0 0       $self->{connections}{txn} ||= {group => 'txn', nb => ref $_[-1] eq 'CODE' ? 1 : 0};
33 0           push @{$self->{connections}{txn}{queue}}, [undef, 'MULTI'];
  0            
34             }
35              
36 0           $self->SUPER::_execute(txn => $op, @_);
37             }
38              
39             sub _execute_if_instructions {
40 0 0   0     my @cb = ref $_[-1] eq 'CODE' ? (pop) : ();
41 0           my ($self, $action) = @_;
42 0           my $res;
43              
44 0 0         if (delete $self->{instructions}) {
    0          
45 0           $res = $self->_execute(txn => $action, @cb);
46             }
47             elsif (my $cb = $cb[0]) {
48 0 0         $self->$cb($action eq 'EXEC' ? [] : 'OK');
49             }
50             else {
51 0 0         return $action eq 'EXEC' ? [] : 'OK';
52             }
53              
54 0           return $res;
55             }
56              
57             for my $illegal (qw( blpop brpop brpoplpush multi psubscribe publish subscribe )) {
58 1     1   687 no strict 'refs';
  1         2  
  1         123  
59 0     0     *$illegal = sub { die "Cannot call $illegal() on $_[0]"; };
60             }
61              
62             1;
63              
64             =encoding utf8
65              
66             =head1 NAME
67              
68             Mojo::Redis2::Transaction - Transaction guard for Mojo::Redis2
69              
70             =head1 DESCRIPTION
71              
72             L is an object for handling transactions started
73             by L.
74              
75             All transactions objects will be kept isolated having its own connection to
76             the database. One object can also be re-used: Calling a
77             L after L or L will
78             result in sending the "MULTI" command to the Redis server again.
79              
80             L is automatically called when an instance of
81             L goes out of scope.
82              
83             See also L.
84              
85             =head1 SYNOPSIS
86              
87             use Mojo::Redis2;
88             my $redis = Mojo::Redis2->new;
89              
90             my $txn = $redis->multi;
91             $txn->set(foo => 42);
92             $txn->exec;
93              
94             # the same object (and connection to database) can be re-used
95             $txn->incr('foo');
96             $txn->discard;
97              
98             =head1 ATTRIBUTES
99              
100             L inherits all attributes from L.
101              
102             =head1 METHODS
103              
104             L inherits all methods from L and
105             implements the following new ones.
106              
107             =head2 discard
108              
109             $self->discard;
110             $self->discard(sub { my ($self, $err, $res) = @_; });
111              
112             Discard all commands issued. This method is called automatically on DESTROY,
113             unless L was called first.
114              
115             =head2 exec
116              
117             $self->exec;
118             $self->exec(sub { my ($self, $err, $res) = @_; });
119              
120             Execute all commands issued.
121              
122             =head2 watch
123              
124             $self = $self->watch($key, $cb);
125             $res = $self->watch($key);
126              
127             Marks the given keys to be watched for conditional execution of a transaction.
128              
129             =head1 ILLEGAL METHODS
130              
131             The following methods cannot be called on an instance of
132             L.
133              
134             =over 4
135              
136             =item * blpop
137              
138             =item * brpop
139              
140             =item * brpoplpush
141              
142             =item * multi
143              
144             =item * psubscribe
145              
146             =item * publish
147              
148             =item * subscribe
149              
150             =back
151              
152             =head1 COPYRIGHT AND LICENSE
153              
154             Copyright (C) 2014, Jan Henning Thorsen
155              
156             This program is free software, you can redistribute it and/or modify it under
157             the terms of the Artistic License version 2.0.
158              
159             =head1 AUTHOR
160              
161             Jan Henning Thorsen - C
162              
163             =cut