File Coverage

blib/lib/DBIx/ScopedTransaction.pm
Criterion Covered Total %
statement 75 79 94.9
branch 25 32 78.1
condition n/a
subroutine 13 14 92.8
pod 5 5 100.0
total 118 130 90.7


line stmt bran cond sub pod time code
1             package DBIx::ScopedTransaction;
2              
3 12     12   475524 use strict;
  12         32  
  12         416  
4 12     12   69 use warnings;
  12         21  
  12         468  
5              
6 12     12   119 use Carp qw();
  12         25  
  12         176  
7 12     12   12636 use Data::Validate::Type qw();
  12         287406  
  12         299  
8 12     12   13533 use Try::Tiny qw();
  12         26258  
  12         11778  
9              
10              
11             =head1 NAME
12              
13             DBIx::ScopedTransaction - Scope database transactions on DBI handles in code, to detect and prevent issues with unterminated transactions.
14              
15              
16             =head1 VERSION
17              
18             Version 1.1.5
19              
20             =cut
21              
22             our $VERSION = '1.1.5';
23              
24             our $DESTROY_LOGGER;
25              
26              
27             =head1 SYNOPSIS
28              
29             use DBIx::ScopedTransaction;
30             use Try::Tiny;
31              
32             # Optional, define custom logger for errors detected when destroying a
33             # transaction object. By default, this prints to STDERR.
34             $DBIx::ScopedTransaction::DESTROY_LOGGER = sub
35             {
36             my ( $messages ) = @_;
37              
38             foreach my $message ( @$messages )
39             {
40             warn "DBIx::ScopedTransaction: $message";
41             }
42             };
43              
44             # Start a transaction on $dbh - this in turn calls $dbh->begin_work();
45             my $transaction = DBIx::ScopedTransaction->new( $dbh );
46             try
47             {
48             # Do some work on $dbh that may succeed or fail.
49             }
50             finally
51             {
52             my @errors = @_;
53             if ( scalar( @errors ) == 0 )
54             {
55             $transaction->commit() || die 'Failed to commit transaction';
56             }
57             else
58             {
59             $transaction->rollback() || die 'Failed to roll back transaction.';
60             }
61             };
62              
63              
64             =head1 DESCRIPTION
65              
66             Small class designed to be instantiated in a localized scope. Its purpose
67             is to start and then clean up a transaction on a DBI object, while detecting
68             cases where the transaction isn't terminated properly.
69              
70             The synopsis has an example of working code, let's see here an example in
71             which DBIx::ScopedTransaction helps us to detect a logic error in how the
72             programmer handled terminating the transaction.
73              
74             sub test
75             {
76             my $transaction = DBIx::ScopedTransaction->new( $dbh );
77             try
78             {
79             # Do some work on $dbh that may succeed or fail.
80             }
81             catch
82             {
83             $transaction->rollback();
84             };
85             }
86              
87             test();
88              
89             As soon as the test() function has been run, $transaction goes out of scope and
90             gets destroyed by Perl. DBIx::ScopedTransaction subclasses destroy and detects
91             that the underlying transaction has neither been committed nor rolled back,
92             and forces a rollback for safety as well as prints details on what code should
93             be reviewed on STDERR.
94              
95              
96             =head1 METHODS
97              
98             =head2 new()
99              
100             Create a new transaction.
101              
102             my $transaction = DBIx::ScopedTransaction->new(
103             $database_handle,
104             );
105              
106             =cut
107              
108             sub new
109             {
110 14     14 1 174361 my ( $class, $database_handle ) = @_;
111              
112             # If we're in void context, DESTROY will be called immediately on the
113             # object we return in new(), which is not desirable and indicates an
114             # error in the calling code. To prevent unhelpful reports of
115             # "transaction not completed properly", we instead catch it here before
116             # we even instantiate the object.
117 14 100       97 Carp::croak(
118             'You need to assign the output of DBIx::ScopedTransaction to a ' .
119             'variable, otherwise it would get destroyed immediately.'
120             ) if !defined( wantarray() );
121              
122 13 50       103 Carp::croak('You need to pass a database handle to create a new transaction object')
123             if !Data::Validate::Type::is_instance( $database_handle, class => 'DBI::db' );
124              
125 13 50       485 Carp::croak('A transaction is already in progress on this database handle')
126             if !$database_handle->begin_work();
127              
128 12         304 my ( undef, $filename, $line ) = caller();
129              
130 12         135 return bless(
131             {
132             database_handle => $database_handle,
133             active => 1,
134             filename => $filename,
135             line => $line,
136             },
137             $class
138             );
139             }
140              
141              
142             =head2 get_database_handle()
143              
144             Return the database handle the current transaction is operating on.
145              
146             my $database_handle = $transaction->get_database_handle();
147              
148             =cut
149              
150             sub get_database_handle
151             {
152 15     15 1 671 my ( $self ) = @_;
153              
154 15         47 return $self->{'database_handle'};
155             }
156              
157              
158             =head2 is_active()
159              
160             Return whether the current transaction object is active.
161              
162             # Get the active status of the transaction.
163             my $is_active = $transaction->is_active();
164              
165             # Set the active status of the transaction.
166             $transaction->is_active( $is_active );
167              
168             The transaction object goes inactive after a successful commit or rollback.
169              
170             =cut
171              
172             sub is_active
173             {
174 28     28 1 361 my ( $self, $value ) = @_;
175              
176 28 100       97 if ( defined( $value ) )
177             {
178 5         16 $self->{'active'} = $value;
179             }
180              
181 28         143 return $self->{'active'};
182             }
183              
184              
185             =head2 commit()
186              
187             Commit the current transaction.
188              
189             my $commit_successful = $transaction->commit();
190              
191             =cut
192              
193             sub commit
194             {
195 4     4 1 4828 my ( $self ) = @_;
196              
197 4 100       16 if ( ! $self->is_active() )
198             {
199 1         23 Carp::carp('Logic error: inactive transaction object committed again');
200 1         602 return 0;
201             }
202              
203 3         15 my $database_handle = $self->get_database_handle();
204 3 100       44 if ( $database_handle->commit() )
205             {
206 2         9 $self->is_active( 0 );
207 2         9 return 1;
208             }
209             else
210             {
211 1         29 my $error = $database_handle->errstr();
212 1 50       5 $error = '(no error associate with the database handle)'
213             if !defined( $error );
214 1         21 Carp::cluck( "Failed to commit transaction: $error" );
215 1         855 return 0;
216             }
217             }
218              
219              
220             =head2 rollback()
221              
222             Roll back the current transaction.
223              
224             my $rollback_successful = $transaction->rollback();
225              
226             =cut
227              
228             sub rollback
229             {
230 5     5 1 5415 my ( $self ) = @_;
231              
232 5 100       23 if ( ! $self->is_active() )
233             {
234 1         28 Carp::carp('Logic error: inactive transaction object committed again');
235 1         591 return 0;
236             }
237              
238 4         19 my $database_handle = $self->get_database_handle();
239 4 100       69 if ( $database_handle->rollback() )
240             {
241 3         15 $self->is_active( 0 );
242 3         11 return 1;
243             }
244             else
245             {
246 1         27 my $error = $database_handle->errstr();
247 1 50       4 $error = '(no error associate with the database handle)'
248             if !defined( $error );
249 1         21 Carp::cluck( "Failed to rollback transaction: $error" );
250 1         976 return 0;
251             }
252             }
253              
254              
255             =head1 HIDDEN FUNCTIONS
256              
257             =head2 _default_destroy_logger()
258              
259             Log to STDERR warnings and errors that occur when a DBIx::ScopedTransaction
260             object is destroyed.
261              
262             _default_destroy_logger( $messages );
263              
264             To override this default logger you can override
265             C<$DBIx::ScopedTransaction::DESTROY_LOGGER>. For example:
266              
267             $DBIx::ScopedTransaction::DESTROY_LOGGER = sub
268             {
269             my ( $messages ) = @_;
270              
271             foreach $message ( @$messages )
272             {
273             warn "DBIx::ScopedTransaction: $message";
274             }
275             };
276              
277             =cut
278              
279             sub _default_destroy_logger
280             {
281 5     5   8 my ( $messages ) = @_;
282              
283 5         77 print STDERR "\n";
284 5         23 print STDERR "/!\\ ***** DBIx::ScopedTransaction::DESTROY *****\n";
285 5         13 foreach my $message ( @$messages )
286             {
287 10         53 print STDERR "/!\\ $message\n";
288             }
289 5         22 print STDERR "\n";
290              
291 5         18 return;
292             }
293              
294              
295             =head2 DESTROY()
296              
297             Clean up function to detect unterminated transactions and try to roll them
298             back safely before destroying the DBIx::ScopedTransaction object.
299              
300             =cut
301              
302             sub DESTROY
303             {
304 12     12   8557 my ( $self ) = @_;
305              
306             # If the transaction is still active but we're trying to destroy the object,
307             # we have a problem. It most likely indicates that the transaction object is
308             # going out of scope without the transaction having been properly completed.
309 12 100       50 if ( $self->is_active() )
310             {
311 7         19 my $messages = [];
312              
313             # Try to resolve the situation as cleanly as possible, inside an eval
314             # block to catch any issue.
315             Try::Tiny::try
316             {
317 7     7   349 push(
318             @$messages,
319             "Transaction object created at $self->{'filename'}:$self->{'line'} is "
320             . "going out of scope, but the transaction has not been committed or "
321             . "rolled back; check logic."
322             );
323              
324 7         31 my $database_handle = $self->get_database_handle();
325 7 50       33 if ( defined( $database_handle ) )
326             {
327 7 100       100 if ( $database_handle->rollback() )
328             {
329 6         34 push( @$messages, 'Forced rolling back the transaction to prevent issues.' );
330             }
331             else
332             {
333 1         9 push( @$messages, 'Could not roll back transaction to resolve the issue.' );
334             }
335             }
336             else
337             {
338 0         0 push( @$messages, 'Failed to roll back transaction, the database handle has already vanished.' );
339             }
340             }
341             Try::Tiny::catch
342             {
343 0     0   0 push( @$messages, 'Error: ' . $_ );
344 7         247 };
345              
346             # Find where to log the errors to.
347 7         191 my $destroy_logger;
348 7 100       220 if ( defined( $DESTROY_LOGGER ) )
349             {
350             # There's a custom logger defined, make sure it is a valid code block
351             # before using it.
352 2 50       11 if ( Data::Validate::Type::is_coderef( $DESTROY_LOGGER ) )
353             {
354 2         29 $destroy_logger = $DESTROY_LOGGER;
355             }
356             else
357             {
358             # Fall back to the default logger.
359 0         0 $destroy_logger = \&_default_destroy_logger;
360 0         0 push(
361             @$messages,
362             '$DBIx::ScopedTransaction::_default_destroy_logger is not a valid code block, could not send log message to it.',
363             );
364             }
365             }
366             else
367             {
368             # No logger defined, use the default.
369 5         15 $destroy_logger = \&_default_destroy_logger;
370             }
371              
372 7         27 $destroy_logger->( $messages );
373             }
374              
375 12 50       1000 return $self->can('SUPER::DESTROY') ? $self->SUPER::DESTROY() : 1;
376             }
377              
378              
379             =head1 BUGS
380              
381             Please report any bugs or feature requests through the web interface at
382             L.
383             I will be notified, and then you'll automatically be notified of progress on
384             your bug as I make changes.
385              
386              
387             =head1 SUPPORT
388              
389             You can find documentation for this module with the perldoc command.
390              
391             perldoc DBIx::ScopedTransaction
392              
393              
394             You can also look for information at:
395              
396             =over 4
397              
398             =item * GitHub's request tracker
399              
400             L
401              
402             =item * AnnoCPAN: Annotated CPAN documentation
403              
404             L
405              
406             =item * CPAN Ratings
407              
408             L
409              
410             =item * MetaCPAN
411              
412             L
413              
414             =back
415              
416              
417             =head1 AUTHOR
418              
419             L,
420             C<< >>.
421              
422              
423             =head1 ACKNOWLEDGEMENTS
424              
425             I originally developed this project for ThinkGeek
426             (L). Thanks for allowing me to open-source it!
427              
428              
429             =head1 COPYRIGHT & LICENSE
430              
431             Copyright 2012-2014 Guillaume Aubert.
432              
433             This program is free software: you can redistribute it and/or modify it under
434             the terms of the GNU General Public License version 3 as published by the Free
435             Software Foundation.
436              
437             This program is distributed in the hope that it will be useful, but WITHOUT ANY
438             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
439             PARTICULAR PURPOSE. See the GNU General Public License for more details.
440              
441             You should have received a copy of the GNU General Public License along with
442             this program. If not, see http://www.gnu.org/licenses/
443              
444             =cut
445              
446             1;