[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage.pm

package DBIx::Class::Storage;

use strict;
use warnings;

use base qw/DBIx::Class/;
use mro 'c3';

use DBIx::Class::Exception;
use Scalar::Util 'weaken';
use DBIx::Class::Storage::TxnScopeGuard;
use Try::Tiny;
use namespace::clean;

__PACKAGE__->mk_group_accessors('simple' => qw/debug schema/);
__PACKAGE__->mk_group_accessors('inherited' => 'cursor_class');

__PACKAGE__->cursor_class('DBIx::Class::Cursor');

sub cursor { shift->cursor_class(@_); }

package # Hide from PAUSE
    DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION;

use overload '"' => sub {
  'DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION'
};

sub new {
  my $class = shift;
  my $self = {};
  return bless $self, $class;
}

package DBIx::Class::Storage;

=head1 NAME

DBIx::Class::Storage - Generic Storage Handler

=head1 DESCRIPTION

A base implementation of common Storage methods.  For specific
information about L<DBI>-based storage, see L<DBIx::Class::Storage::DBI>.

=head1 METHODS

=head2 new

Arguments: $schema

Instantiates the Storage object.

=cut

sub new {
  my ($self, $schema) = @_;

  $self = ref $self if ref $self;

  my $new = {};
  bless $new, $self;

  $new->set_schema($schema);
  $new->debug(1)
    if $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} || $ENV{DBIC_TRACE};

  $new;
}

=head2 set_schema

Used to reset the schema class or object which owns this
storage object, such as during L<DBIx::Class::Schema/clone>.

=cut

sub set_schema {
  my ($self, $schema) = @_;
  $self->schema($schema);
  weaken $self->{schema} if ref $self->{schema};
}

=head2 connected

Returns true if we have an open storage connection, false
if it is not (yet) open.

=cut

sub connected { die "Virtual method!" }

=head2 disconnect

Closes any open storage connection unconditionally.

=cut

sub disconnect { die "Virtual method!" }

=head2 ensure_connected

Initiate a connection to the storage if one isn't already open.

=cut

sub ensure_connected { die "Virtual method!" }

=head2 throw_exception

Throws an exception - croaks.

=cut

sub throw_exception {
  my $self = shift;

  if (ref $self and $self->schema) {
    $self->schema->throw_exception(@_);
  }
  else {
    DBIx::Class::Exception->throw(@_);
  }
}

=head2 txn_do

=over 4

=item Arguments: C<$coderef>, @coderef_args?

=item Return Value: The return value of $coderef

=back

Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
returning its result (if any). If an exception is caught, a rollback is issued
and the exception is rethrown. If the rollback fails, (i.e. throws an
exception) an exception is thrown that includes a "Rollback failed" message.

For example,

  my $author_rs = $schema->resultset('Author')->find(1);
  my @titles = qw/Night Day It/;

  my $coderef = sub {
    # If any one of these fails, the entire transaction fails
    $author_rs->create_related('books', {
      title => $_
    }) foreach (@titles);

    return $author->books;
  };

  my $rs;
  try {
    $rs = $schema->txn_do($coderef);
  } catch {
    my $error = shift;
    # Transaction failed
    die "something terrible has happened!"   #
      if ($error =~ /Rollback failed/);          # Rollback failed

    deal_with_failed_transaction();
  };

In a nested transaction (calling txn_do() from within a txn_do() coderef) only
the outermost transaction will issue a L</txn_commit>, and txn_do() can be
called in void, scalar and list context and it will behave as expected.

Please note that all of the code in your coderef, including non-DBIx::Class
code, is part of a transaction.  This transaction may fail out halfway, or
it may get partially double-executed (in the case that our DB connection
failed halfway through the transaction, in which case we reconnect and
restart the txn).  Therefore it is best that any side-effects in your coderef
are idempotent (that is, can be re-executed multiple times and get the
same result), and that you check up on your side-effects in the case of
transaction failure.

=cut

sub txn_do {
  my $self = shift;
  my $coderef = shift;

  ref $coderef eq 'CODE' or $self->throw_exception
    ('$coderef must be a CODE reference');

  my (@return_values, $return_value);

  $self->txn_begin; # If this throws an exception, no rollback is needed

  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);
    } elsif (defined $wantarray) {
      # scalar context
      $return_value = $coderef->(@$args);
    } else {
      # void context
      $coderef->(@$args);
    }
    $self->txn_commit;
  }
  catch {
    my $error = shift;

    try {
      $self->txn_rollback;
    } catch {
      my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
      $self->throw_exception($error)  # propagate nested rollback
        if $_ =~ /$exception_class/;

      $self->throw_exception(
        "Transaction aborted: $error. Rollback failed: $_"
      );
    }
    $self->throw_exception($error); # txn failed but rollback succeeded
  };

  return wantarray ? @return_values : $return_value;
}

