Commit | Line | Data |
4012acd8 |
1 | package DBIx::Class::Storage; |
a62cf8d4 |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
046ad905 |
6 | use base qw/DBIx::Class/; |
2ad62d97 |
7 | use mro 'c3'; |
046ad905 |
8 | |
1a58752c |
9 | use DBIx::Class::Exception; |
6298a324 |
10 | use Scalar::Util 'weaken'; |
942cd0c1 |
11 | use IO::File; |
1bc193ac |
12 | use DBIx::Class::Storage::TxnScopeGuard; |
f43ea814 |
13 | use Try::Tiny; |
fd323bf1 |
14 | use namespace::clean; |
046ad905 |
15 | |
046ad905 |
16 | __PACKAGE__->mk_group_accessors('simple' => qw/debug debugobj schema/); |
e4eb8ee1 |
17 | __PACKAGE__->mk_group_accessors('inherited' => 'cursor_class'); |
18 | |
19 | __PACKAGE__->cursor_class('DBIx::Class::Cursor'); |
20 | |
21 | sub cursor { shift->cursor_class(@_); } |
046ad905 |
22 | |
4012acd8 |
23 | package # Hide from PAUSE |
24 | DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION; |
25 | |
26 | use overload '"' => sub { |
27 | 'DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION' |
28 | }; |
29 | |
30 | sub new { |
31 | my $class = shift; |
32 | my $self = {}; |
33 | return bless $self, $class; |
34 | } |
35 | |
36 | package DBIx::Class::Storage; |
37 | |
046ad905 |
38 | =head1 NAME |
39 | |
40 | DBIx::Class::Storage - Generic Storage Handler |
41 | |
42 | =head1 DESCRIPTION |
43 | |
44 | A base implementation of common Storage methods. For specific |
45 | information about L<DBI>-based storage, see L<DBIx::Class::Storage::DBI>. |
46 | |
47 | =head1 METHODS |
48 | |
49 | =head2 new |
50 | |
51 | Arguments: $schema |
52 | |
53 | Instantiates the Storage object. |
54 | |
55 | =cut |
56 | |
57 | sub new { |
58 | my ($self, $schema) = @_; |
59 | |
60 | $self = ref $self if ref $self; |
61 | |
62 | my $new = {}; |
63 | bless $new, $self; |
64 | |
65 | $new->set_schema($schema); |
b6cd6478 |
66 | my $debugobj; |
67 | if (my $profile = $ENV{DBIC_TRACE_PROFILE}) { |
68 | require DBIx::Class::Storage::Debug::PrettyPrint; |
69 | if ($profile =~ /^\.?\//) { |
70 | require Config::Any; |
71 | my $cfg = Config::Any->load_files({ files => [$profile], use_ext => 1 }); |
72 | |
73 | my ($filename, $config) = %{$cfg->[0]}; |
74 | $debugobj = DBIx::Class::Storage::Debug::PrettyPrint->new($config) |
75 | } else { |
76 | $debugobj = DBIx::Class::Storage::Debug::PrettyPrint->new({ profile => $profile }) |
77 | } |
78 | } else { |
79 | $debugobj = DBIx::Class::Storage::Statistics->new |
80 | } |
81 | $new->debugobj($debugobj); |
046ad905 |
82 | |
83 | my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} |
84 | || $ENV{DBIC_TRACE}; |
85 | |
046ad905 |
86 | $new->debug(1) if $debug_env; |
87 | |
88 | $new; |
89 | } |
90 | |
91 | =head2 set_schema |
92 | |
93 | Used to reset the schema class or object which owns this |
94 | storage object, such as during L<DBIx::Class::Schema/clone>. |
95 | |
96 | =cut |
97 | |
98 | sub set_schema { |
99 | my ($self, $schema) = @_; |
100 | $self->schema($schema); |
6298a324 |
101 | weaken $self->{schema} if ref $self->{schema}; |
046ad905 |
102 | } |
103 | |
104 | =head2 connected |
105 | |
106 | Returns true if we have an open storage connection, false |
107 | if it is not (yet) open. |
108 | |
109 | =cut |
110 | |
a62cf8d4 |
111 | sub connected { die "Virtual method!" } |
046ad905 |
112 | |
113 | =head2 disconnect |
114 | |
115 | Closes any open storage connection unconditionally. |
116 | |
117 | =cut |
118 | |
119 | sub disconnect { die "Virtual method!" } |
120 | |
121 | =head2 ensure_connected |
122 | |
123 | Initiate a connection to the storage if one isn't already open. |
124 | |
125 | =cut |
126 | |
a62cf8d4 |
127 | sub ensure_connected { die "Virtual method!" } |
046ad905 |
128 | |
129 | =head2 throw_exception |
130 | |
131 | Throws an exception - croaks. |
132 | |
133 | =cut |
134 | |
135 | sub throw_exception { |
136 | my $self = shift; |
137 | |
1a58752c |
138 | if ($self->schema) { |
139 | $self->schema->throw_exception(@_); |
140 | } |
141 | else { |
142 | DBIx::Class::Exception->throw(@_); |
143 | } |
046ad905 |
144 | } |
a62cf8d4 |
145 | |
4012acd8 |
146 | =head2 txn_do |
a62cf8d4 |
147 | |
4012acd8 |
148 | =over 4 |
a62cf8d4 |
149 | |
4012acd8 |
150 | =item Arguments: C<$coderef>, @coderef_args? |
a62cf8d4 |
151 | |
4012acd8 |
152 | =item Return Value: The return value of $coderef |
153 | |
154 | =back |
155 | |
156 | Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically, |
157 | returning its result (if any). If an exception is caught, a rollback is issued |
158 | and the exception is rethrown. If the rollback fails, (i.e. throws an |
159 | exception) an exception is thrown that includes a "Rollback failed" message. |
160 | |
161 | For example, |
162 | |
163 | my $author_rs = $schema->resultset('Author')->find(1); |
164 | my @titles = qw/Night Day It/; |
165 | |
166 | my $coderef = sub { |
167 | # If any one of these fails, the entire transaction fails |
168 | $author_rs->create_related('books', { |
169 | title => $_ |
170 | }) foreach (@titles); |
171 | |
172 | return $author->books; |
173 | }; |
174 | |
175 | my $rs; |
20674fcd |
176 | try { |
4012acd8 |
177 | $rs = $schema->txn_do($coderef); |
20674fcd |
178 | } catch { |
6b89ee0b |
179 | my $error = shift; |
20674fcd |
180 | # Transaction failed |
4012acd8 |
181 | die "something terrible has happened!" # |
6b89ee0b |
182 | if ($error =~ /Rollback failed/); # Rollback failed |
4012acd8 |
183 | |
184 | deal_with_failed_transaction(); |
20674fcd |
185 | }; |
4012acd8 |
186 | |
187 | In a nested transaction (calling txn_do() from within a txn_do() coderef) only |
188 | the outermost transaction will issue a L</txn_commit>, and txn_do() can be |
189 | called in void, scalar and list context and it will behave as expected. |
190 | |
05075aee |
191 | Please note that all of the code in your coderef, including non-DBIx::Class |
192 | code, is part of a transaction. This transaction may fail out halfway, or |
193 | it may get partially double-executed (in the case that our DB connection |
194 | failed halfway through the transaction, in which case we reconnect and |
195 | restart the txn). Therefore it is best that any side-effects in your coderef |
196 | are idempotent (that is, can be re-executed multiple times and get the |
197 | same result), and that you check up on your side-effects in the case of |
198 | transaction failure. |
6500d50f |
199 | |
4012acd8 |
200 | =cut |
201 | |
202 | sub txn_do { |
38ed54cd |
203 | my $self = shift; |
204 | my $coderef = shift; |
4012acd8 |
205 | |
206 | ref $coderef eq 'CODE' or $self->throw_exception |
207 | ('$coderef must be a CODE reference'); |
208 | |
209 | my (@return_values, $return_value); |
210 | |
211 | $self->txn_begin; # If this throws an exception, no rollback is needed |
212 | |
213 | my $wantarray = wantarray; # Need to save this since the context |
9780718f |
214 | # inside the try{} block is independent |
4012acd8 |
215 | # of the context that called txn_do() |
38ed54cd |
216 | my $args = \@_; |
217 | |
20674fcd |
218 | try { |
4012acd8 |
219 | |
220 | # Need to differentiate between scalar/list context to allow for |
221 | # returning a list in scalar context to get the size of the list |
222 | if ($wantarray) { |
223 | # list context |
38ed54cd |
224 | @return_values = $coderef->(@$args); |
4012acd8 |
225 | } elsif (defined $wantarray) { |
226 | # scalar context |
38ed54cd |
227 | $return_value = $coderef->(@$args); |
4012acd8 |
228 | } else { |
229 | # void context |
38ed54cd |
230 | $coderef->(@$args); |
4012acd8 |
231 | } |
232 | $self->txn_commit; |
52b420dd |
233 | } |
234 | catch { |
6b89ee0b |
235 | my $error = shift; |
4012acd8 |
236 | |
20674fcd |
237 | try { |
4012acd8 |
238 | $self->txn_rollback; |
20674fcd |
239 | } catch { |
4012acd8 |
240 | my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION"; |
241 | $self->throw_exception($error) # propagate nested rollback |
52b420dd |
242 | if $_ =~ /$exception_class/; |
4012acd8 |
243 | |
244 | $self->throw_exception( |
52b420dd |
245 | "Transaction aborted: $error. Rollback failed: $_" |
4012acd8 |
246 | ); |
4012acd8 |
247 | } |
20674fcd |
248 | $self->throw_exception($error); # txn failed but rollback succeeded |
52b420dd |
249 | }; |
4012acd8 |
250 | |
251 | return $wantarray ? @return_values : $return_value; |
a62cf8d4 |
252 | } |
253 | |
046ad905 |
254 | =head2 txn_begin |
255 | |
256 | Starts a transaction. |
257 | |
258 | See the preferred L</txn_do> method, which allows for |
259 | an entire code block to be executed transactionally. |
260 | |
261 | =cut |
262 | |
263 | sub txn_begin { die "Virtual method!" } |
264 | |
265 | =head2 txn_commit |
266 | |
267 | Issues a commit of the current transaction. |
268 | |
be01f1be |
269 | It does I<not> perform an actual storage commit unless there's a DBIx::Class |
270 | transaction currently in effect (i.e. you called L</txn_begin>). |
271 | |
046ad905 |
272 | =cut |
273 | |
274 | sub txn_commit { die "Virtual method!" } |
275 | |
276 | =head2 txn_rollback |
277 | |
278 | Issues a rollback of the current transaction. A nested rollback will |
279 | throw a L<DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION> exception, |
280 | which allows the rollback to propagate to the outermost transaction. |
281 | |
282 | =cut |
283 | |
284 | sub txn_rollback { die "Virtual method!" } |
285 | |
adb3554a |
286 | =head2 svp_begin |
287 | |
360dc8a5 |
288 | Arguments: $savepoint_name? |
adb3554a |
289 | |
360dc8a5 |
290 | Created a new savepoint using the name provided as argument. If no name |
291 | is provided, a random name will be used. |
adb3554a |
292 | |
293 | =cut |
294 | |
295 | sub svp_begin { die "Virtual method!" } |
296 | |
297 | =head2 svp_release |
298 | |
360dc8a5 |
299 | Arguments: $savepoint_name? |
adb3554a |
300 | |
360dc8a5 |
301 | Release the savepoint provided as argument. If none is provided, |
302 | release the savepoint created most recently. This will implicitly |
303 | release all savepoints created after the one explicitly released as well. |
adb3554a |
304 | |
305 | =cut |
306 | |
307 | sub svp_release { die "Virtual method!" } |
308 | |
309 | =head2 svp_rollback |
310 | |
360dc8a5 |
311 | Arguments: $savepoint_name? |
adb3554a |
312 | |
360dc8a5 |
313 | Rollback to the savepoint provided as argument. If none is provided, |
314 | rollback to the savepoint created most recently. This will implicitly |
315 | release all savepoints created after the savepoint we rollback to. |
adb3554a |
316 | |
317 | =cut |
318 | |
319 | sub svp_rollback { die "Virtual method!" } |
320 | |
dd018f09 |
321 | =for comment |
3b7f3eac |
322 | |
6936e902 |
323 | =head2 txn_scope_guard |
1bc193ac |
324 | |
6936e902 |
325 | An alternative way of transaction handling based on |
326 | L<DBIx::Class::Storage::TxnScopeGuard>: |
89028f42 |
327 | |
6936e902 |
328 | my $txn_guard = $storage->txn_scope_guard; |
89028f42 |
329 | |
330 | $row->col1("val1"); |
331 | $row->update; |
332 | |
6936e902 |
333 | $txn_guard->commit; |
89028f42 |
334 | |
6936e902 |
335 | If an exception occurs, or the guard object otherwise leaves the scope |
336 | before C<< $txn_guard->commit >> is called, the transaction will be rolled |
337 | back by an explicit L</txn_rollback> call. In essence this is akin to |
338 | using a L</txn_begin>/L</txn_commit> pair, without having to worry |
339 | about calling L</txn_rollback> at the right places. Note that since there |
340 | is no defined code closure, there will be no retries and other magic upon |
341 | database disconnection. If you need such functionality see L</txn_do>. |
1bc193ac |
342 | |
343 | =cut |
344 | |
345 | sub txn_scope_guard { |
346 | return DBIx::Class::Storage::TxnScopeGuard->new($_[0]); |
347 | } |
348 | |
046ad905 |
349 | =head2 sql_maker |
350 | |
351 | Returns a C<sql_maker> object - normally an object of class |
d5dedbd6 |
352 | C<DBIx::Class::SQLMaker>. |
046ad905 |
353 | |
354 | =cut |
355 | |
356 | sub sql_maker { die "Virtual method!" } |
357 | |
358 | =head2 debug |
359 | |
360 | Causes trace information to be emitted on the C<debugobj> object. |
361 | (or C<STDERR> if C<debugobj> has not specifically been set). |
362 | |
363 | This is the equivalent to setting L</DBIC_TRACE> in your |
364 | shell environment. |
365 | |
366 | =head2 debugfh |
367 | |
368 | Set or retrieve the filehandle used for trace/debug output. This should be |
48580715 |
369 | an IO::Handle compatible object (only the C<print> method is used. Initially |
046ad905 |
370 | set to be STDERR - although see information on the |
371 | L<DBIC_TRACE> environment variable. |
372 | |
373 | =cut |
374 | |
375 | sub debugfh { |
376 | my $self = shift; |
377 | |
378 | if ($self->debugobj->can('debugfh')) { |
379 | return $self->debugobj->debugfh(@_); |
380 | } |
381 | } |
382 | |
383 | =head2 debugobj |
384 | |
385 | Sets or retrieves the object used for metric collection. Defaults to an instance |
386 | of L<DBIx::Class::Storage::Statistics> that is compatible with the original |
387 | method of using a coderef as a callback. See the aforementioned Statistics |
388 | class for more information. |
389 | |
390 | =head2 debugcb |
391 | |
392 | Sets a callback to be executed each time a statement is run; takes a sub |
393 | reference. Callback is executed as $sub->($op, $info) where $op is |
394 | SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed. |
395 | |
396 | See L<debugobj> for a better way. |
397 | |
398 | =cut |
399 | |
400 | sub debugcb { |
401 | my $self = shift; |
402 | |
403 | if ($self->debugobj->can('callback')) { |
404 | return $self->debugobj->callback(@_); |
405 | } |
406 | } |
407 | |
e4eb8ee1 |
408 | =head2 cursor_class |
046ad905 |
409 | |
410 | The cursor class for this Storage object. |
411 | |
412 | =cut |
413 | |
046ad905 |
414 | =head2 deploy |
415 | |
416 | Deploy the tables to storage (CREATE TABLE and friends in a SQL-based |
417 | Storage class). This would normally be called through |
418 | L<DBIx::Class::Schema/deploy>. |
419 | |
420 | =cut |
421 | |
422 | sub deploy { die "Virtual method!" } |
423 | |
a3eaff0e |
424 | =head2 connect_info |
425 | |
426 | The arguments of C<connect_info> are always a single array reference, |
427 | and are Storage-handler specific. |
428 | |
429 | This is normally accessed via L<DBIx::Class::Schema/connection>, which |
430 | encapsulates its argument list in an arrayref before calling |
431 | C<connect_info> here. |
432 | |
433 | =cut |
434 | |
046ad905 |
435 | sub connect_info { die "Virtual method!" } |
a3eaff0e |
436 | |
437 | =head2 select |
438 | |
439 | Handle a select statement. |
440 | |
441 | =cut |
442 | |
443 | sub select { die "Virtual method!" } |
444 | |
445 | =head2 insert |
446 | |
447 | Handle an insert statement. |
448 | |
449 | =cut |
450 | |
046ad905 |
451 | sub insert { die "Virtual method!" } |
a3eaff0e |
452 | |
453 | =head2 update |
454 | |
455 | Handle an update statement. |
456 | |
457 | =cut |
458 | |
046ad905 |
459 | sub update { die "Virtual method!" } |
a3eaff0e |
460 | |
461 | =head2 delete |
462 | |
463 | Handle a delete statement. |
464 | |
465 | =cut |
466 | |
046ad905 |
467 | sub delete { die "Virtual method!" } |
a3eaff0e |
468 | |
469 | =head2 select_single |
470 | |
471 | Performs a select, fetch and return of data - handles a single row |
472 | only. |
473 | |
474 | =cut |
475 | |
046ad905 |
476 | sub select_single { die "Virtual method!" } |
a3eaff0e |
477 | |
478 | =head2 columns_info_for |
479 | |
c22c7625 |
480 | Returns metadata for the given source's columns. This |
481 | is *deprecated*, and will be removed before 1.0. You should |
482 | be specifying the metadata yourself if you need it. |
a3eaff0e |
483 | |
484 | =cut |
485 | |
046ad905 |
486 | sub columns_info_for { die "Virtual method!" } |
487 | |
488 | =head1 ENVIRONMENT VARIABLES |
489 | |
490 | =head2 DBIC_TRACE |
491 | |
492 | If C<DBIC_TRACE> is set then trace information |
493 | is produced (as when the L<debug> method is set). |
494 | |
495 | If the value is of the form C<1=/path/name> then the trace output is |
496 | written to the file C</path/name>. |
497 | |
498 | This environment variable is checked when the storage object is first |
fd323bf1 |
499 | created (when you call connect on your schema). So, run-time changes |
500 | to this environment variable will not take effect unless you also |
046ad905 |
501 | re-connect on your schema. |
502 | |
b6cd6478 |
503 | =head2 DBIC_TRACE_PROFILE |
504 | |
505 | If C<DBIC_TRACE_PROFILE> is set, L<DBIx::Class::Storage::PrettyPrint> |
506 | will be used to format the output from C<DBIC_TRACE>. The value it |
507 | is set to is the C<profile> that it will be used. If the value is a |
508 | filename the file is read with L<Config::Any> and the results are |
509 | used as the configuration for tracing. See L<SQL::Abstract::Tree/new> |
510 | for what that structure should look like. |
511 | |
512 | |
046ad905 |
513 | =head2 DBIX_CLASS_STORAGE_DBI_DEBUG |
514 | |
515 | Old name for DBIC_TRACE |
516 | |
ace385bd |
517 | =head1 SEE ALSO |
518 | |
2f0790c4 |
519 | L<DBIx::Class::Storage::DBI> - reference storage implementation using |
520 | SQL::Abstract and DBI. |
ace385bd |
521 | |
046ad905 |
522 | =head1 AUTHORS |
523 | |
524 | Matt S. Trout <mst@shadowcatsystems.co.uk> |
525 | |
526 | Andy Grundman <andy@hybridized.org> |
527 | |
528 | =head1 LICENSE |
529 | |
530 | You may distribute this code under the same terms as Perl itself. |
531 | |
532 | =cut |
533 | |
a62cf8d4 |
534 | 1; |