use DBIx::Class::Exception;
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');
+__PACKAGE__->mk_group_accessors('simple' => qw/debug schema/);
+__PACKAGE__->mk_group_accessors('component_class' => 'cursor_class');
__PACKAGE__->cursor_class('DBIx::Class::Cursor');
bless $new, $self;
$new->set_schema($schema);
- my $debugobj;
- if (my $profile = $ENV{DBIC_TRACE_PROFILE}) {
- require DBIx::Class::Storage::Debug::PrettyPrint;
- if ($profile =~ /^\.?\//) {
- require Config::Any;
- my $cfg = Config::Any->load_files({ files => [$profile], use_ext => 1 });
-
- 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};
-
- $new->debug(1) if $debug_env;
+ $new->debug(1)
+ if $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} || $ENV{DBIC_TRACE};
$new;
}
sub throw_exception {
my $self = shift;
- if ($self->schema) {
+ if (ref $self and $self->schema) {
$self->schema->throw_exception(@_);
}
else {
$self->throw_exception($error); # txn failed but rollback succeeded
};
- return $wantarray ? @return_values : $return_value;
+ return wantarray ? @return_values : $return_value;
}
=head2 txn_begin
=head2 debug
-Causes trace information to be emitted on the C<debugobj> object.
-(or C<STDERR> if C<debugobj> has not specifically been set).
+Causes trace information to be emitted on the L</debugobj> object.
+(or C<STDERR> if L</debugobj> has not specifically been set).
This is the equivalent to setting L</DBIC_TRACE> in your
shell environment.
method of using a coderef as a callback. See the aforementioned Statistics
class for more information.
+=cut
+
+sub debugobj {
+ my $self = shift;
+
+ if (@_) {
+ return $self->{debugobj} = $_[0];
+ }
+
+ $self->{debugobj} ||= do {
+ 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}: $_");
+ };
+
+ DBIx::Class::Storage::Debug::PrettyPrint->new(values %{$cfg->[0]});
+ }
+ else {
+ DBIx::Class::Storage::Debug::PrettyPrint->new({ profile => $profile });
+ }
+ }
+ else {
+ require DBIx::Class::Storage::Statistics;
+ DBIx::Class::Storage::Statistics->new
+ }
+ };
+}
+
=head2 debugcb
Sets a callback to be executed each time a statement is run; takes a sub
reference. Callback is executed as $sub->($op, $info) where $op is
SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed.
-See L<debugobj> for a better way.
+See L</debugobj> for a better way.
=cut
=head2 DBIC_TRACE
If C<DBIC_TRACE> is set then trace information
-is produced (as when the L<debug> method is set).
+is produced (as when the L</debug> method is set).
If the value is of the form C<1=/path/name> then the trace output is
written to the file C</path/name>.