File Coverage

blib/lib/ORM/Ta.pm
Criterion Covered Total %
statement 23 32 71.8
branch 13 18 72.2
condition 4 9 44.4
subroutine 2 3 66.6
pod 0 2 0.0
total 42 64 65.6


line stmt bran cond sub pod time code
1             #
2             # DESCRIPTION
3             # PerlORM - Object relational mapper (ORM) for Perl. PerlORM is Perl
4             # library that implements object-relational mapping. Its features are
5             # much similar to those of Java's Hibernate library, but interface is
6             # much different and easier to use.
7             #
8             # AUTHOR
9             # Alexey V. Akimov
10             #
11             # COPYRIGHT
12             # Copyright (C) 2005-2006 Alexey V. Akimov
13             #
14             # This library is free software; you can redistribute it and/or
15             # modify it under the terms of the GNU Lesser General Public
16             # License as published by the Free Software Foundation; either
17             # version 2.1 of the License, or (at your option) any later version.
18             #
19             # This library is distributed in the hope that it will be useful,
20             # but WITHOUT ANY WARRANTY; without even the implied warranty of
21             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22             # Lesser General Public License for more details.
23             #
24             # You should have received a copy of the GNU Lesser General Public
25             # License along with this library; if not, write to the Free Software
26             # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
27             #
28              
29             package ORM::Ta;
30              
31             $VERSION = 0.8;
32              
33             my $die;
34             my $die_eval;
35             my $die_handler_enabled;
36             my $old_die_handler;
37              
38             sub new
39             {
40 57     57 0 149 my $class = shift;
41 57         216 my %arg = @_;
42 57         185 my $self = bless {}, $class;
43              
44 57 100       375 unless( $arg{class}->_current_transaction )
45             {
46 10         82 $die = undef;
47            
48 10         36 $self->{class} = $arg{class};
49 10   33     67 $self->{error} = $arg{error} || ORM::Error->new;
50 10         129 $self->{eval} = $^S;
51              
52 10 100       42 unless( $die_handler_enabled )
53             {
54 1         2 $die_handler_enabled = 1;
55 1         2 $old_die_handler = $::SIG{__DIE__};
56 1         5 $::SIG{__DIE__} = \&die_handler;
57             }
58              
59 10 50       50 unless( $self->{error}->fatal )
60             {
61 10         41 my $error = ORM::Error->new;
62 10         58 $self->{class}->_db->begin_transaction( error=>$error );
63 10         70 $self->{class}->_current_transaction( 1 );
64 10 50       124 if( $error->fatal )
65             {
66 0         0 $self->{error}->add( error=>$error );
67 0         0 $self->{not_started} = 1;
68             }
69             }
70             }
71              
72 57         558 return $self;
73             }
74              
75             sub DESTROY
76             {
77 57     57   126 my $self = shift;
78              
79 57 100       221 $self->{class} && $self->{class}->_current_transaction( undef );
80              
81 57 100 66     1983 if( $self->{not_started} || !$self->{class} )
    50 33        
    100          
82             {
83             # nothing to do
84             }
85             elsif( $die && $die_eval eq $self->{eval} )
86             {
87 0         0 $die = undef;
88 0         0 $self->{error}->add_fatal( "Transaction rolled back because of thrown exception" );
89 0         0 $self->{class}->_db->rollback_transaction( error=>$self->{error} );
90             }
91             elsif( $self->{error}->fatal )
92             {
93 1         5 $self->{class}->_db->rollback_transaction( error=>$self->{error} );
94             }
95             else
96             {
97 9         47 $self->{class}->_db->commit_transaction( error=>$self->{error} );
98             }
99             }
100              
101             sub die_handler
102             {
103 0     0 0   $die = 1;
104 0           $die_eval = $^S;
105 0 0         $old_die_handler && &{$old_die_handler}( @_ );
  0            
106             }
107              
108             1;