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