Showing 3 changed files with 120 additions and 30 deletions
+1
Changes
... ...
@@ -1,4 +1,5 @@
1 1
 0.1659
2
+    - EXPERIMETAL fork safety implementaion.
2 3
     - removed EXPERIMENTAL selection
3 4
     - added select() all_column option
4 5
 0.1658
+72 -30
lib/DBIx/Custom.pm
... ...
@@ -1,6 +1,6 @@
1 1
 package DBIx::Custom;
2 2
 
3
-our $VERSION = '0.1658';
3
+our $VERSION = '0.1659';
4 4
 
5 5
 use 5.008001;
6 6
 use strict;
... ...
@@ -20,7 +20,7 @@ use DBIx::Custom::Util;
20 20
 use Encode qw/encode_utf8 decode_utf8/;
21 21
 
22 22
 __PACKAGE__->attr(
23
-    [qw/data_source dbh password user/],
23
+    [qw/data_source password pid user/],
24 24
     cache => 1,
25 25
     dbi_option => sub { {} },
26 26
     default_dbi_option => sub {{
... ...
@@ -35,6 +35,29 @@ __PACKAGE__->attr(
35 35
     stash => sub { {} }
36 36
 );
37 37
 
38
+sub dbh {
39
+    my $self = shift;
40
+
41
+    if (@_) {
42
+        $self->{dbh} = $_[0];
43
+        return $self;
44
+    }
45
+    else {
46
+        my $pid = $$;
47
+        if ($self->pid eq $pid) {
48
+            return $self->{dbh};
49
+        }
50
+        else {
51
+            # Create new connection in child process
52
+            croak "Process is forked in transaction"
53
+              unless $self->{dbh}->{AutoCommit};
54
+            $self->pid($pid);
55
+            $self->{dbh}->{InactiveDestroy} = 1;
56
+            return $self->{dbh} = $self->_connect;
57
+        }
58
+    }
59
+}
60
+
38 61
 __PACKAGE__->attr(
39 62
     cache_method => sub {
40 63
         sub {
... ...
@@ -157,31 +180,14 @@ sub method {
157 180
 sub connect {
158 181
     my $self = ref $_[0] ? shift : shift->new(@_);;
159 182
     
160
-    # Attributes
161
-    my $data_source = $self->data_source;
162
-    croak qq{"data_source" must be specified to connect()"}
163
-      unless $data_source;
164
-    my $user        = $self->user;
165
-    my $password    = $self->password;
166
-    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
167
-    
168
-    # Connect
169
-    my $dbh = eval {DBI->connect(
170
-        $data_source,
171
-        $user,
172
-        $password,
173
-        {
174
-            %{$self->default_dbi_option},
175
-            %$dbi_option
176
-        }
177
-    )};
178
-    
179
-    # Connect error
180
-    croak $@ if $@;
183
+    my $dbh = $self->_connect;
181 184
     
182 185
     # Database handle
183 186
     $self->dbh($dbh);
184 187
     
188
+    # Process ID
189
+    $self->pid($$);
190
+    
185 191
     return $self;
186 192
 }
187 193
 
... ...
@@ -1126,6 +1132,34 @@ sub _bind {
1126 1132
     return \@bind;
1127 1133
 }
1128 1134
 
1135
+sub _connect {
1136
+    my $self = shift;
1137
+    
1138
+    # Attributes
1139
+    my $data_source = $self->data_source;
1140
+    croak qq{"data_source" must be specified to connect()"}
1141
+      unless $data_source;
1142
+    my $user        = $self->user;
1143
+    my $password    = $self->password;
1144
+    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1145
+    
1146
+    # Connect
1147
+    my $dbh = eval {DBI->connect(
1148
+        $data_source,
1149
+        $user,
1150
+        $password,
1151
+        {
1152
+            %{$self->default_dbi_option},
1153
+            %$dbi_option
1154
+        }
1155
+    )};
1156
+    
1157
+    # Connect error
1158
+    croak $@ if $@;
1159
+    
1160
+    return $dbh;
1161
+}
1162
+
1129 1163
 sub _croak {
1130 1164
     my ($self, $error, $append) = @_;
1131 1165
     $append ||= "";
... ...
@@ -1434,13 +1468,6 @@ default to 1.
1434 1468
 
1435 1469
 Data source, used when C<connect()> is executed.
1436 1470
 
1437
-=head2 C<dbh>
1438
-
1439
-    my $dbh = $dbi->dbh;
1440
-    $dbi    = $dbi->dbh($dbh);
1441
-
1442
-Database handle of L<DBI>.
1443
-
1444 1471
 =head2 C<dbi_option>
1445 1472
 
1446 1473
     my $dbi_option = $dbi->dbi_option;
... ...
@@ -1463,6 +1490,11 @@ default to the following values.
1463 1490
         AutoCommit => 1,
1464 1491
     }
1465 1492
 
1493
+You should not change C<AutoCommit> value directly
1494
+to check if the process is in transaction correctly.
1495
+L<DBIx::Custom> determin the process is in transaction
1496
+if AutoCommit is 0. 
1497
+
1466 1498
 =head2 C<filters>
1467 1499
 
1468 1500
     my $filters = $dbi->filters;
... ...
@@ -1562,6 +1594,16 @@ instead of suger methods.
1562 1594
 
1563 1595
     $dbi->execute($query, {author => 'Ken', title => '%Perl%'});
1564 1596
 
1597
+=head2 C<dbh>
1598
+
1599
+    my $dbh = $dbi->dbh;
1600
+    $dbi    = $dbi->dbh($dbh);
1601
+
1602
+Get and set database handle of L<DBI>.
1603
+
1604
+If process is changed by forking, new connection is created
1605
+and get new database hande ofL<DBI>. This feature is EXPERIMETNAL.
1606
+
1565 1607
 =head2 C<execute>
1566 1608
 
1567 1609
     my $result = $dbi->execute($query,  param => $params, filter => \@filter);
+47
t/dbix-custom-mysql-private.t
... ...
@@ -30,6 +30,7 @@ sub connect_info {
30 30
 my $dbi;
31 31
 my $dbname;
32 32
 my $rows;
33
+my $result;
33 34
 
34 35
 # Constant varialbes for test
35 36
 my $CREATE_TABLE = {
... ...
@@ -59,6 +60,7 @@ $dbi = DBIx::Custom->connect(
59 60
     user => $USER,
60 61
     password => $PASSWORD
61 62
 );
63
+$dbi->delete_all(table => 'table1');
62 64
 $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
63 65
 $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 4});
64 66
 $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 6});
... ...
@@ -93,3 +95,48 @@ $rows = $dbi->select(
93 95
 )->fetch_hash_all;
94 96
 is_deeply($rows, [{key1 => 1, key2 => 2}]);
95 97
 $dbi->delete_all(table => 'table1');
98
+
99
+
100
+test 'fork';
101
+{
102
+    $dbi = DBIx::Custom->connect(
103
+        data_source => "dbi:mysql:database=$DATABASE",
104
+        user => $USER,
105
+        password => $PASSWORD
106
+    );
107
+    $dbi->delete_all(table => 'table1');
108
+    $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
109
+    die "Can't fork" unless defined (my $pid = fork);
110
+
111
+    if ($pid) {
112
+        # Parent
113
+        my $result = $dbi->select(table => 'table1');
114
+        is_deeply($result->fetch_hash_first, {key1 => 1, key2 => 2});
115
+    }
116
+    else {
117
+        # Child
118
+        my $result = $dbi->select(table => 'table1');
119
+        die "Not OK" unless $result->fetch_hash_first->{key1} == 1;
120
+    }
121
+}
122
+
123
+test 'fork in transaction';
124
+{
125
+    $dbi = DBIx::Custom->connect(
126
+        data_source => "dbi:mysql:database=$DATABASE",
127
+        user => $USER,
128
+        password => $PASSWORD
129
+    );
130
+    
131
+    $dbi->begin_work;
132
+    die "Can't fork" unless defined (my $pid = fork);
133
+    
134
+    if ($pid) {
135
+        # Parent
136
+    }
137
+    else {
138
+        # Child
139
+        eval {$dbi->select(table => 'table1') };
140
+        die "Not OK" unless $@ =~ /transaction/;
141
+    }
142
+}