1 package DBIx::Class::Storage::DBI;
2 # -*- mode: cperl; cperl-indent-level: 2 -*-
4 use base 'DBIx::Class::Storage';
9 use SQL::Abstract::Limit;
10 use DBIx::Class::Storage::DBI::Cursor;
11 use DBIx::Class::Storage::Statistics;
13 use Carp::Clan qw/DBIx::Class/;
16 package DBIC::SQL::Abstract; # Would merge upstream, but nate doesn't reply :(
18 use base qw/SQL::Abstract::Limit/;
21 my ($self, $table, $fields, $where, $order, @rest) = @_;
22 $table = $self->_quote($table) unless ref($table);
23 @rest = (-1) unless defined $rest[0];
24 die "LIMIT 0 Does Not Compute" if $rest[0] == 0;
25 # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
26 local $self->{having_bind} = [];
27 my ($sql, @ret) = $self->SUPER::select(
28 $table, $self->_recurse_fields($fields), $where, $order, @rest
30 return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
36 $table = $self->_quote($table) unless ref($table);
37 $self->SUPER::insert($table, @_);
43 $table = $self->_quote($table) unless ref($table);
44 $self->SUPER::update($table, @_);
50 $table = $self->_quote($table) unless ref($table);
51 $self->SUPER::delete($table, @_);
57 return $_[1].$self->_order_by($_[2]);
59 return $self->SUPER::_emulate_limit(@_);
64 my ($self, $fields) = @_;
65 my $ref = ref $fields;
66 return $self->_quote($fields) unless $ref;
67 return $$fields if $ref eq 'SCALAR';
69 if ($ref eq 'ARRAY') {
70 return join(', ', map { $self->_recurse_fields($_) } @$fields);
71 } elsif ($ref eq 'HASH') {
72 foreach my $func (keys %$fields) {
73 return $self->_sqlcase($func)
74 .'( '.$self->_recurse_fields($fields->{$func}).' )';
83 if (ref $_[0] eq 'HASH') {
84 if (defined $_[0]->{group_by}) {
85 $ret = $self->_sqlcase(' group by ')
86 .$self->_recurse_fields($_[0]->{group_by});
88 if (defined $_[0]->{having}) {
90 ($frag, @extra) = $self->_recurse_where($_[0]->{having});
91 push(@{$self->{having_bind}}, @extra);
92 $ret .= $self->_sqlcase(' having ').$frag;
94 if (defined $_[0]->{order_by}) {
95 $ret .= $self->SUPER::_order_by($_[0]->{order_by});
97 } elsif(ref $_[0] eq 'SCALAR') {
98 $ret = $self->_sqlcase(' order by ').${ $_[0] };
100 $ret = $self->SUPER::_order_by(@_);
105 sub _order_directions {
106 my ($self, $order) = @_;
107 $order = $order->{order_by} if ref $order eq 'HASH';
108 return $self->SUPER::_order_directions($order);
112 my ($self, $from) = @_;
113 if (ref $from eq 'ARRAY') {
114 return $self->_recurse_from(@$from);
115 } elsif (ref $from eq 'HASH') {
116 return $self->_make_as($from);
118 return $from; # would love to quote here but _table ends up getting called
119 # twice during an ->select without a limit clause due to
120 # the way S::A::Limit->select works. should maybe consider
121 # bypassing this and doing S::A::select($self, ...) in
122 # our select method above. meantime, quoting shims have
123 # been added to select/insert/update/delete here
128 my ($self, $from, @join) = @_;
130 push(@sqlf, $self->_make_as($from));
131 foreach my $j (@join) {
134 # check whether a join type exists
135 my $join_clause = '';
136 if (ref($to) eq 'HASH' and exists($to->{-join_type})) {
137 $join_clause = ' '.uc($to->{-join_type}).' JOIN ';
139 $join_clause = ' JOIN ';
141 push(@sqlf, $join_clause);
143 if (ref $to eq 'ARRAY') {
144 push(@sqlf, '(', $self->_recurse_from(@$to), ')');
146 push(@sqlf, $self->_make_as($to));
148 push(@sqlf, ' ON ', $self->_join_condition($on));
150 return join('', @sqlf);
154 my ($self, $from) = @_;
155 return join(' ', map { (ref $_ eq 'SCALAR' ? $$_ : $self->_quote($_)) }
156 reverse each %{$self->_skip_options($from)});
160 my ($self, $hash) = @_;
162 $clean_hash->{$_} = $hash->{$_}
163 for grep {!/^-/} keys %$hash;
167 sub _join_condition {
168 my ($self, $cond) = @_;
169 if (ref $cond eq 'HASH') {
172 my $x = '= '.$self->_quote($cond->{$_}); $j{$_} = \$x;
174 return $self->_recurse_where(\%j);
175 } elsif (ref $cond eq 'ARRAY') {
176 return join(' OR ', map { $self->_join_condition($_) } @$cond);
178 die "Can't handle this yet!";
183 my ($self, $label) = @_;
184 return '' unless defined $label;
185 return "*" if $label eq '*';
186 return $label unless $self->{quote_char};
187 if(ref $self->{quote_char} eq "ARRAY"){
188 return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
189 if !defined $self->{name_sep};
190 my $sep = $self->{name_sep};
191 return join($self->{name_sep},
192 map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
193 split(/\Q$sep\E/,$label));
195 return $self->SUPER::_quote($label);
201 $_[0] =~ s/SELECT (.*?) FROM/
202 'SELECT '.join(', ', map { $_.' AS col'.++$c } split(', ', $1)).' FROM'/e;
203 $self->SUPER::_RowNum(@_);
206 # Accessor for setting limit dialect. This is useful
207 # for JDBC-bridge among others where the remote SQL-dialect cannot
208 # be determined by the name of the driver alone.
212 $self->{limit_dialect} = shift if @_;
213 return $self->{limit_dialect};
218 $self->{quote_char} = shift if @_;
219 return $self->{quote_char};
224 $self->{name_sep} = shift if @_;
225 return $self->{name_sep};
228 } # End of BEGIN block
230 use base qw/DBIx::Class/;
232 __PACKAGE__->load_components(qw/AccessorGroup/);
234 __PACKAGE__->mk_group_accessors('simple' =>
235 qw/_connect_info _dbh _sql_maker _conn_pid _conn_tid debug debugobj
236 cursor on_connect_do transaction_depth/);
243 my $new = bless({}, ref $_[0] || $_[0]);
244 $new->cursor("DBIx::Class::Storage::DBI::Cursor");
245 $new->transaction_depth(0);
247 $new->debugobj(new DBIx::Class::Storage::Statistics());
250 if (defined($ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}) &&
251 ($ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} =~ /=(.+)$/)) {
252 $fh = IO::File->new($1, 'w')
253 or $new->throw_exception("Cannot open trace file $1");
255 $fh = IO::File->new('>&STDERR');
258 $new->debug(1) if $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG};
262 =head2 throw_exception
264 Throws an exception - croaks.
268 sub throw_exception {
269 my ($self, $msg) = @_;
275 DBIx::Class::Storage::DBI - DBI storage handler
281 This class represents the connection to the database
289 Connection information arrayref. Can either be the same arguments
290 one would pass to DBI->connect, or a code-reference which returns
291 a connected database handle. In either case, there is an optional
292 final element in the arrayref, which can hold a hashref of
293 connection-specific Storage::DBI options. These include
294 C<on_connect_do>, and the sql_maker options C<limit_dialect>,
295 C<quote_char>, and C<name_sep>. Examples:
297 ->connect_info([ 'dbi:SQLite:./foo.db' ]);
298 ->connect_info(sub { DBI->connect(...) });
299 ->connect_info([ 'dbi:Pg:dbname=foo',
303 { quote_char => q{`}, name_sep => q{@} },
308 Executes the sql statements given as a listref on every db connect.
312 Specifies what characters to use to quote table and column names. If
313 you use this you will want to specify L<name_sep> as well.
315 quote_char expectes either a single character, in which case is it is placed
316 on either side of the table/column, or an array of length 2 in which case the
317 table/column name is placed between the elements.
319 For example under MySQL you'd use C<quote_char('`')>, and user SQL Server you'd
320 use C<quote_char(qw/[ ]/)>.
324 This only needs to be used in conjunction with L<quote_char>, and is used to
325 specify the charecter that seperates elements (schemas, tables, columns) from
326 each other. In most cases this is simply a C<.>.
330 Causes SQL trace information to be emitted on the C<debugobj> object.
331 (or C<STDERR> if C<debugobj> has not specifically been set).
335 Set or retrieve the filehandle used for trace/debug output. This should be
336 an IO::Handle compatible ojbect (only the C<print> method is used. Initially
337 set to be STDERR - although see information on the
338 L<DBIX_CLASS_STORAGE_DBI_DEBUG> environment variable.
345 if ($self->debugobj->can('debugfh')) {
346 return $self->debugobj->debugfh(@_);
352 Sets or retrieves the object used for metric collection. Defaults to an instance
353 of L<DBIx::Class::Storage::Statistics> that is campatible with the original
354 method of using a coderef as a callback. See the aforementioned Statistics
355 class for more information.
359 Sets a callback to be executed each time a statement is run; takes a sub
360 reference. Callback is executed as $sub->($op, $info) where $op is
361 SELECT/INSERT/UPDATE/DELETE and $info is what would normally be printed.
363 See L<debugobj> for a better way.
370 if ($self->debugobj->can('callback')) {
371 return $self->debugobj->callback(@_);
377 Disconnect the L<DBI> handle, performing a rollback first if the
378 database is not in C<AutoCommit> mode.
385 if( $self->connected ) {
386 $self->_dbh->rollback unless $self->_dbh->{AutoCommit};
387 $self->_dbh->disconnect;
394 Check if the L<DBI> handle is connected. Returns true if the handle
399 sub connected { my ($self) = @_;
401 if(my $dbh = $self->_dbh) {
402 if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
403 $self->_sql_maker(undef);
404 return $self->_dbh(undef);
406 elsif($self->_conn_pid != $$) {
407 $self->_dbh->{InactiveDestroy} = 1;
408 $self->_sql_maker(undef);
409 return $self->_dbh(undef)
411 return ($dbh->FETCH('Active') && $dbh->ping);
417 =head2 ensure_connected
419 Check whether the database handle is connected - if not then make a
424 sub ensure_connected {
427 unless ($self->connected) {
428 $self->_populate_dbh;
434 Returns the dbh - a data base handle of class L<DBI>.
441 $self->ensure_connected;
445 sub _sql_maker_args {
448 return ( limit_dialect => $self->dbh );
453 Returns a C<sql_maker> object - normally an object of class
454 C<DBIC::SQL::Abstract>.
460 unless ($self->_sql_maker) {
461 $self->_sql_maker(new DBIC::SQL::Abstract( $self->_sql_maker_args ));
463 return $self->_sql_maker;
467 my ($self, $info_arg) = @_;
470 my $info = [ @$info_arg ]; # copy because we can alter it
471 my $last_info = $info->[-1];
472 if(ref $last_info eq 'HASH') {
474 if(my $on_connect_do = $last_info->{on_connect_do}) {
476 $self->on_connect_do($on_connect_do);
478 for my $sql_maker_opt (qw/limit_dialect quote_char name_sep/) {
479 if(my $opt_val = $last_info->{$sql_maker_opt}) {
481 $self->sql_maker->$sql_maker_opt($opt_val);
485 # remove our options hashref if it was there, to avoid confusing
486 # DBI in the case the user didn't use all 4 DBI options, as in:
487 # [ 'dbi:SQLite:foo.db', { quote_char => q{`} } ]
488 pop(@$info) if $used;
491 $self->_connect_info($info);
494 $self->_connect_info;
499 my @info = @{$self->_connect_info || []};
500 $self->_dbh($self->_connect(@info));
501 my $driver = $self->_dbh->{Driver}->{Name};
502 eval "require DBIx::Class::Storage::DBI::${driver}";
504 bless $self, "DBIx::Class::Storage::DBI::${driver}";
505 $self->_rebless() if $self->can('_rebless');
507 # if on-connect sql statements are given execute them
508 foreach my $sql_statement (@{$self->on_connect_do || []}) {
509 $self->debugobj->query_start($sql_statement) if $self->debug();
510 $self->_dbh->do($sql_statement);
511 $self->debugobj->query_end($sql_statement) if $self->debug();
514 $self->_conn_pid($$);
515 $self->_conn_tid(threads->tid) if $INC{'threads.pm'};
519 my ($self, @info) = @_;
521 $self->throw_exception("You failed to provide any connection info")
524 my ($old_connect_via, $dbh);
526 if ($INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}) {
527 $old_connect_via = $DBI::connect_via;
528 $DBI::connect_via = 'connect';
532 if(ref $info[0] eq 'CODE') {
536 $dbh = DBI->connect(@info);
540 $DBI::connect_via = $old_connect_via if $old_connect_via;
543 $self->throw_exception("DBI Connection failed: " . ($@ || $DBI::errstr));
551 Calls begin_work on the current dbh.
553 See L<DBIx::Class::Schema> for the txn_do() method, which allows for
554 an entire code block to be executed transactionally.
560 if ($self->{transaction_depth}++ == 0) {
561 my $dbh = $self->dbh;
562 if ($dbh->{AutoCommit}) {
563 $self->debugobj->txn_begin()
572 Issues a commit against the current dbh.
578 my $dbh = $self->dbh;
579 if ($self->{transaction_depth} == 0) {
580 unless ($dbh->{AutoCommit}) {
581 $self->debugobj->txn_commit()
587 if (--$self->{transaction_depth} == 0) {
588 $self->debugobj->txn_commit()
597 Issues a rollback against the current dbh. A nested rollback will
598 throw a L<DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION> exception,
599 which allows the rollback to propagate to the outermost transaction.
607 my $dbh = $self->dbh;
608 if ($self->{transaction_depth} == 0) {
609 unless ($dbh->{AutoCommit}) {
610 $self->debugobj->txn_rollback()
616 if (--$self->{transaction_depth} == 0) {
617 $self->debugobj->txn_rollback()
622 die DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->new;
629 my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
630 $error =~ /$exception_class/ and $self->throw_exception($error);
631 $self->{transaction_depth} = 0; # ensure that a failed rollback
632 $self->throw_exception($error); # resets the transaction depth
637 my ($self, $op, $extra_bind, $ident, @args) = @_;
638 my ($sql, @bind) = $self->sql_maker->$op($ident, @args);
639 unshift(@bind, @$extra_bind) if $extra_bind;
641 my @debug_bind = map { defined $_ ? qq{'$_'} : q{'NULL'} } @bind;
642 $self->debugobj->query_start($sql, @debug_bind);
644 my $sth = eval { $self->sth($sql,$op) };
647 $self->throw_exception(
648 'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"
651 @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
655 $rv = eval { $sth->execute(@bind) };
658 $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr));
661 $self->throw_exception("'$sql' did not generate a statement.");
664 my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
665 $self->debugobj->query_end($sql, @debug_bind);
667 return (wantarray ? ($rv, $sth, @bind) : $rv);
671 my ($self, $ident, $to_insert) = @_;
672 $self->throw_exception(
673 "Couldn't insert ".join(', ',
674 map "$_ => $to_insert->{$_}", keys %$to_insert
676 ) unless ($self->_execute('insert' => [], $ident, $to_insert));
681 return shift->_execute('update' => [], @_);
685 return shift->_execute('delete' => [], @_);
689 my ($self, $ident, $select, $condition, $attrs) = @_;
690 my $order = $attrs->{order_by};
691 if (ref $condition eq 'SCALAR') {
692 $order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
694 if (exists $attrs->{group_by} || $attrs->{having}) {
696 group_by => $attrs->{group_by},
697 having => $attrs->{having},
698 ($order ? (order_by => $order) : ())
701 my @args = ('select', $attrs->{bind}, $ident, $select, $condition, $order);
702 if ($attrs->{software_limit} ||
703 $self->sql_maker->_default_limit_syntax eq "GenericSubQ") {
704 $attrs->{software_limit} = 1;
706 $self->throw_exception("rows attribute must be positive if present")
707 if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
708 push @args, $attrs->{rows}, $attrs->{offset};
710 return $self->_execute(@args);
715 Handle a SQL select statement.
721 my ($ident, $select, $condition, $attrs) = @_;
722 return $self->cursor->new($self, \@_, $attrs);
727 Performs a select, fetch and return of data - handles a single row
732 # Need to call finish() to work round broken DBDs
736 my ($rv, $sth, @bind) = $self->_select(@_);
737 my @row = $sth->fetchrow_array;
744 Returns a L<DBI> sth (statement handle) for the supplied SQL.
749 my ($self, $sql) = @_;
750 # 3 is the if_active parameter which avoids active sth re-use
751 return $self->dbh->prepare_cached($sql, {}, 3);
754 =head2 columns_info_for
756 Returns database type info for a given table columns.
760 sub columns_info_for {
761 my ($self, $table) = @_;
763 my $dbh = $self->dbh;
765 if ($dbh->can('column_info')) {
767 my $old_raise_err = $dbh->{RaiseError};
768 my $old_print_err = $dbh->{PrintError};
769 $dbh->{RaiseError} = 1;
770 $dbh->{PrintError} = 0;
772 my ($schema,$tab) = $table =~ /^(.+?)\.(.+)$/ ? ($1,$2) : (undef,$table);
773 my $sth = $dbh->column_info( undef,$schema, $tab, '%' );
775 while ( my $info = $sth->fetchrow_hashref() ){
777 $column_info{data_type} = $info->{TYPE_NAME};
778 $column_info{size} = $info->{COLUMN_SIZE};
779 $column_info{is_nullable} = $info->{NULLABLE} ? 1 : 0;
780 $column_info{default_value} = $info->{COLUMN_DEF};
781 my $col_name = $info->{COLUMN_NAME};
782 $col_name =~ s/^\"(.*)\"$/$1/;
784 $result{$col_name} = \%column_info;
787 $dbh->{RaiseError} = $old_raise_err;
788 $dbh->{PrintError} = $old_print_err;
789 return \%result if !$@;
793 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0");
795 my @columns = @{$sth->{NAME_lc}};
796 for my $i ( 0 .. $#columns ){
798 my $type_num = $sth->{TYPE}->[$i];
800 if(defined $type_num && $dbh->can('type_info')) {
801 my $type_info = $dbh->type_info($type_num);
802 $type_name = $type_info->{TYPE_NAME} if $type_info;
804 $column_info{data_type} = $type_name ? $type_name : $type_num;
805 $column_info{size} = $sth->{PRECISION}->[$i];
806 $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0;
808 if ($column_info{data_type} =~ m/^(.*?)\((.*?)\)$/) {
809 $column_info{data_type} = $1;
810 $column_info{size} = $2;
813 $result{$columns[$i]} = \%column_info;
819 =head2 last_insert_id
821 Return the row id of the last insert.
826 my ($self, $row) = @_;
828 return $self->dbh->func('last_insert_rowid');
834 Returns the database driver name.
838 sub sqlt_type { shift->dbh->{Driver}->{Name} }
840 =head2 create_ddl_dir (EXPERIMENTAL)
844 =item Arguments: $schema \@databases, $version, $directory, $sqlt_args
848 Creates an SQL file based on the Schema, for each of the specified
849 database types, in the given directory.
851 Note that this feature is currently EXPERIMENTAL and may not work correctly
852 across all databases, or fully handle complex relationships.
858 my ($self, $schema, $databases, $version, $dir, $sqltargs) = @_;
860 if(!$dir || !-d $dir)
862 warn "No directory given, using ./\n";
865 $databases ||= ['MySQL', 'SQLite', 'PostgreSQL'];
866 $databases = [ $databases ] if(ref($databases) ne 'ARRAY');
867 $version ||= $schema->VERSION || '1.x';
869 eval "use SQL::Translator";
870 $self->throw_exception("Can't deploy without SQL::Translator: $@") if $@;
872 my $sqlt = SQL::Translator->new({
876 foreach my $db (@$databases)
879 $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
880 # $sqlt->parser_args({'DBIx::Class' => $schema);
881 $sqlt->data($schema);
882 $sqlt->producer($db);
885 my $filename = $schema->ddl_filename($db, $dir, $version);
888 $self->throw_exception("$filename already exists, skipping $db");
891 open($file, ">$filename")
892 or $self->throw_exception("Can't open $filename for writing ($!)");
893 my $output = $sqlt->translate;
895 # print join(":", keys %{$schema->source_registrations});
896 # print Dumper($sqlt->schema);
899 $self->throw_exception("Failed to translate to $db. (" . $sqlt->error . ")");
908 =head2 deployment_statements
910 Create the statements for L</deploy> and
911 L<DBIx::Class::Schema/deploy>.
915 sub deployment_statements {
916 my ($self, $schema, $type, $version, $dir, $sqltargs) = @_;
917 $type ||= $self->sqlt_type;
918 $version ||= $schema->VERSION || '1.x';
920 eval "use SQL::Translator";
923 eval "use SQL::Translator::Parser::DBIx::Class;";
924 $self->throw_exception($@) if $@;
925 eval "use SQL::Translator::Producer::${type};";
926 $self->throw_exception($@) if $@;
927 my $tr = SQL::Translator->new(%$sqltargs);
928 SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema );
929 return "SQL::Translator::Producer::${type}"->can('produce')->($tr);
932 my $filename = $schema->ddl_filename($type, $dir, $version);
935 # $schema->create_ddl_dir([ $type ], $version, $dir, $sqltargs);
936 $self->throw_exception("No SQL::Translator, and no Schema file found, aborting deploy");
940 open($file, "<$filename")
941 or $self->throw_exception("Can't open $filename ($!)");
945 return join('', @rows);
951 Sends the appropriate statements to create or modify tables to the
952 db. This would normally be called through
953 L<DBIx::Class::Schema/deploy>.
958 my ($self, $schema, $type, $sqltargs) = @_;
959 foreach my $statement ( $self->deployment_statements($schema, $type, undef, undef, $sqltargs) ) {
960 for ( split(";\n", $statement)) {
961 next if($_ =~ /^--/);
963 # next if($_ =~ /^DROP/m);
964 next if($_ =~ /^BEGIN TRANSACTION/m);
965 next if($_ =~ /^COMMIT/m);
966 $self->debugobj->query_begin($_) if $self->debug;
967 $self->dbh->do($_) or warn "SQL was:\n $_";
968 $self->debugobj->query_end($_) if $self->debug;
973 =head2 datetime_parser
975 Returns the datetime parser class
979 sub datetime_parser {
981 return $self->{datetime_parser} ||= $self->build_datetime_parser(@_);
984 =head2 datetime_parser_type
986 Defines (returns) the datetime parser class - currently hardwired to
987 L<DateTime::Format::MySQL>
991 sub datetime_parser_type { "DateTime::Format::MySQL"; }
993 =head2 build_datetime_parser
995 See L</datetime_parser>
999 sub build_datetime_parser {
1001 my $type = $self->datetime_parser_type(@_);
1003 $self->throw_exception("Couldn't load ${type}: $@") if $@;
1007 sub DESTROY { shift->disconnect }
1013 The module defines a set of methods within the DBIC::SQL::Abstract
1014 namespace. These build on L<SQL::Abstract::Limit> to provide the
1015 SQL query functions.
1017 The following methods are extended:-
1037 =head1 ENVIRONMENT VARIABLES
1039 =head2 DBIX_CLASS_STORAGE_DBI_DEBUG
1041 If C<DBIX_CLASS_STORAGE_DBI_DEBUG> is set then SQL trace information
1042 is produced (as when the L<debug> method is set).
1044 If the value is of the form C<1=/path/name> then the trace output is
1045 written to the file C</path/name>.
1047 This environment variable is checked when the storage object is first
1048 created (when you call connect on your schema). So, run-time changes
1049 to this environment variable will not take effect unless you also
1050 re-connect on your schema.
1054 Matt S. Trout <mst@shadowcatsystems.co.uk>
1056 Andy Grundman <andy@hybridized.org>
1060 You may distribute this code under the same terms as Perl itself.