use mro 'c3';
use DBIx::Class::Exception;
-use Scalar::Util();
+use Scalar::Util 'weaken';
use IO::File;
use DBIx::Class::Storage::TxnScopeGuard;
+use Try::Tiny;
+use namespace::clean;
__PACKAGE__->mk_group_accessors('simple' => qw/debug debugobj schema/);
__PACKAGE__->mk_group_accessors('inherited' => 'cursor_class');
bless $new, $self;
$new->set_schema($schema);
- $new->debugobj(new DBIx::Class::Storage::Statistics());
-
- #my $fh;
+ my $debugobj;
+ if (my $profile = $ENV{DBIC_TRACE_PROFILE}) {
+ require DBIx::Class::Storage::Debug::PrettyPrint;
+ if ($profile =~ /^\.?\//) {
+ require Config::Any;
+
+ my $cfg = try {
+ Config::Any->load_files({ files => [$profile], use_ext => 1 });
+ } catch {
+ # sanitize the error message a bit
+ $_ =~ s/at \s+ .+ Storage\.pm \s line \s \d+ $//x;
+ $self->throw_exception("Failure processing \$ENV{DBIC_TRACE_PROFILE}: $_");
+ };
+
+ my ($filename, $config) = %{$cfg->[0]};
+ $debugobj = DBIx::Class::Storage::Debug::PrettyPrint->new($config)
+ } else {
+ $debugobj = DBIx::Class::Storage::Debug::PrettyPrint->new({ profile => $profile })
+ }
+ } else {
+ $debugobj = DBIx::Class::Storage::Statistics->new
+ }
+ $new->debugobj($debugobj);
my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
|| $ENV{DBIC_TRACE};
sub set_schema {
my ($self, $schema) = @_;
$self->schema($schema);
- Scalar::Util::weaken($self->{schema}) if ref $self->{schema};
+ weaken $self->{schema} if ref $self->{schema};
}
=head2 connected
sub throw_exception {
my $self = shift;
- if ($self->schema) {
+ if (ref $self and $self->schema) {
$self->schema->throw_exception(@_);
}
else {
=cut
sub txn_do {
- my ($self, $coderef, @args) = @_;
+ my $self = shift;
+ my $coderef = shift;
ref $coderef eq 'CODE' or $self->throw_exception
('$coderef must be a CODE reference');
my $wantarray = wantarray; # Need to save this since the context
# inside the try{} block is independent
# of the context that called txn_do()
+ my $args = \@_;
+
try {
# Need to differentiate between scalar/list context to allow for
# returning a list in scalar context to get the size of the list
if ($wantarray) {
# list context
- @return_values = $coderef->(@args);
+ @return_values = $coderef->(@$args);
} elsif (defined $wantarray) {
# scalar context
- $return_value = $coderef->(@args);
+ $return_value = $coderef->(@$args);
} else {
# void context
- $coderef->(@args);
+ $coderef->(@$args);
}
$self->txn_commit;
- } catch {
+ }
+ catch {
my $error = shift;
try {
$self->txn_rollback;
} catch {
- my $rollback_error = shift;
my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
$self->throw_exception($error) # propagate nested rollback
- if $rollback_error =~ /$exception_class/;
+ if $_ =~ /$exception_class/;
$self->throw_exception(
- "Transaction aborted: $error. Rollback failed: ${rollback_error}"
+ "Transaction aborted: $error. Rollback failed: $_"
);
}
$self->throw_exception($error); # txn failed but rollback succeeded
- }
+ };
return $wantarray ? @return_values : $return_value;
}
=head2 sql_maker
Returns a C<sql_maker> object - normally an object of class
-C<DBIx::Class::SQLAHacks>.
+C<DBIx::Class::SQLMaker>.
=cut
written to the file C</path/name>.
This environment variable is checked when the storage object is first
-created (when you call connect on your schema). So, run-time changes
-to this environment variable will not take effect unless you also
+created (when you call connect on your schema). So, run-time changes
+to this environment variable will not take effect unless you also
re-connect on your schema.
+=head2 DBIC_TRACE_PROFILE
+
+If C<DBIC_TRACE_PROFILE> is set, L<DBIx::Class::Storage::PrettyPrint>
+will be used to format the output from C<DBIC_TRACE>. The value it
+is set to is the C<profile> that it will be used. If the value is a
+filename the file is read with L<Config::Any> and the results are
+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