1 package DBIx::Class::Storage;
6 use base qw/DBIx::Class/;
10 package # Hide from PAUSE
11 DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION;
12 use base 'DBIx::Class::Exception';
15 use DBIx::Class::Carp;
16 use Scalar::Util qw/blessed weaken/;
17 use DBIx::Class::Storage::TxnScopeGuard;
21 __PACKAGE__->mk_group_accessors(simple => qw/debug schema transaction_depth auto_savepoint savepoints/);
22 __PACKAGE__->mk_group_accessors(component_class => 'cursor_class');
24 __PACKAGE__->cursor_class('DBIx::Class::Cursor');
26 sub cursor { shift->cursor_class(@_); }
30 DBIx::Class::Storage - Generic Storage Handler
34 A base implementation of common Storage methods. For specific
35 information about L<DBI>-based storage, see L<DBIx::Class::Storage::DBI>.
43 Instantiates the Storage object.
48 my ($self, $schema) = @_;
50 $self = ref $self if ref $self;
53 transaction_depth => 0,
57 $new->set_schema($schema);
59 if $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} || $ENV{DBIC_TRACE};
66 Used to reset the schema class or object which owns this
67 storage object, such as during L<DBIx::Class::Schema/clone>.
72 my ($self, $schema) = @_;
73 $self->schema($schema);
74 weaken $self->{schema} if ref $self->{schema};
79 Returns true if we have an open storage connection, false
80 if it is not (yet) open.
84 sub connected { die "Virtual method!" }
88 Closes any open storage connection unconditionally.
92 sub disconnect { die "Virtual method!" }
94 =head2 ensure_connected
96 Initiate a connection to the storage if one isn't already open.
100 sub ensure_connected { die "Virtual method!" }
102 =head2 throw_exception
104 Throws an exception - croaks.
108 sub throw_exception {
111 if (ref $self and $self->schema) {
112 $self->schema->throw_exception(@_);
115 DBIx::Class::Exception->throw(@_);
123 =item Arguments: C<$coderef>, @coderef_args?
125 =item Return Value: The return value of $coderef
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.
136 my $author_rs = $schema->resultset('Author')->find(1);
137 my @titles = qw/Night Day It/;
140 # If any one of these fails, the entire transaction fails
141 $author_rs->create_related('books', {
143 }) foreach (@titles);
145 return $author->books;
150 $rs = $schema->txn_do($coderef);
154 die "something terrible has happened!"
155 if ($error =~ /Rollback failed/); # Rollback failed
157 deal_with_failed_transaction();
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.
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
179 ref $coderef eq 'CODE' or $self->throw_exception
180 ('$coderef must be a CODE reference');
182 my $abort_txn = sub {
183 my ($self, $exception) = @_;
185 my $rollback_exception = try { $self->txn_rollback; undef } catch { shift };
187 if ( $rollback_exception and (
188 ! defined blessed $rollback_exception
190 ! $rollback_exception->isa('DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION')
192 $self->throw_exception(
193 "Transaction aborted: ${exception}. "
194 . "Rollback failed: ${rollback_exception}"
197 $self->throw_exception($exception);
200 # take a ref instead of a copy, to preserve coderef @_ aliasing semantics
203 # do not turn on until a succesful txn_begin
204 my $attempt_commit = 0;
206 my $txn_init_depth = $self->transaction_depth;
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, $_);
221 carp "Retrying txn_do($coderef) after catching disconnected exception: $_"
222 if $ENV{DBIC_STORAGE_RETRY_DEBUG};
224 $self->_populate_dbh;
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;
241 $abort_txn->($self, $_)
246 if ($attempt_commit) {
247 my $delta_txn = (1 + $txn_init_depth) - $self->transaction_depth;
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;
263 Starts a transaction.
265 See the preferred L</txn_do> method, which allows for
266 an entire code block to be executed transactionally.
273 if($self->transaction_depth == 0) {
274 $self->debugobj->txn_begin()
276 $self->_exec_txn_begin;
278 elsif ($self->auto_savepoint) {
281 $self->{transaction_depth}++;
287 Issues a commit of the current transaction.
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>).
297 if ($self->transaction_depth == 1) {
298 $self->debugobj->txn_commit() if $self->debug;
299 $self->_exec_txn_commit;
300 $self->{transaction_depth}--;
302 elsif($self->transaction_depth > 1) {
303 $self->{transaction_depth}--;
304 $self->svp_release if $self->auto_savepoint;
307 $self->throw_exception( 'Refusing to commit without a started transaction' );
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.
322 if ($self->transaction_depth == 1) {
323 $self->debugobj->txn_rollback() if $self->debug;
324 $self->_exec_txn_rollback;
325 $self->{transaction_depth}--;
327 elsif ($self->transaction_depth > 1) {
328 $self->{transaction_depth}--;
330 if ($self->auto_savepoint) {
335 DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->throw(
336 "A txn_rollback in nested transaction is ineffective! (depth $self->{transaction_depth})"
341 $self->throw_exception( 'Refusing to roll back without a started transaction' );
347 Arguments: $savepoint_name?
349 Created a new savepoint using the name provided as argument. If no name
350 is provided, a random name will be used.
355 my ($self, $name) = @_;
357 $self->throw_exception ("You can't use savepoints outside a transaction")
358 unless $self->transaction_depth;
360 my $exec = $self->can('_exec_svp_begin')
361 or $self->throw_exception ("Your Storage implementation doesn't support savepoints");
363 $name = $self->_svp_generate_name
364 unless defined $name;
366 push @{ $self->{savepoints} }, $name;
368 $self->debugobj->svp_begin($name) if $self->debug;
370 $exec->($self, $name);
373 sub _svp_generate_name {
375 return 'savepoint_'.scalar(@{ $self->{'savepoints'} });
381 Arguments: $savepoint_name?
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.
390 my ($self, $name) = @_;
392 $self->throw_exception ("You can't use savepoints outside a transaction")
393 unless $self->transaction_depth;
395 my $exec = $self->can('_exec_svp_release')
396 or $self->throw_exception ("Your Storage implementation doesn't support savepoints");
399 my @stack = @{ $self->savepoints };
402 do { $svp = pop @stack } until $svp eq $name;
404 $self->throw_exception ("Savepoint '$name' does not exist")
407 $self->savepoints(\@stack); # put back what's left
410 $name = pop @{ $self->savepoints }
411 or $self->throw_exception('No savepoints to release');;
414 $self->debugobj->svp_release($name) if $self->debug;
416 $exec->($self, $name);
421 Arguments: $savepoint_name?
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.
430 my ($self, $name) = @_;
432 $self->throw_exception ("You can't use savepoints outside a transaction")
433 unless $self->transaction_depth;
435 my $exec = $self->can('_exec_svp_rollback')
436 or $self->throw_exception ("Your Storage implementation doesn't support savepoints");
439 my @stack = @{ $self->savepoints };
442 # a rollback doesn't remove the named savepoint,
443 # only everything after it
444 while (@stack and $stack[-1] ne $name) {
448 $self->throw_exception ("Savepoint '$name' does not exist")
451 $self->savepoints(\@stack); # put back what's left
454 $name = $self->savepoints->[-1]
455 or $self->throw_exception('No savepoints to rollback');;
458 $self->debugobj->svp_rollback($name) if $self->debug;
460 $exec->($self, $name);
465 =head2 txn_scope_guard
467 An alternative way of transaction handling based on
468 L<DBIx::Class::Storage::TxnScopeGuard>:
470 my $txn_guard = $storage->txn_scope_guard;
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>.
489 sub txn_scope_guard {
490 return DBIx::Class::Storage::TxnScopeGuard->new($_[0]);
495 Returns a C<sql_maker> object - normally an object of class
496 C<DBIx::Class::SQLMaker>.
500 sub sql_maker { die "Virtual method!" }
504 Causes trace information to be emitted on the L</debugobj> object.
505 (or C<STDERR> if L</debugobj> has not specifically been set).
507 This is the equivalent to setting L</DBIC_TRACE> in your
512 Set or retrieve the filehandle used for trace/debug output. This should be
513 an IO::Handle compatible object (only the C<print> method is used. Initially
514 set to be STDERR - although see information on the
515 L<DBIC_TRACE> environment variable.
522 if ($self->debugobj->can('debugfh')) {
523 return $self->debugobj->debugfh(@_);
529 Sets or retrieves the object used for metric collection. Defaults to an instance
530 of L<DBIx::Class::Storage::Statistics> that is compatible with the original
531 method of using a coderef as a callback. See the aforementioned Statistics
532 class for more information.
540 return $self->{debugobj} = $_[0];
543 $self->{debugobj} ||= do {
544 if (my $profile = $ENV{DBIC_TRACE_PROFILE}) {
545 require DBIx::Class::Storage::Debug::PrettyPrint;
546 if ($profile =~ /^\.?\//) {
550 Config::Any->load_files({ files => [$profile], use_ext => 1 });
552 # sanitize the error message a bit
553 $_ =~ s/at \s+ .+ Storage\.pm \s line \s \d+ $//x;
554 $self->throw_exception("Failure processing \$ENV{DBIC_TRACE_PROFILE}: $_");
557 DBIx::Class::Storage::Debug::PrettyPrint->new(values %{$cfg->[0]});
560 DBIx::Class::Storage::Debug::PrettyPrint->new({ profile => $profile });
564 require DBIx::Class::Storage::Statistics;
565 DBIx::Class::Storage::Statistics->new
572 Sets a callback to be executed each time a statement is run; takes a sub
573 reference. Callback is executed as $sub->($op, $info) where $op is
574 SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed.
576 See L</debugobj> for a better way.
583 if ($self->debugobj->can('callback')) {
584 return $self->debugobj->callback(@_);
590 The cursor class for this Storage object.
596 Deploy the tables to storage (CREATE TABLE and friends in a SQL-based
597 Storage class). This would normally be called through
598 L<DBIx::Class::Schema/deploy>.
602 sub deploy { die "Virtual method!" }
606 The arguments of C<connect_info> are always a single array reference,
607 and are Storage-handler specific.
609 This is normally accessed via L<DBIx::Class::Schema/connection>, which
610 encapsulates its argument list in an arrayref before calling
611 C<connect_info> here.
615 sub connect_info { die "Virtual method!" }
619 Handle a select statement.
623 sub select { die "Virtual method!" }
627 Handle an insert statement.
631 sub insert { die "Virtual method!" }
635 Handle an update statement.
639 sub update { die "Virtual method!" }
643 Handle a delete statement.
647 sub delete { die "Virtual method!" }
651 Performs a select, fetch and return of data - handles a single row
656 sub select_single { die "Virtual method!" }
658 =head2 columns_info_for
660 Returns metadata for the given source's columns. This
661 is *deprecated*, and will be removed before 1.0. You should
662 be specifying the metadata yourself if you need it.
666 sub columns_info_for { die "Virtual method!" }
668 =head1 ENVIRONMENT VARIABLES
672 If C<DBIC_TRACE> is set then trace information
673 is produced (as when the L</debug> method is set).
675 If the value is of the form C<1=/path/name> then the trace output is
676 written to the file C</path/name>.
678 This environment variable is checked when the storage object is first
679 created (when you call connect on your schema). So, run-time changes
680 to this environment variable will not take effect unless you also
681 re-connect on your schema.
683 =head2 DBIC_TRACE_PROFILE
685 If C<DBIC_TRACE_PROFILE> is set, L<DBIx::Class::Storage::Debug::PrettyPrint>
686 will be used to format the output from C<DBIC_TRACE>. The value it
687 is set to is the C<profile> that it will be used. If the value is a
688 filename the file is read with L<Config::Any> and the results are
689 used as the configuration for tracing. See L<SQL::Abstract::Tree/new>
690 for what that structure should look like.
693 =head2 DBIX_CLASS_STORAGE_DBI_DEBUG
695 Old name for DBIC_TRACE
699 L<DBIx::Class::Storage::DBI> - reference storage implementation using
700 SQL::Abstract and DBI.
704 Matt S. Trout <mst@shadowcatsystems.co.uk>
706 Andy Grundman <andy@hybridized.org>
710 You may distribute this code under the same terms as Perl itself.