sub txn_do {
my $self = shift;
- my $coderef = shift;
DBIx::Class::Storage::BlockRunner->new(
storage => $self,
- run_code => $coderef,
- run_args => \@_, # take a ref instead of a copy, to preserve coderef @_ aliasing semantics
wrap_txn => 1,
- retry_handler => sub { ! ( $_[0]->retried_count or $_[0]->storage->connected ) },
- )->run;
+ retry_handler => sub {
+ $_[0]->failed_attempt_count == 1
+ and
+ ! $_[0]->storage->connected
+ },
+ )->run(@_);
}
=head2 txn_begin
$self->debugobj->txn_commit() if $self->debug;
$self->_exec_txn_commit;
$self->{transaction_depth}--;
+ $self->savepoints([]);
}
elsif($self->transaction_depth > 1) {
$self->{transaction_depth}--;
$self->debugobj->txn_rollback() if $self->debug;
$self->_exec_txn_rollback;
$self->{transaction_depth}--;
+ $self->savepoints([]);
}
elsif ($self->transaction_depth > 1) {
$self->{transaction_depth}--;
my $txn_guard = $storage->txn_scope_guard;
- $row->col1("val1");
- $row->update;
+ $result->col1("val1");
+ $result->update;
$txn_guard->commit;
=head2 debugfh
-Set or retrieve the filehandle used for trace/debug output. This should be
-an IO::Handle compatible object (only the C<print> method is used. Initially
-set to be STDERR - although see information on the
-L<DBIC_TRACE> environment variable.
+An opportunistic proxy to L<< ->debugobj->debugfh(@_)
+|DBIx::Class::Storage::Statistics/debugfh >>
+If the currently set L</debugobj> does not have a L</debugfh> method, caling
+this is a no-op.
=cut
$self->{debugobj} ||= do {
if (my $profile = $ENV{DBIC_TRACE_PROFILE}) {
require DBIx::Class::Storage::Debug::PrettyPrint;
+ my @pp_args;
+
if ($profile =~ /^\.?\//) {
require Config::Any;
$self->throw_exception("Failure processing \$ENV{DBIC_TRACE_PROFILE}: $_");
};
- DBIx::Class::Storage::Debug::PrettyPrint->new(values %{$cfg->[0]});
+ @pp_args = values %{$cfg->[0]};
}
else {
- DBIx::Class::Storage::Debug::PrettyPrint->new({ profile => $profile });
+ @pp_args = { profile => $profile };
+ }
+
+ # FIXME - FRAGILE
+ # Hash::Merge is a sorry piece of shit and tramples all over $@
+ # *without* throwing an exception
+ # This is a rather serious problem in the debug codepath
+ # Insulate the condition here with a try{} until a review of
+ # DBIx::Class::Storage::Debug::PrettyPrint takes place
+ # we do rethrow the error unconditionally, the only reason
+ # to try{} is to preserve the precise state of $@ (down
+ # to the scalar (if there is one) address level)
+ #
+ # Yes I am aware this is fragile and TxnScopeGuard needs
+ # a better fix. This is another yak to shave... :(
+ try {
+ DBIx::Class::Storage::Debug::PrettyPrint->new(@pp_args);
+ } catch {
+ $self->throw_exception($_);
}
}
else {
used as the configuration for tracing. See L<SQL::Abstract::Tree/new>
for what that structure should look like.
-
=head2 DBIX_CLASS_STORAGE_DBI_DEBUG
Old name for DBIC_TRACE
L<DBIx::Class::Storage::DBI> - reference storage implementation using
SQL::Abstract and DBI.
-=head1 AUTHORS
-
-Matt S. Trout <mst@shadowcatsystems.co.uk>
+=head1 FURTHER QUESTIONS?
-Andy Grundman <andy@hybridized.org>
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
-=head1 LICENSE
+=head1 COPYRIGHT AND LICENSE
-You may distribute this code under the same terms as Perl itself.
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
=cut