Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DBIx/Class/Storage.pm |
Statements | Executed 3331 statements in 17.0ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
294 | 1 | 1 | 7.26ms | 34.9s | txn_commit | DBIx::Class::Storage::
294 | 1 | 1 | 5.54ms | 44.3ms | txn_begin | DBIx::Class::Storage::
294 | 2 | 2 | 2.69ms | 74.2ms | txn_scope_guard | DBIx::Class::Storage::
1 | 1 | 1 | 749µs | 1.73ms | BEGIN@17 | DBIx::Class::Storage::
6 | 1 | 1 | 99µs | 304µs | new | DBIx::Class::Storage::
6 | 1 | 1 | 49µs | 206µs | set_schema | DBIx::Class::Storage::
4 | 2 | 1 | 46µs | 4.72ms | throw_exception | DBIx::Class::Storage::
1 | 1 | 1 | 15µs | 17µs | BEGIN@3 | DBIx::Class::Storage::
1 | 1 | 1 | 13µs | 20µs | BEGIN@4 | DBIx::Class::Storage::
1 | 1 | 1 | 11µs | 57µs | BEGIN@16 | DBIx::Class::Storage::
1 | 1 | 1 | 9µs | 110µs | BEGIN@15 | DBIx::Class::Storage::
1 | 1 | 1 | 9µs | 18µs | BEGIN@7 | DBIx::Class::Storage::
1 | 1 | 1 | 8µs | 43µs | BEGIN@18 | DBIx::Class::Storage::
1 | 1 | 1 | 8µs | 78µs | BEGIN@6 | DBIx::Class::Storage::
1 | 1 | 1 | 7µs | 58µs | BEGIN@12 | DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION::
1 | 1 | 1 | 6µs | 172µs | BEGIN@19 | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | __ANON__[:185] | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | __ANON__[:198] | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | __ANON__[:212] | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | __ANON__[:238] | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | __ANON__[:242] | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | __ANON__[:244] | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | __ANON__[:258] | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | __ANON__[:549] | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | __ANON__[:553] | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | _svp_generate_name | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | columns_info_for | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | connect_info | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | connected | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | cursor | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | debugcb | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | debugfh | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | debugobj | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | delete | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | deploy | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | disconnect | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | ensure_connected | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | insert | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | select | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | select_single | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | sql_maker | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | svp_begin | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | svp_release | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | svp_rollback | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | txn_do | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | txn_rollback | DBIx::Class::Storage::
0 | 0 | 0 | 0s | 0s | update | DBIx::Class::Storage::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package DBIx::Class::Storage; | ||||
2 | |||||
3 | 3 | 22µs | 2 | 19µs | # spent 17µs (15+2) within DBIx::Class::Storage::BEGIN@3 which was called:
# once (15µs+2µs) by base::import at line 3 # spent 17µs making 1 call to DBIx::Class::Storage::BEGIN@3
# spent 2µs making 1 call to strict::import |
4 | 3 | 20µs | 2 | 28µs | # spent 20µs (13+7) within DBIx::Class::Storage::BEGIN@4 which was called:
# once (13µs+7µs) by base::import at line 4 # spent 20µs making 1 call to DBIx::Class::Storage::BEGIN@4
# spent 7µs making 1 call to warnings::import |
5 | |||||
6 | 3 | 18µs | 2 | 78µs | # spent 78µs (8+70) within DBIx::Class::Storage::BEGIN@6 which was called:
# once (8µs+70µs) by base::import at line 6 # spent 78µs making 1 call to DBIx::Class::Storage::BEGIN@6
# spent 70µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 70µs |
7 | 3 | 31µs | 2 | 27µs | # spent 18µs (9+9) within DBIx::Class::Storage::BEGIN@7 which was called:
# once (9µs+9µs) by base::import at line 7 # spent 18µs making 1 call to DBIx::Class::Storage::BEGIN@7
# spent 9µs making 1 call to mro::import |
8 | |||||
9 | { | ||||
10 | 1 | 800ns | package # Hide from PAUSE | ||
11 | DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION; | ||||
12 | 3 | 138µs | 2 | 58µs | # spent 58µs (7+51) within DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION::BEGIN@12 which was called:
# once (7µs+51µs) by base::import at line 12 # spent 58µs making 1 call to DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION::BEGIN@12
# spent 51µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 51µs |
13 | } | ||||
14 | |||||
15 | 3 | 24µs | 2 | 211µs | # spent 110µs (9+101) within DBIx::Class::Storage::BEGIN@15 which was called:
# once (9µs+101µs) by base::import at line 15 # spent 110µs making 1 call to DBIx::Class::Storage::BEGIN@15
# spent 101µs making 1 call to DBIx::Class::Carp::import |
16 | 3 | 23µs | 2 | 102µs | # spent 57µs (11+46) within DBIx::Class::Storage::BEGIN@16 which was called:
# once (11µs+46µs) by base::import at line 16 # spent 57µs making 1 call to DBIx::Class::Storage::BEGIN@16
# spent 46µs making 1 call to Exporter::import |
17 | 3 | 86µs | 1 | 1.73ms | # spent 1.73ms (749µs+986µs) within DBIx::Class::Storage::BEGIN@17 which was called:
# once (749µs+986µs) by base::import at line 17 # spent 1.73ms making 1 call to DBIx::Class::Storage::BEGIN@17 |
18 | 3 | 20µs | 2 | 77µs | # spent 43µs (8+35) within DBIx::Class::Storage::BEGIN@18 which was called:
# once (8µs+35µs) by base::import at line 18 # spent 43µs making 1 call to DBIx::Class::Storage::BEGIN@18
# spent 34µs making 1 call to Exporter::import |
19 | 3 | 1.57ms | 2 | 338µs | # spent 172µs (6+166) within DBIx::Class::Storage::BEGIN@19 which was called:
# once (6µs+166µs) by base::import at line 19 # spent 172µs making 1 call to DBIx::Class::Storage::BEGIN@19
# spent 166µs making 1 call to namespace::clean::import |
20 | |||||
21 | 1 | 27µs | 1 | 353µs | __PACKAGE__->mk_group_accessors(simple => qw/debug schema transaction_depth auto_savepoint savepoints/); # spent 353µs making 1 call to Class::Accessor::Grouped::mk_group_accessors |
22 | 1 | 2µs | 1 | 209µs | __PACKAGE__->mk_group_accessors(component_class => 'cursor_class'); # spent 209µs making 1 call to Class::Accessor::Grouped::mk_group_accessors |
23 | |||||
24 | 1 | 1µs | 1 | 40µs | __PACKAGE__->cursor_class('DBIx::Class::Cursor'); # spent 40µs making 1 call to DBIx::Class::Storage::cursor_class |
25 | |||||
26 | sub cursor { shift->cursor_class(@_); } | ||||
27 | |||||
28 | =head1 NAME | ||||
29 | |||||
30 | DBIx::Class::Storage - Generic Storage Handler | ||||
31 | |||||
32 | =head1 DESCRIPTION | ||||
33 | |||||
34 | A base implementation of common Storage methods. For specific | ||||
35 | information about L<DBI>-based storage, see L<DBIx::Class::Storage::DBI>. | ||||
36 | |||||
37 | =head1 METHODS | ||||
38 | |||||
39 | =head2 new | ||||
40 | |||||
41 | Arguments: $schema | ||||
42 | |||||
43 | Instantiates the Storage object. | ||||
44 | |||||
45 | =cut | ||||
46 | |||||
47 | # spent 304µs (99+206) within DBIx::Class::Storage::new which was called 6 times, avg 51µs/call:
# 6 times (99µs+206µs) by DBIx::Class::Storage::DBI::new at line 28 of mro.pm, avg 51µs/call | ||||
48 | 36 | 99µs | my ($self, $schema) = @_; | ||
49 | |||||
50 | $self = ref $self if ref $self; | ||||
51 | |||||
52 | my $new = bless( { | ||||
53 | transaction_depth => 0, | ||||
54 | savepoints => [], | ||||
55 | }, $self); | ||||
56 | |||||
57 | 6 | 206µs | $new->set_schema($schema); # spent 206µs making 6 calls to DBIx::Class::Storage::set_schema, avg 34µs/call | ||
58 | $new->debug(1) | ||||
59 | if $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} || $ENV{DBIC_TRACE}; | ||||
60 | |||||
61 | $new; | ||||
62 | } | ||||
63 | |||||
64 | =head2 set_schema | ||||
65 | |||||
66 | Used to reset the schema class or object which owns this | ||||
67 | storage object, such as during L<DBIx::Class::Schema/clone>. | ||||
68 | |||||
69 | =cut | ||||
70 | |||||
71 | # spent 206µs (49+157) within DBIx::Class::Storage::set_schema which was called 6 times, avg 34µs/call:
# 6 times (49µs+157µs) by DBIx::Class::Storage::new at line 57, avg 34µs/call | ||||
72 | 18 | 53µs | my ($self, $schema) = @_; | ||
73 | 2 | 151µs | $self->schema($schema); # spent 150µs making 1 call to DBIx::Class::Storage::schema
# spent 900ns making 1 call to DBIx::Class::Storage::DBI::schema | ||
74 | 6 | 5µs | weaken $self->{schema} if ref $self->{schema}; # spent 5µs making 6 calls to Scalar::Util::weaken, avg 800ns/call | ||
75 | } | ||||
76 | |||||
77 | =head2 connected | ||||
78 | |||||
79 | Returns true if we have an open storage connection, false | ||||
80 | if it is not (yet) open. | ||||
81 | |||||
82 | =cut | ||||
83 | |||||
84 | sub connected { die "Virtual method!" } | ||||
85 | |||||
86 | =head2 disconnect | ||||
87 | |||||
88 | Closes any open storage connection unconditionally. | ||||
89 | |||||
90 | =cut | ||||
91 | |||||
92 | sub disconnect { die "Virtual method!" } | ||||
93 | |||||
94 | =head2 ensure_connected | ||||
95 | |||||
96 | Initiate a connection to the storage if one isn't already open. | ||||
97 | |||||
98 | =cut | ||||
99 | |||||
100 | sub ensure_connected { die "Virtual method!" } | ||||
101 | |||||
102 | =head2 throw_exception | ||||
103 | |||||
104 | Throws an exception - croaks. | ||||
105 | |||||
106 | =cut | ||||
107 | |||||
108 | # spent 4.72ms (46µs+4.67) within DBIx::Class::Storage::throw_exception which was called 4 times, avg 1.18ms/call:
# 2 times (37µs+4.56ms) by DBIx::Class::Storage::DBI::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DBIx/Class/Storage/DBI.pm:1297] at line 1289 of DBIx/Class/Storage/DBI.pm, avg 2.30ms/call
# 2 times (8µs+113µs) by DBIx::Class::Storage::DBI::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DBIx/Class/Storage/DBI.pm:800] at line 791 of DBIx/Class/Storage/DBI.pm, avg 61µs/call | ||||
109 | 8 | 41µs | my $self = shift; | ||
110 | |||||
111 | 6 | 4.67ms | if (ref $self and $self->schema) { # spent 4.67ms making 4 calls to DBIx::Class::Schema::throw_exception, avg 1.17ms/call
# spent 2µs making 2 calls to DBIx::Class::Storage::DBI::schema, avg 1µs/call | ||
112 | $self->schema->throw_exception(@_); | ||||
113 | } | ||||
114 | else { | ||||
115 | DBIx::Class::Exception->throw(@_); | ||||
116 | } | ||||
117 | } | ||||
118 | |||||
119 | =head2 txn_do | ||||
120 | |||||
121 | =over 4 | ||||
122 | |||||
123 | =item Arguments: C<$coderef>, @coderef_args? | ||||
124 | |||||
125 | =item Return Value: The return value of $coderef | ||||
126 | |||||
127 | =back | ||||
128 | |||||
129 | Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically, | ||||
130 | returning its result (if any). If an exception is caught, a rollback is issued | ||||
131 | and the exception is rethrown. If the rollback fails, (i.e. throws an | ||||
132 | exception) an exception is thrown that includes a "Rollback failed" message. | ||||
133 | |||||
134 | For example, | ||||
135 | |||||
136 | my $author_rs = $schema->resultset('Author')->find(1); | ||||
137 | my @titles = qw/Night Day It/; | ||||
138 | |||||
139 | my $coderef = sub { | ||||
140 | # If any one of these fails, the entire transaction fails | ||||
141 | $author_rs->create_related('books', { | ||||
142 | title => $_ | ||||
143 | }) foreach (@titles); | ||||
144 | |||||
145 | return $author->books; | ||||
146 | }; | ||||
147 | |||||
148 | my $rs; | ||||
149 | try { | ||||
150 | $rs = $schema->txn_do($coderef); | ||||
151 | } catch { | ||||
152 | my $error = shift; | ||||
153 | # Transaction failed | ||||
154 | die "something terrible has happened!" | ||||
155 | if ($error =~ /Rollback failed/); # Rollback failed | ||||
156 | |||||
157 | deal_with_failed_transaction(); | ||||
158 | }; | ||||
159 | |||||
160 | In a nested transaction (calling txn_do() from within a txn_do() coderef) only | ||||
161 | the outermost transaction will issue a L</txn_commit>, and txn_do() can be | ||||
162 | called in void, scalar and list context and it will behave as expected. | ||||
163 | |||||
164 | Please note that all of the code in your coderef, including non-DBIx::Class | ||||
165 | code, is part of a transaction. This transaction may fail out halfway, or | ||||
166 | it may get partially double-executed (in the case that our DB connection | ||||
167 | failed halfway through the transaction, in which case we reconnect and | ||||
168 | restart the txn). Therefore it is best that any side-effects in your coderef | ||||
169 | are idempotent (that is, can be re-executed multiple times and get the | ||||
170 | same result), and that you check up on your side-effects in the case of | ||||
171 | transaction failure. | ||||
172 | |||||
173 | =cut | ||||
174 | |||||
175 | sub txn_do { | ||||
176 | my $self = shift; | ||||
177 | my $coderef = shift; | ||||
178 | |||||
179 | ref $coderef eq 'CODE' or $self->throw_exception | ||||
180 | ('$coderef must be a CODE reference'); | ||||
181 | |||||
182 | my $abort_txn = sub { | ||||
183 | my ($self, $exception) = @_; | ||||
184 | |||||
185 | my $rollback_exception = try { $self->txn_rollback; undef } catch { shift }; | ||||
186 | |||||
187 | if ( $rollback_exception and ( | ||||
188 | ! defined blessed $rollback_exception | ||||
189 | or | ||||
190 | ! $rollback_exception->isa('DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION') | ||||
191 | ) ) { | ||||
192 | $self->throw_exception( | ||||
193 | "Transaction aborted: ${exception}. " | ||||
194 | . "Rollback failed: ${rollback_exception}" | ||||
195 | ); | ||||
196 | } | ||||
197 | $self->throw_exception($exception); | ||||
198 | }; | ||||
199 | |||||
200 | # take a ref instead of a copy, to preserve coderef @_ aliasing semantics | ||||
201 | my $args = \@_; | ||||
202 | |||||
203 | # do not turn on until a succesful txn_begin | ||||
204 | my $attempt_commit = 0; | ||||
205 | |||||
206 | my $txn_init_depth = $self->transaction_depth; | ||||
207 | |||||
208 | try { | ||||
209 | $self->txn_begin; | ||||
210 | $attempt_commit = 1; | ||||
211 | $coderef->(@$args) | ||||
212 | } | ||||
213 | catch { | ||||
214 | $attempt_commit = 0; | ||||
215 | |||||
216 | # init depth of > 0 implies nesting or non-autocommit (either way no retry) | ||||
217 | if($txn_init_depth or $self->connected ) { | ||||
218 | $abort_txn->($self, $_); | ||||
219 | } | ||||
220 | else { | ||||
221 | carp "Retrying txn_do($coderef) after catching disconnected exception: $_" | ||||
222 | if $ENV{DBIC_STORAGE_RETRY_DEBUG}; | ||||
223 | |||||
224 | $self->_populate_dbh; | ||||
225 | |||||
226 | # if txn_depth is > 1 this means something was done to the | ||||
227 | # original $dbh, otherwise we would not get past the if() above | ||||
228 | $self->throw_exception(sprintf | ||||
229 | 'Unexpected transaction depth of %d on freshly connected handle', | ||||
230 | $self->transaction_depth, | ||||
231 | ) if $self->transaction_depth; | ||||
232 | |||||
233 | $self->txn_begin; | ||||
234 | $attempt_commit = 1; | ||||
235 | |||||
236 | try { | ||||
237 | $coderef->(@$args) | ||||
238 | } | ||||
239 | catch { | ||||
240 | $attempt_commit = 0; | ||||
241 | $abort_txn->($self, $_) | ||||
242 | }; | ||||
243 | }; | ||||
244 | } | ||||
245 | finally { | ||||
246 | if ($attempt_commit) { | ||||
247 | my $delta_txn = (1 + $txn_init_depth) - $self->transaction_depth; | ||||
248 | |||||
249 | if ($delta_txn) { | ||||
250 | # a rollback in a top-level txn_do is valid-ish (seen in the wild and our own tests) | ||||
251 | carp "Unexpected reduction of transaction depth by $delta_txn after execution of $coderef, skipping txn_do's commit" | ||||
252 | unless $delta_txn == 1 and $self->transaction_depth == 0; | ||||
253 | } | ||||
254 | else { | ||||
255 | $self->txn_commit; | ||||
256 | } | ||||
257 | } | ||||
258 | }; | ||||
259 | } | ||||
260 | |||||
261 | =head2 txn_begin | ||||
262 | |||||
263 | Starts a transaction. | ||||
264 | |||||
265 | See the preferred L</txn_do> method, which allows for | ||||
266 | an entire code block to be executed transactionally. | ||||
267 | |||||
268 | =cut | ||||
269 | |||||
270 | # spent 44.3ms (5.54+38.7) within DBIx::Class::Storage::txn_begin which was called 294 times, avg 151µs/call:
# 294 times (5.54ms+38.7ms) by DBIx::Class::Storage::DBI::txn_begin at line 28 of mro.pm, avg 151µs/call | ||||
271 | 882 | 4.28ms | my $self = shift; | ||
272 | |||||
273 | 588 | 1.47ms | 2 | 178µs | if($self->transaction_depth == 0) { # spent 177µs making 1 call to DBIx::Class::Storage::transaction_depth
# spent 2µs making 1 call to DBIx::Class::Storage::DBI::SQLite::transaction_depth |
274 | 1 | 2µs | $self->debugobj->txn_begin() # spent 2µs making 1 call to DBIx::Class::Storage::DBI::SQLite::debug | ||
275 | if $self->debug; | ||||
276 | 294 | 38.5ms | $self->_exec_txn_begin; # spent 38.5ms making 294 calls to DBIx::Class::Storage::DBI::_exec_txn_begin, avg 131µs/call | ||
277 | } | ||||
278 | elsif ($self->auto_savepoint) { | ||||
279 | $self->svp_begin; | ||||
280 | } | ||||
281 | $self->{transaction_depth}++; | ||||
282 | |||||
283 | } | ||||
284 | |||||
285 | =head2 txn_commit | ||||
286 | |||||
287 | Issues a commit of the current transaction. | ||||
288 | |||||
289 | It does I<not> perform an actual storage commit unless there's a DBIx::Class | ||||
290 | transaction currently in effect (i.e. you called L</txn_begin>). | ||||
291 | |||||
292 | =cut | ||||
293 | |||||
294 | # spent 34.9s (7.26ms+34.8) within DBIx::Class::Storage::txn_commit which was called 294 times, avg 119ms/call:
# 294 times (7.26ms+34.8s) by DBIx::Class::Storage::DBI::txn_commit at line 28 of mro.pm, avg 119ms/call | ||||
295 | 588 | 3.12ms | my $self = shift; | ||
296 | |||||
297 | 882 | 3.48ms | 1 | 700ns | if ($self->transaction_depth == 1) { # spent 700ns making 1 call to DBIx::Class::Storage::DBI::SQLite::transaction_depth |
298 | 1 | 1µs | $self->debugobj->txn_commit() if $self->debug; # spent 1µs making 1 call to DBIx::Class::Storage::DBI::SQLite::debug | ||
299 | 294 | 34.8s | $self->_exec_txn_commit; # spent 34.8s making 294 calls to DBIx::Class::Storage::DBI::_exec_txn_commit, avg 119ms/call | ||
300 | $self->{transaction_depth}--; | ||||
301 | } | ||||
302 | elsif($self->transaction_depth > 1) { | ||||
303 | $self->{transaction_depth}--; | ||||
304 | $self->svp_release if $self->auto_savepoint; | ||||
305 | } | ||||
306 | else { | ||||
307 | $self->throw_exception( 'Refusing to commit without a started transaction' ); | ||||
308 | } | ||||
309 | } | ||||
310 | |||||
311 | =head2 txn_rollback | ||||
312 | |||||
313 | Issues a rollback of the current transaction. A nested rollback will | ||||
314 | throw a L<DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION> exception, | ||||
315 | which allows the rollback to propagate to the outermost transaction. | ||||
316 | |||||
317 | =cut | ||||
318 | |||||
319 | sub txn_rollback { | ||||
320 | my $self = shift; | ||||
321 | |||||
322 | if ($self->transaction_depth == 1) { | ||||
323 | $self->debugobj->txn_rollback() if $self->debug; | ||||
324 | $self->_exec_txn_rollback; | ||||
325 | $self->{transaction_depth}--; | ||||
326 | } | ||||
327 | elsif ($self->transaction_depth > 1) { | ||||
328 | $self->{transaction_depth}--; | ||||
329 | |||||
330 | if ($self->auto_savepoint) { | ||||
331 | $self->svp_rollback; | ||||
332 | $self->svp_release; | ||||
333 | } | ||||
334 | else { | ||||
335 | DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->throw( | ||||
336 | "A txn_rollback in nested transaction is ineffective! (depth $self->{transaction_depth})" | ||||
337 | ); | ||||
338 | } | ||||
339 | } | ||||
340 | else { | ||||
341 | $self->throw_exception( 'Refusing to roll back without a started transaction' ); | ||||
342 | } | ||||
343 | } | ||||
344 | |||||
345 | =head2 svp_begin | ||||
346 | |||||
347 | Arguments: $savepoint_name? | ||||
348 | |||||
349 | Created a new savepoint using the name provided as argument. If no name | ||||
350 | is provided, a random name will be used. | ||||
351 | |||||
352 | =cut | ||||
353 | |||||
354 | sub svp_begin { | ||||
355 | my ($self, $name) = @_; | ||||
356 | |||||
357 | $self->throw_exception ("You can't use savepoints outside a transaction") | ||||
358 | unless $self->transaction_depth; | ||||
359 | |||||
360 | my $exec = $self->can('_exec_svp_begin') | ||||
361 | or $self->throw_exception ("Your Storage implementation doesn't support savepoints"); | ||||
362 | |||||
363 | $name = $self->_svp_generate_name | ||||
364 | unless defined $name; | ||||
365 | |||||
366 | push @{ $self->{savepoints} }, $name; | ||||
367 | |||||
368 | $self->debugobj->svp_begin($name) if $self->debug; | ||||
369 | |||||
370 | $exec->($self, $name); | ||||
371 | } | ||||
372 | |||||
373 | sub _svp_generate_name { | ||||
374 | my ($self) = @_; | ||||
375 | return 'savepoint_'.scalar(@{ $self->{'savepoints'} }); | ||||
376 | } | ||||
377 | |||||
378 | |||||
379 | =head2 svp_release | ||||
380 | |||||
381 | Arguments: $savepoint_name? | ||||
382 | |||||
383 | Release the savepoint provided as argument. If none is provided, | ||||
384 | release the savepoint created most recently. This will implicitly | ||||
385 | release all savepoints created after the one explicitly released as well. | ||||
386 | |||||
387 | =cut | ||||
388 | |||||
389 | sub svp_release { | ||||
390 | my ($self, $name) = @_; | ||||
391 | |||||
392 | $self->throw_exception ("You can't use savepoints outside a transaction") | ||||
393 | unless $self->transaction_depth; | ||||
394 | |||||
395 | my $exec = $self->can('_exec_svp_release') | ||||
396 | or $self->throw_exception ("Your Storage implementation doesn't support savepoints"); | ||||
397 | |||||
398 | if (defined $name) { | ||||
399 | my @stack = @{ $self->savepoints }; | ||||
400 | my $svp; | ||||
401 | |||||
402 | do { $svp = pop @stack } until $svp eq $name; | ||||
403 | |||||
404 | $self->throw_exception ("Savepoint '$name' does not exist") | ||||
405 | unless $svp; | ||||
406 | |||||
407 | $self->savepoints(\@stack); # put back what's left | ||||
408 | } | ||||
409 | else { | ||||
410 | $name = pop @{ $self->savepoints } | ||||
411 | or $self->throw_exception('No savepoints to release');; | ||||
412 | } | ||||
413 | |||||
414 | $self->debugobj->svp_release($name) if $self->debug; | ||||
415 | |||||
416 | $exec->($self, $name); | ||||
417 | } | ||||
418 | |||||
419 | =head2 svp_rollback | ||||
420 | |||||
421 | Arguments: $savepoint_name? | ||||
422 | |||||
423 | Rollback to the savepoint provided as argument. If none is provided, | ||||
424 | rollback to the savepoint created most recently. This will implicitly | ||||
425 | release all savepoints created after the savepoint we rollback to. | ||||
426 | |||||
427 | =cut | ||||
428 | |||||
429 | sub svp_rollback { | ||||
430 | my ($self, $name) = @_; | ||||
431 | |||||
432 | $self->throw_exception ("You can't use savepoints outside a transaction") | ||||
433 | unless $self->transaction_depth; | ||||
434 | |||||
435 | my $exec = $self->can('_exec_svp_rollback') | ||||
436 | or $self->throw_exception ("Your Storage implementation doesn't support savepoints"); | ||||
437 | |||||
438 | if (defined $name) { | ||||
439 | my @stack = @{ $self->savepoints }; | ||||
440 | my $svp; | ||||
441 | |||||
442 | # a rollback doesn't remove the named savepoint, | ||||
443 | # only everything after it | ||||
444 | while (@stack and $stack[-1] ne $name) { | ||||
445 | pop @stack | ||||
446 | }; | ||||
447 | |||||
448 | $self->throw_exception ("Savepoint '$name' does not exist") | ||||
449 | unless @stack; | ||||
450 | |||||
451 | $self->savepoints(\@stack); # put back what's left | ||||
452 | } | ||||
453 | else { | ||||
454 | $name = $self->savepoints->[-1] | ||||
455 | or $self->throw_exception('No savepoints to rollback');; | ||||
456 | } | ||||
457 | |||||
458 | $self->debugobj->svp_rollback($name) if $self->debug; | ||||
459 | |||||
460 | $exec->($self, $name); | ||||
461 | } | ||||
462 | |||||
463 | =for comment | ||||
464 | |||||
465 | =head2 txn_scope_guard | ||||
466 | |||||
467 | An alternative way of transaction handling based on | ||||
468 | L<DBIx::Class::Storage::TxnScopeGuard>: | ||||
469 | |||||
470 | my $txn_guard = $storage->txn_scope_guard; | ||||
471 | |||||
472 | $row->col1("val1"); | ||||
473 | $row->update; | ||||
474 | |||||
475 | $txn_guard->commit; | ||||
476 | |||||
477 | If an exception occurs, or the guard object otherwise leaves the scope | ||||
478 | before C<< $txn_guard->commit >> is called, the transaction will be rolled | ||||
479 | back by an explicit L</txn_rollback> call. In essence this is akin to | ||||
480 | using a L</txn_begin>/L</txn_commit> pair, without having to worry | ||||
481 | about calling L</txn_rollback> at the right places. Note that since there | ||||
482 | is no defined code closure, there will be no retries and other magic upon | ||||
483 | database disconnection. If you need such functionality see L</txn_do>. | ||||
484 | |||||
485 | =cut | ||||
486 | |||||
487 | # spent 74.2ms (2.69+71.5) within DBIx::Class::Storage::txn_scope_guard which was called 294 times, avg 252µs/call:
# 147 times (1.63ms+46.2ms) by DBIx::Class::Schema::txn_scope_guard at line 676 of DBIx/Class/Schema.pm, avg 326µs/call
# 147 times (1.07ms+25.3ms) by DBIx::Class::Row::insert at line 338 of DBIx/Class/Row.pm, avg 179µs/call | ||||
488 | 294 | 2.39ms | 294 | 71.5ms | return DBIx::Class::Storage::TxnScopeGuard->new($_[0]); # spent 71.5ms making 294 calls to DBIx::Class::Storage::TxnScopeGuard::new, avg 243µs/call |
489 | } | ||||
490 | |||||
491 | =head2 sql_maker | ||||
492 | |||||
493 | Returns a C<sql_maker> object - normally an object of class | ||||
494 | C<DBIx::Class::SQLMaker>. | ||||
495 | |||||
496 | =cut | ||||
497 | |||||
498 | sub sql_maker { die "Virtual method!" } | ||||
499 | |||||
500 | =head2 debug | ||||
501 | |||||
502 | Causes trace information to be emitted on the L</debugobj> object. | ||||
503 | (or C<STDERR> if L</debugobj> has not specifically been set). | ||||
504 | |||||
505 | This is the equivalent to setting L</DBIC_TRACE> in your | ||||
506 | shell environment. | ||||
507 | |||||
508 | =head2 debugfh | ||||
509 | |||||
510 | Set or retrieve the filehandle used for trace/debug output. This should be | ||||
511 | an IO::Handle compatible object (only the C<print> method is used. Initially | ||||
512 | set to be STDERR - although see information on the | ||||
513 | L<DBIC_TRACE> environment variable. | ||||
514 | |||||
515 | =cut | ||||
516 | |||||
517 | sub debugfh { | ||||
518 | my $self = shift; | ||||
519 | |||||
520 | if ($self->debugobj->can('debugfh')) { | ||||
521 | return $self->debugobj->debugfh(@_); | ||||
522 | } | ||||
523 | } | ||||
524 | |||||
525 | =head2 debugobj | ||||
526 | |||||
527 | Sets or retrieves the object used for metric collection. Defaults to an instance | ||||
528 | of L<DBIx::Class::Storage::Statistics> that is compatible with the original | ||||
529 | method of using a coderef as a callback. See the aforementioned Statistics | ||||
530 | class for more information. | ||||
531 | |||||
532 | =cut | ||||
533 | |||||
534 | sub debugobj { | ||||
535 | my $self = shift; | ||||
536 | |||||
537 | if (@_) { | ||||
538 | return $self->{debugobj} = $_[0]; | ||||
539 | } | ||||
540 | |||||
541 | $self->{debugobj} ||= do { | ||||
542 | if (my $profile = $ENV{DBIC_TRACE_PROFILE}) { | ||||
543 | require DBIx::Class::Storage::Debug::PrettyPrint; | ||||
544 | if ($profile =~ /^\.?\//) { | ||||
545 | require Config::Any; | ||||
546 | |||||
547 | my $cfg = try { | ||||
548 | Config::Any->load_files({ files => [$profile], use_ext => 1 }); | ||||
549 | } catch { | ||||
550 | # sanitize the error message a bit | ||||
551 | $_ =~ s/at \s+ .+ Storage\.pm \s line \s \d+ $//x; | ||||
552 | $self->throw_exception("Failure processing \$ENV{DBIC_TRACE_PROFILE}: $_"); | ||||
553 | }; | ||||
554 | |||||
555 | DBIx::Class::Storage::Debug::PrettyPrint->new(values %{$cfg->[0]}); | ||||
556 | } | ||||
557 | else { | ||||
558 | DBIx::Class::Storage::Debug::PrettyPrint->new({ profile => $profile }); | ||||
559 | } | ||||
560 | } | ||||
561 | else { | ||||
562 | require DBIx::Class::Storage::Statistics; | ||||
563 | DBIx::Class::Storage::Statistics->new | ||||
564 | } | ||||
565 | }; | ||||
566 | } | ||||
567 | |||||
568 | =head2 debugcb | ||||
569 | |||||
570 | Sets a callback to be executed each time a statement is run; takes a sub | ||||
571 | reference. Callback is executed as $sub->($op, $info) where $op is | ||||
572 | SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed. | ||||
573 | |||||
574 | See L</debugobj> for a better way. | ||||
575 | |||||
576 | =cut | ||||
577 | |||||
578 | sub debugcb { | ||||
579 | my $self = shift; | ||||
580 | |||||
581 | if ($self->debugobj->can('callback')) { | ||||
582 | return $self->debugobj->callback(@_); | ||||
583 | } | ||||
584 | } | ||||
585 | |||||
586 | =head2 cursor_class | ||||
587 | |||||
588 | The cursor class for this Storage object. | ||||
589 | |||||
590 | =cut | ||||
591 | |||||
592 | =head2 deploy | ||||
593 | |||||
594 | Deploy the tables to storage (CREATE TABLE and friends in a SQL-based | ||||
595 | Storage class). This would normally be called through | ||||
596 | L<DBIx::Class::Schema/deploy>. | ||||
597 | |||||
598 | =cut | ||||
599 | |||||
600 | sub deploy { die "Virtual method!" } | ||||
601 | |||||
602 | =head2 connect_info | ||||
603 | |||||
604 | The arguments of C<connect_info> are always a single array reference, | ||||
605 | and are Storage-handler specific. | ||||
606 | |||||
607 | This is normally accessed via L<DBIx::Class::Schema/connection>, which | ||||
608 | encapsulates its argument list in an arrayref before calling | ||||
609 | C<connect_info> here. | ||||
610 | |||||
611 | =cut | ||||
612 | |||||
613 | sub connect_info { die "Virtual method!" } | ||||
614 | |||||
615 | =head2 select | ||||
616 | |||||
617 | Handle a select statement. | ||||
618 | |||||
619 | =cut | ||||
620 | |||||
621 | sub select { die "Virtual method!" } | ||||
622 | |||||
623 | =head2 insert | ||||
624 | |||||
625 | Handle an insert statement. | ||||
626 | |||||
627 | =cut | ||||
628 | |||||
629 | sub insert { die "Virtual method!" } | ||||
630 | |||||
631 | =head2 update | ||||
632 | |||||
633 | Handle an update statement. | ||||
634 | |||||
635 | =cut | ||||
636 | |||||
637 | sub update { die "Virtual method!" } | ||||
638 | |||||
639 | =head2 delete | ||||
640 | |||||
641 | Handle a delete statement. | ||||
642 | |||||
643 | =cut | ||||
644 | |||||
645 | sub delete { die "Virtual method!" } | ||||
646 | |||||
647 | =head2 select_single | ||||
648 | |||||
649 | Performs a select, fetch and return of data - handles a single row | ||||
650 | only. | ||||
651 | |||||
652 | =cut | ||||
653 | |||||
654 | sub select_single { die "Virtual method!" } | ||||
655 | |||||
656 | =head2 columns_info_for | ||||
657 | |||||
658 | Returns metadata for the given source's columns. This | ||||
659 | is *deprecated*, and will be removed before 1.0. You should | ||||
660 | be specifying the metadata yourself if you need it. | ||||
661 | |||||
662 | =cut | ||||
663 | |||||
664 | sub columns_info_for { die "Virtual method!" } | ||||
665 | |||||
666 | =head1 ENVIRONMENT VARIABLES | ||||
667 | |||||
668 | =head2 DBIC_TRACE | ||||
669 | |||||
670 | If C<DBIC_TRACE> is set then trace information | ||||
671 | is produced (as when the L</debug> method is set). | ||||
672 | |||||
673 | If the value is of the form C<1=/path/name> then the trace output is | ||||
674 | written to the file C</path/name>. | ||||
675 | |||||
676 | This environment variable is checked when the storage object is first | ||||
677 | created (when you call connect on your schema). So, run-time changes | ||||
678 | to this environment variable will not take effect unless you also | ||||
679 | re-connect on your schema. | ||||
680 | |||||
681 | =head2 DBIC_TRACE_PROFILE | ||||
682 | |||||
683 | If C<DBIC_TRACE_PROFILE> is set, L<DBIx::Class::Storage::PrettyPrint> | ||||
684 | will be used to format the output from C<DBIC_TRACE>. The value it | ||||
685 | is set to is the C<profile> that it will be used. If the value is a | ||||
686 | filename the file is read with L<Config::Any> and the results are | ||||
687 | used as the configuration for tracing. See L<SQL::Abstract::Tree/new> | ||||
688 | for what that structure should look like. | ||||
689 | |||||
690 | |||||
691 | =head2 DBIX_CLASS_STORAGE_DBI_DEBUG | ||||
692 | |||||
693 | Old name for DBIC_TRACE | ||||
694 | |||||
695 | =head1 SEE ALSO | ||||
696 | |||||
697 | L<DBIx::Class::Storage::DBI> - reference storage implementation using | ||||
698 | SQL::Abstract and DBI. | ||||
699 | |||||
700 | =head1 AUTHORS | ||||
701 | |||||
702 | Matt S. Trout <mst@shadowcatsystems.co.uk> | ||||
703 | |||||
704 | Andy Grundman <andy@hybridized.org> | ||||
705 | |||||
706 | =head1 LICENSE | ||||
707 | |||||
708 | You may distribute this code under the same terms as Perl itself. | ||||
709 | |||||
710 | =cut | ||||
711 | |||||
712 | 1 | 37µs | 1 | 556µs | 1; # spent 556µs making 1 call to B::Hooks::EndOfScope::__ANON__[B/Hooks/EndOfScope.pm:26] |