=head2 txn_begin

Starts a transaction.

See the preferred L</txn_do> method, which allows for
an entire code block to be executed transactionally.

=cut

sub txn_begin { die "Virtual method!" }

=head2 txn_commit

Issues a commit of the current transaction.

It does I<not> perform an actual storage commit unless there's a DBIx::Class
transaction currently in effect (i.e. you called L</txn_begin>).

=cut

sub txn_commit { die "Virtual method!" }

=head2 txn_rollback

Issues a rollback of the current transaction. A nested rollback will
throw a L<DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION> exception,
which allows the rollback to propagate to the outermost transaction.

=cut

sub txn_rollback { die "Virtual method!" }

=head2 svp_begin

Arguments: $savepoint_name?

Created a new savepoint using the name provided as argument. If no name
is provided, a random name will be used.

=cut

sub svp_begin { die "Virtual method!" }

=head2 svp_release

Arguments: $savepoint_name?

Release the savepoint provided as argument. If none is provided,
release the savepoint created most recently. This will implicitly
release all savepoints created after the one explicitly released as well.

=cut

sub svp_release { die "Virtual method!" }

=head2 svp_rollback

Arguments: $savepoint_name?

Rollback to the savepoint provided as argument. If none is provided,
rollback to the savepoint created most recently. This will implicitly
release all savepoints created after the savepoint we rollback to.

=cut

sub svp_rollback { die "Virtual method!" }

=for comment

=head2 txn_scope_guard

An alternative way of transaction handling based on
L<DBIx::Class::Storage::TxnScopeGuard>:

 my $txn_guard = $storage->txn_scope_guard;

 $row->col1("val1");
 $row->update;

 $txn_guard->commit;

If an exception occurs, or the guard object otherwise leaves the scope
before C<< $txn_guard->commit >> is called, the transaction will be rolled
back by an explicit L</txn_rollback> call. In essence this is akin to
using a L</txn_begin>/L</txn_commit> pair, without having to worry
about calling L</txn_rollback> at the right places. Note that since there
is no defined code closure, there will be no retries and other magic upon
database disconnection. If you need such functionality see L</txn_do>.

=cut

sub txn_scope_guard {
  return DBIx::Class::Storage::TxnScopeGuard->new($_[0]);
}

=head2 sql_maker

Returns a C<sql_maker> object - normally an object of class
C<DBIx::Class::SQLMaker>.

=cut

sub sql_maker { die "Virtual method!" }

=head2 debug

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.

=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.

=cut

sub debugfh {
    my $self = shift;

    if ($self->debugobj->can('debugfh')) {
        return $self->debugobj->debugfh(@_);
    }
}

=head2 debugobj

Sets or retrieves the object used for metric collection. Defaults to an instance
of L<DBIx::Class::Storage::Statistics> that is compatible with the original
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.

=cut

sub debugcb {
    my $self = shift;

    if ($self->debugobj->can('callback')) {
        return $self->debugobj->callback(@_);
    }
}

=head2 cursor_class

The cursor class for this Storage object.

=cut

=head2 deploy

Deploy the tables to storage (CREATE TABLE and friends in a SQL-based
Storage class). This would normally be called through
L<DBIx::Class::Schema/deploy>.

=cut

sub deploy { die "Virtual method!" }

=head2 connect_info

The arguments of C<connect_info> are always a single array reference,
and are Storage-handler specific.

This is normally accessed via L<DBIx::Class::Schema/connection>, which
encapsulates its argument list in an arrayref before calling
C<connect_info> here.

=cut

sub connect_info { die "Virtual method!" }

=head2 select

Handle a select statement.

=cut

sub select { die "Virtual method!" }

=head2 insert

Handle an insert statement.

=cut

sub insert { die "Virtual method!" }

=head2 update

Handle an update statement.

=cut

sub update { die "Virtual method!" }

=head2 delete

Handle a delete statement.

=cut

sub delete { die "Virtual method!" }

=head2 select_single

Performs a select, fetch and return of data - handles a single row
only.

=cut

sub select_single { die "Virtual method!" }

=head2 columns_info_for

Returns metadata for the given source's columns.  This
is *deprecated*, and will be removed before 1.0.  You should
be specifying the metadata yourself if you need it.

=cut

sub columns_info_for { die "Virtual method!" }

=head1 ENVIRONMENT VARIABLES

=head2 DBIC_TRACE

If C<DBIC_TRACE> is set then trace information
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>.

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
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

=head1 SEE ALSO

L<DBIx::Class::Storage::DBI> - reference storage implementation using
SQL::Abstract and DBI.

=head1 AUTHORS

Matt S. Trout <mst@shadowcatsystems.co.uk>

Andy Grundman <andy@hybridized.org>

=head1 LICENSE

You may distribute this code under the same terms as Perl itself.

=cut

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