1 package DBIx::Class::Storage::DBI;
2 # -*- mode: cperl; cperl-indent-level: 2 -*-
4 use base 'DBIx::Class::Storage';
8 use Carp::Clan qw/^DBIx::Class/;
10 use SQL::Abstract::Limit;
11 use DBIx::Class::Storage::DBI::Cursor;
12 use DBIx::Class::Storage::Statistics;
13 use Scalar::Util qw/blessed weaken/;
15 __PACKAGE__->mk_group_accessors('simple' =>
16 qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts
17 _conn_pid _conn_tid transaction_depth _dbh_autocommit savepoints/
20 # the values for these accessors are picked out (and deleted) from
21 # the attribute hashref passed to connect_info
22 my @storage_options = qw/
23 on_connect_do on_disconnect_do disable_sth_caching unsafe auto_savepoint
25 __PACKAGE__->mk_group_accessors('simple' => @storage_options);
28 # default cursor class, overridable in connect_info attributes
29 __PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::Cursor');
31 __PACKAGE__->mk_group_accessors('inherited' => qw/sql_maker_class/);
32 __PACKAGE__->sql_maker_class('DBIC::SQL::Abstract');
36 package # Hide from PAUSE
37 DBIC::SQL::Abstract; # Would merge upstream, but nate doesn't reply :(
39 use base qw/SQL::Abstract::Limit/;
42 my $self = shift->SUPER::new(@_);
44 # This prevents the caching of $dbh in S::A::L, I believe
45 # If limit_dialect is a ref (like a $dbh), go ahead and replace
46 # it with what it resolves to:
47 $self->{limit_dialect} = $self->_find_syntax($self->{limit_dialect})
48 if ref $self->{limit_dialect};
55 # Some databases (sqlite) do not handle multiple parenthesis
56 # around in/between arguments. A tentative x IN ( ( 1, 2 ,3) )
57 # is interpreted as x IN 1 or something similar.
59 # Since we currently do not have access to the SQLA AST, resort
60 # to barbaric mutilation of any SQL supplied in literal form
62 sub _strip_outer_paren {
63 my ($self, $arg) = @_;
65 return $self->_SWITCH_refkind ($arg, {
67 $$arg->[0] = __strip_outer_paren ($$arg->[0]);
71 return \__strip_outer_paren( $$arg );
79 sub __strip_outer_paren {
82 if ($sql and not ref $sql) {
83 while ($sql =~ /^ \s* \( (.*) \) \s* $/x ) {
92 my ($self, $lhs, $op, $rhs) = @_;
93 $rhs = $self->_strip_outer_paren ($rhs);
94 return $self->SUPER::_where_field_IN ($lhs, $op, $rhs);
97 sub _where_field_BETWEEN {
98 my ($self, $lhs, $op, $rhs) = @_;
99 $rhs = $self->_strip_outer_paren ($rhs);
100 return $self->SUPER::_where_field_BETWEEN ($lhs, $op, $rhs);
105 # DB2 is the only remaining DB using this. Even though we are not sure if
106 # RowNumberOver is still needed here (should be part of SQLA) leave the
109 my ($self, $sql, $order, $rows, $offset ) = @_;
112 my $last = $rows + $offset;
113 my ( $order_by ) = $self->_order_by( $order );
118 SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
123 WHERE ROW_NUM BETWEEN $offset AND $last
131 # While we're at it, this should make LIMIT queries more efficient,
132 # without digging into things too deeply
133 use Scalar::Util 'blessed';
135 my ($self, $syntax) = @_;
137 # DB2 is the only remaining DB using this. Even though we are not sure if
138 # RowNumberOver is still needed here (should be part of SQLA) leave the
140 my $dbhname = blessed($syntax) ? $syntax->{Driver}{Name} : $syntax;
141 if(ref($self) && $dbhname && $dbhname eq 'DB2') {
142 return 'RowNumberOver';
145 $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
149 my ($self, $table, $fields, $where, $order, @rest) = @_;
150 if (ref $table eq 'SCALAR') {
153 elsif (not ref $table) {
154 $table = $self->_quote($table);
156 local $self->{rownum_hack_count} = 1
157 if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
158 @rest = (-1) unless defined $rest[0];
159 die "LIMIT 0 Does Not Compute" if $rest[0] == 0;
160 # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
161 local $self->{having_bind} = [];
162 my ($sql, @ret) = $self->SUPER::select(
163 $table, $self->_recurse_fields($fields), $where, $order, @rest
168 $self->{for} eq 'update' ? ' FOR UPDATE' :
169 $self->{for} eq 'shared' ? ' FOR SHARE' :
174 return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
180 $table = $self->_quote($table) unless ref($table);
181 $self->SUPER::insert($table, @_);
187 $table = $self->_quote($table) unless ref($table);
188 $self->SUPER::update($table, @_);
194 $table = $self->_quote($table) unless ref($table);
195 $self->SUPER::delete($table, @_);
201 return $_[1].$self->_order_by($_[2]);
203 return $self->SUPER::_emulate_limit(@_);
207 sub _recurse_fields {
208 my ($self, $fields, $params) = @_;
209 my $ref = ref $fields;
210 return $self->_quote($fields) unless $ref;
211 return $$fields if $ref eq 'SCALAR';
213 if ($ref eq 'ARRAY') {
214 return join(', ', map {
215 $self->_recurse_fields($_)
216 .(exists $self->{rownum_hack_count} && !($params && $params->{no_rownum_hack})
217 ? ' AS col'.$self->{rownum_hack_count}++
220 } elsif ($ref eq 'HASH') {
221 foreach my $func (keys %$fields) {
222 return $self->_sqlcase($func)
223 .'( '.$self->_recurse_fields($fields->{$func}).' )';
226 # Is the second check absolutely necessary?
227 elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
228 return $self->_bind_to_sql( $fields );
231 Carp::croak($ref . qq{ unexpected in _recurse_fields()})
239 if (ref $_[0] eq 'HASH') {
240 if (defined $_[0]->{group_by}) {
241 $ret = $self->_sqlcase(' group by ')
242 .$self->_recurse_fields($_[0]->{group_by}, { no_rownum_hack => 1 });
244 if (defined $_[0]->{having}) {
246 ($frag, @extra) = $self->_recurse_where($_[0]->{having});
247 push(@{$self->{having_bind}}, @extra);
248 $ret .= $self->_sqlcase(' having ').$frag;
250 if (defined $_[0]->{order_by}) {
251 $ret .= $self->_order_by($_[0]->{order_by});
253 if (grep { $_ =~ /^-(desc|asc)/i } keys %{$_[0]}) {
254 return $self->SUPER::_order_by($_[0]);
256 } elsif (ref $_[0] eq 'SCALAR') {
257 $ret = $self->_sqlcase(' order by ').${ $_[0] };
258 } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
259 my @order = @{+shift};
260 $ret = $self->_sqlcase(' order by ')
262 my $r = $self->_order_by($_, @_);
263 $r =~ s/^ ?ORDER BY //i;
267 $ret = $self->SUPER::_order_by(@_);
272 sub _order_directions {
273 my ($self, $order) = @_;
274 $order = $order->{order_by} if ref $order eq 'HASH';
275 return $self->SUPER::_order_directions($order);
279 my ($self, $from) = @_;
280 if (ref $from eq 'ARRAY') {
281 return $self->_recurse_from(@$from);
282 } elsif (ref $from eq 'HASH') {
283 return $self->_make_as($from);
285 return $from; # would love to quote here but _table ends up getting called
286 # twice during an ->select without a limit clause due to
287 # the way S::A::Limit->select works. should maybe consider
288 # bypassing this and doing S::A::select($self, ...) in
289 # our select method above. meantime, quoting shims have
290 # been added to select/insert/update/delete here
295 my ($self, $from, @join) = @_;
297 push(@sqlf, $self->_make_as($from));
298 foreach my $j (@join) {
301 # check whether a join type exists
302 my $join_clause = '';
303 my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
304 if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
305 $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
307 $join_clause = ' JOIN ';
309 push(@sqlf, $join_clause);
311 if (ref $to eq 'ARRAY') {
312 push(@sqlf, '(', $self->_recurse_from(@$to), ')');
314 push(@sqlf, $self->_make_as($to));
316 push(@sqlf, ' ON ', $self->_join_condition($on));
318 return join('', @sqlf);
324 my $sql = shift @$$arr;
325 $sql =~ s/\?/$self->_quote((shift @$$arr)->[1])/eg;
330 my ($self, $from) = @_;
331 return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
332 : ref $_ eq 'REF' ? $self->_bind_to_sql($_)
334 } reverse each %{$self->_skip_options($from)});
338 my ($self, $hash) = @_;
340 $clean_hash->{$_} = $hash->{$_}
341 for grep {!/^-/} keys %$hash;
345 sub _join_condition {
346 my ($self, $cond) = @_;
347 if (ref $cond eq 'HASH') {
352 # XXX no throw_exception() in this package and croak() fails with strange results
353 Carp::croak(ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
354 if ref($v) ne 'SCALAR';
358 my $x = '= '.$self->_quote($v); $j{$_} = \$x;
361 return scalar($self->_recurse_where(\%j));
362 } elsif (ref $cond eq 'ARRAY') {
363 return join(' OR ', map { $self->_join_condition($_) } @$cond);
365 die "Can't handle this yet!";
370 my ($self, $label) = @_;
371 return '' unless defined $label;
372 return "*" if $label eq '*';
373 return $label unless $self->{quote_char};
374 if(ref $self->{quote_char} eq "ARRAY"){
375 return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
376 if !defined $self->{name_sep};
377 my $sep = $self->{name_sep};
378 return join($self->{name_sep},
379 map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
380 split(/\Q$sep\E/,$label));
382 return $self->SUPER::_quote($label);
387 $self->{limit_dialect} = shift if @_;
388 return $self->{limit_dialect};
393 $self->{quote_char} = shift if @_;
394 return $self->{quote_char};
399 $self->{name_sep} = shift if @_;
400 return $self->{name_sep};
403 } # End of BEGIN block
407 DBIx::Class::Storage::DBI - DBI storage handler
411 my $schema = MySchema->connect('dbi:SQLite:my.db');
413 $schema->storage->debug(1);
414 $schema->dbh_do("DROP TABLE authors");
416 $schema->resultset('Book')->search({
417 written_on => $schema->storage->datetime_parser(DateTime->now)
422 This class represents the connection to an RDBMS via L<DBI>. See
423 L<DBIx::Class::Storage> for general information. This pod only
424 documents DBI-specific methods and behaviors.
431 my $new = shift->next::method(@_);
433 $new->transaction_depth(0);
434 $new->_sql_maker_opts({});
435 $new->{savepoints} = [];
436 $new->{_in_dbh_do} = 0;
437 $new->{_dbh_gen} = 0;
444 This method is normally called by L<DBIx::Class::Schema/connection>, which
445 encapsulates its argument list in an arrayref before passing them here.
447 The argument list may contain:
453 The same 4-element argument set one would normally pass to
454 L<DBI/connect>, optionally followed by
455 L<extra attributes|/DBIx::Class specific connection attributes>
456 recognized by DBIx::Class:
458 $connect_info_args = [ $dsn, $user, $password, \%dbi_attributes?, \%extra_attributes? ];
462 A single code reference which returns a connected
463 L<DBI database handle|DBI/connect> optionally followed by
464 L<extra attributes|/DBIx::Class specific connection attributes> recognized
467 $connect_info_args = [ sub { DBI->connect (...) }, \%extra_attributes? ];
471 A single hashref with all the attributes and the dsn/user/password
474 $connect_info_args = [{
482 This is particularly useful for L<Catalyst> based applications, allowing the
483 following config (L<Config::General> style):
488 dsn dbi:mysql:database=test
497 Please note that the L<DBI> docs recommend that you always explicitly
498 set C<AutoCommit> to either I<0> or I<1>. L<DBIx::Class> further
499 recommends that it be set to I<1>, and that you perform transactions
500 via our L<DBIx::Class::Schema/txn_do> method. L<DBIx::Class> will set it
501 to I<1> if you do not do explicitly set it to zero. This is the default
502 for most DBDs. See L</DBIx::Class and AutoCommit> for details.
504 =head3 DBIx::Class specific connection attributes
506 In addition to the standard L<DBI|DBI/ATTRIBUTES_COMMON_TO_ALL_HANDLES>
507 L<connection|DBI/Database_Handle_Attributes> attributes, DBIx::Class recognizes
508 the following connection options. These options can be mixed in with your other
509 L<DBI> connection attributes, or placed in a seperate hashref
510 (C<\%extra_attributes>) as shown above.
512 Every time C<connect_info> is invoked, any previous settings for
513 these options will be cleared before setting the new ones, regardless of
514 whether any options are specified in the new C<connect_info>.
521 Specifies things to do immediately after connecting or re-connecting to
522 the database. Its value may contain:
526 =item an array reference
528 This contains SQL statements to execute in order. Each element contains
529 a string or a code reference that returns a string.
531 =item a code reference
533 This contains some code to execute. Unlike code references within an
534 array reference, its return value is ignored.
538 =item on_disconnect_do
540 Takes arguments in the same form as L</on_connect_do> and executes them
541 immediately before disconnecting from the database.
543 Note, this only runs if you explicitly call L</disconnect> on the
546 =item disable_sth_caching
548 If set to a true value, this option will disable the caching of
549 statement handles via L<DBI/prepare_cached>.
553 Sets the limit dialect. This is useful for JDBC-bridge among others
554 where the remote SQL-dialect cannot be determined by the name of the
555 driver alone. See also L<SQL::Abstract::Limit>.
559 Specifies what characters to use to quote table and column names. If
560 you use this you will want to specify L</name_sep> as well.
562 C<quote_char> expects either a single character, in which case is it
563 is placed on either side of the table/column name, or an arrayref of length
564 2 in which case the table/column name is placed between the elements.
566 For example under MySQL you should use C<< quote_char => '`' >>, and for
567 SQL Server you should use C<< quote_char => [qw/[ ]/] >>.
571 This only needs to be used in conjunction with C<quote_char>, and is used to
572 specify the charecter that seperates elements (schemas, tables, columns) from
573 each other. In most cases this is simply a C<.>.
575 The consequences of not supplying this value is that L<SQL::Abstract>
576 will assume DBIx::Class' uses of aliases to be complete column
577 names. The output will look like I<"me.name"> when it should actually
582 This Storage driver normally installs its own C<HandleError>, sets
583 C<RaiseError> and C<ShowErrorStatement> on, and sets C<PrintError> off on
584 all database handles, including those supplied by a coderef. It does this
585 so that it can have consistent and useful error behavior.
587 If you set this option to a true value, Storage will not do its usual
588 modifications to the database handle's attributes, and instead relies on
589 the settings in your connect_info DBI options (or the values you set in
590 your connection coderef, in the case that you are connecting via coderef).
592 Note that your custom settings can cause Storage to malfunction,
593 especially if you set a C<HandleError> handler that suppresses exceptions
594 and/or disable C<RaiseError>.
598 If this option is true, L<DBIx::Class> will use savepoints when nesting
599 transactions, making it possible to recover from failure in the inner
600 transaction without having to abort all outer transactions.
604 Use this argument to supply a cursor class other than the default
605 L<DBIx::Class::Storage::DBI::Cursor>.
609 Some real-life examples of arguments to L</connect_info> and
610 L<DBIx::Class::Schema/connect>
612 # Simple SQLite connection
613 ->connect_info([ 'dbi:SQLite:./foo.db' ]);
616 ->connect_info([ sub { DBI->connect(...) } ]);
618 # A bit more complicated
625 { quote_char => q{"}, name_sep => q{.} },
629 # Equivalent to the previous example
635 { AutoCommit => 1, quote_char => q{"}, name_sep => q{.} },
639 # Same, but with hashref as argument
640 # See parse_connect_info for explanation
643 dsn => 'dbi:Pg:dbname=foo',
645 password => 'my_pg_password',
652 # Subref + DBIx::Class-specific connection options
655 sub { DBI->connect(...) },
659 on_connect_do => ['SET search_path TO myschema,otherschema,public'],
660 disable_sth_caching => 1,
670 my ($self, $info_arg) = @_;
672 return $self->_connect_info if !$info_arg;
674 my @args = @$info_arg; # take a shallow copy for further mutilation
675 $self->_connect_info([@args]); # copy for _connect_info
678 # combine/pre-parse arguments depending on invocation style
681 if (ref $args[0] eq 'CODE') { # coderef with optional \%extra_attributes
682 %attrs = %{ $args[1] || {} };
685 elsif (ref $args[0] eq 'HASH') { # single hashref (i.e. Catalyst config)
686 %attrs = %{$args[0]};
688 for (qw/password user dsn/) {
689 unshift @args, delete $attrs{$_};
692 else { # otherwise assume dsn/user/password + \%attrs + \%extra_attrs
694 % { $args[3] || {} },
695 % { $args[4] || {} },
697 @args = @args[0,1,2];
700 # Kill sql_maker/_sql_maker_opts, so we get a fresh one with only
701 # the new set of options
702 $self->_sql_maker(undef);
703 $self->_sql_maker_opts({});
706 for my $storage_opt (@storage_options, 'cursor_class') { # @storage_options is declared at the top of the module
707 if(my $value = delete $attrs{$storage_opt}) {
708 $self->$storage_opt($value);
711 for my $sql_maker_opt (qw/limit_dialect quote_char name_sep/) {
712 if(my $opt_val = delete $attrs{$sql_maker_opt}) {
713 $self->_sql_maker_opts->{$sql_maker_opt} = $opt_val;
718 %attrs = () if (ref $args[0] eq 'CODE'); # _connect() never looks past $args[0] in this case
720 $self->_dbi_connect_info([@args, keys %attrs ? \%attrs : ()]);
721 $self->_connect_info;
726 This method is deprecated in favour of setting via L</connect_info>.
731 Arguments: ($subref | $method_name), @extra_coderef_args?
733 Execute the given $subref or $method_name using the new exception-based
734 connection management.
736 The first two arguments will be the storage object that C<dbh_do> was called
737 on and a database handle to use. Any additional arguments will be passed
738 verbatim to the called subref as arguments 2 and onwards.
740 Using this (instead of $self->_dbh or $self->dbh) ensures correct
741 exception handling and reconnection (or failover in future subclasses).
743 Your subref should have no side-effects outside of the database, as
744 there is the potential for your subref to be partially double-executed
745 if the database connection was stale/dysfunctional.
749 my @stuff = $schema->storage->dbh_do(
751 my ($storage, $dbh, @cols) = @_;
752 my $cols = join(q{, }, @cols);
753 $dbh->selectrow_array("SELECT $cols FROM foo");
764 my $dbh = $self->_dbh;
766 return $self->$code($dbh, @_) if $self->{_in_dbh_do}
767 || $self->{transaction_depth};
769 local $self->{_in_dbh_do} = 1;
772 my $want_array = wantarray;
775 $self->_verify_pid if $dbh;
777 $self->_populate_dbh;
782 @result = $self->$code($dbh, @_);
784 elsif(defined $want_array) {
785 $result[0] = $self->$code($dbh, @_);
788 $self->$code($dbh, @_);
793 if(!$exception) { return $want_array ? @result : $result[0] }
795 $self->throw_exception($exception) if $self->connected;
797 # We were not connected - reconnect and retry, but let any
798 # exception fall right through this time
799 $self->_populate_dbh;
800 $self->$code($self->_dbh, @_);
803 # This is basically a blend of dbh_do above and DBIx::Class::Storage::txn_do.
804 # It also informs dbh_do to bypass itself while under the direction of txn_do,
805 # via $self->{_in_dbh_do} (this saves some redundant eval and errorcheck, etc)
810 ref $coderef eq 'CODE' or $self->throw_exception
811 ('$coderef must be a CODE reference');
813 return $coderef->(@_) if $self->{transaction_depth} && ! $self->auto_savepoint;
815 local $self->{_in_dbh_do} = 1;
818 my $want_array = wantarray;
823 $self->_verify_pid if $self->_dbh;
824 $self->_populate_dbh if !$self->_dbh;
828 @result = $coderef->(@_);
830 elsif(defined $want_array) {
831 $result[0] = $coderef->(@_);
840 if(!$exception) { return $want_array ? @result : $result[0] }
842 if($tried++ > 0 || $self->connected) {
843 eval { $self->txn_rollback };
844 my $rollback_exception = $@;
845 if($rollback_exception) {
846 my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
847 $self->throw_exception($exception) # propagate nested rollback
848 if $rollback_exception =~ /$exception_class/;
850 $self->throw_exception(
851 "Transaction aborted: ${exception}. "
852 . "Rollback failed: ${rollback_exception}"
855 $self->throw_exception($exception)
858 # We were not connected, and was first try - reconnect and retry
860 $self->_populate_dbh;
866 Our C<disconnect> method also performs a rollback first if the
867 database is not in C<AutoCommit> mode.
874 if( $self->connected ) {
875 my $connection_do = $self->on_disconnect_do;
876 $self->_do_connection_actions($connection_do) if ref($connection_do);
878 $self->_dbh->rollback unless $self->_dbh_autocommit;
879 $self->_dbh->disconnect;
885 =head2 with_deferred_fk_checks
889 =item Arguments: C<$coderef>
891 =item Return Value: The return value of $coderef
895 Storage specific method to run the code ref with FK checks deferred or
896 in MySQL's case disabled entirely.
900 # Storage subclasses should override this
901 sub with_deferred_fk_checks {
902 my ($self, $sub) = @_;
910 if(my $dbh = $self->_dbh) {
911 if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
918 return 0 if !$self->_dbh;
920 return ($dbh->FETCH('Active') && $dbh->ping);
926 # handle pid changes correctly
927 # NOTE: assumes $self->_dbh is a valid $dbh
931 return if defined $self->_conn_pid && $self->_conn_pid == $$;
933 $self->_dbh->{InactiveDestroy} = 1;
940 sub ensure_connected {
943 unless ($self->connected) {
944 $self->_populate_dbh;
950 Returns the dbh - a data base handle of class L<DBI>.
957 $self->ensure_connected;
961 sub _sql_maker_args {
964 return ( bindtype=>'columns', array_datatypes => 1, limit_dialect => $self->dbh, %{$self->_sql_maker_opts} );
969 unless ($self->_sql_maker) {
970 my $sql_maker_class = $self->sql_maker_class;
971 $self->_sql_maker($sql_maker_class->new( $self->_sql_maker_args ));
973 return $self->_sql_maker;
980 my @info = @{$self->_dbi_connect_info || []};
981 $self->_dbh($self->_connect(@info));
983 # Always set the transaction depth on connect, since
984 # there is no transaction in progress by definition
985 $self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
987 if(ref $self eq 'DBIx::Class::Storage::DBI') {
988 my $driver = $self->_dbh->{Driver}->{Name};
989 if ($self->load_optional_class("DBIx::Class::Storage::DBI::${driver}")) {
990 bless $self, "DBIx::Class::Storage::DBI::${driver}";
995 $self->_conn_pid($$);
996 $self->_conn_tid(threads->tid) if $INC{'threads.pm'};
998 my $connection_do = $self->on_connect_do;
999 $self->_do_connection_actions($connection_do) if ref($connection_do);
1002 sub _do_connection_actions {
1004 my $connection_do = shift;
1006 if (ref $connection_do eq 'ARRAY') {
1007 $self->_do_query($_) foreach @$connection_do;
1009 elsif (ref $connection_do eq 'CODE') {
1010 $connection_do->($self);
1017 my ($self, $action) = @_;
1019 if (ref $action eq 'CODE') {
1020 $action = $action->($self);
1021 $self->_do_query($_) foreach @$action;
1024 # Most debuggers expect ($sql, @bind), so we need to exclude
1025 # the attribute hash which is the second argument to $dbh->do
1026 # furthermore the bind values are usually to be presented
1027 # as named arrayref pairs, so wrap those here too
1028 my @do_args = (ref $action eq 'ARRAY') ? (@$action) : ($action);
1029 my $sql = shift @do_args;
1030 my $attrs = shift @do_args;
1031 my @bind = map { [ undef, $_ ] } @do_args;
1033 $self->_query_start($sql, @bind);
1034 $self->_dbh->do($sql, $attrs, @do_args);
1035 $self->_query_end($sql, @bind);
1042 my ($self, @info) = @_;
1044 $self->throw_exception("You failed to provide any connection info")
1047 my ($old_connect_via, $dbh);
1049 if ($INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}) {
1050 $old_connect_via = $DBI::connect_via;
1051 $DBI::connect_via = 'connect';
1055 if(ref $info[0] eq 'CODE') {
1059 $dbh = DBI->connect(@info);
1062 if($dbh && !$self->unsafe) {
1063 my $weak_self = $self;
1065 $dbh->{HandleError} = sub {
1067 $weak_self->throw_exception("DBI Exception: $_[0]");
1070 croak ("DBI Exception: $_[0]");
1073 $dbh->{ShowErrorStatement} = 1;
1074 $dbh->{RaiseError} = 1;
1075 $dbh->{PrintError} = 0;
1079 $DBI::connect_via = $old_connect_via if $old_connect_via;
1081 $self->throw_exception("DBI Connection failed: " . ($@||$DBI::errstr))
1084 $self->_dbh_autocommit($dbh->{AutoCommit});
1090 my ($self, $name) = @_;
1092 $name = $self->_svp_generate_name
1093 unless defined $name;
1095 $self->throw_exception ("You can't use savepoints outside a transaction")
1096 if $self->{transaction_depth} == 0;
1098 $self->throw_exception ("Your Storage implementation doesn't support savepoints")
1099 unless $self->can('_svp_begin');
1101 push @{ $self->{savepoints} }, $name;
1103 $self->debugobj->svp_begin($name) if $self->debug;
1105 return $self->_svp_begin($name);
1109 my ($self, $name) = @_;
1111 $self->throw_exception ("You can't use savepoints outside a transaction")
1112 if $self->{transaction_depth} == 0;
1114 $self->throw_exception ("Your Storage implementation doesn't support savepoints")
1115 unless $self->can('_svp_release');
1117 if (defined $name) {
1118 $self->throw_exception ("Savepoint '$name' does not exist")
1119 unless grep { $_ eq $name } @{ $self->{savepoints} };
1121 # Dig through the stack until we find the one we are releasing. This keeps
1122 # the stack up to date.
1125 do { $svp = pop @{ $self->{savepoints} } } while $svp ne $name;
1127 $name = pop @{ $self->{savepoints} };
1130 $self->debugobj->svp_release($name) if $self->debug;
1132 return $self->_svp_release($name);
1136 my ($self, $name) = @_;
1138 $self->throw_exception ("You can't use savepoints outside a transaction")
1139 if $self->{transaction_depth} == 0;
1141 $self->throw_exception ("Your Storage implementation doesn't support savepoints")
1142 unless $self->can('_svp_rollback');
1144 if (defined $name) {
1145 # If they passed us a name, verify that it exists in the stack
1146 unless(grep({ $_ eq $name } @{ $self->{savepoints} })) {
1147 $self->throw_exception("Savepoint '$name' does not exist!");
1150 # Dig through the stack until we find the one we are releasing. This keeps
1151 # the stack up to date.
1152 while(my $s = pop(@{ $self->{savepoints} })) {
1153 last if($s eq $name);
1155 # Add the savepoint back to the stack, as a rollback doesn't remove the
1156 # named savepoint, only everything after it.
1157 push(@{ $self->{savepoints} }, $name);
1159 # We'll assume they want to rollback to the last savepoint
1160 $name = $self->{savepoints}->[-1];
1163 $self->debugobj->svp_rollback($name) if $self->debug;
1165 return $self->_svp_rollback($name);
1168 sub _svp_generate_name {
1171 return 'savepoint_'.scalar(@{ $self->{'savepoints'} });
1176 $self->ensure_connected();
1177 if($self->{transaction_depth} == 0) {
1178 $self->debugobj->txn_begin()
1180 # this isn't ->_dbh-> because
1181 # we should reconnect on begin_work
1182 # for AutoCommit users
1183 $self->dbh->begin_work;
1184 } elsif ($self->auto_savepoint) {
1187 $self->{transaction_depth}++;
1192 if ($self->{transaction_depth} == 1) {
1193 my $dbh = $self->_dbh;
1194 $self->debugobj->txn_commit()
1197 $self->{transaction_depth} = 0
1198 if $self->_dbh_autocommit;
1200 elsif($self->{transaction_depth} > 1) {
1201 $self->{transaction_depth}--;
1203 if $self->auto_savepoint;
1209 my $dbh = $self->_dbh;
1211 if ($self->{transaction_depth} == 1) {
1212 $self->debugobj->txn_rollback()
1214 $self->{transaction_depth} = 0
1215 if $self->_dbh_autocommit;
1218 elsif($self->{transaction_depth} > 1) {
1219 $self->{transaction_depth}--;
1220 if ($self->auto_savepoint) {
1221 $self->svp_rollback;
1226 die DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->new;
1231 my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
1232 $error =~ /$exception_class/ and $self->throw_exception($error);
1233 # ensure that a failed rollback resets the transaction depth
1234 $self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
1235 $self->throw_exception($error);
1239 # This used to be the top-half of _execute. It was split out to make it
1240 # easier to override in NoBindVars without duping the rest. It takes up
1241 # all of _execute's args, and emits $sql, @bind.
1242 sub _prep_for_execute {
1243 my ($self, $op, $extra_bind, $ident, $args) = @_;
1245 if( blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
1246 $ident = $ident->from();
1249 my ($sql, @bind) = $self->sql_maker->$op($ident, @$args);
1252 map { ref $_ eq 'ARRAY' ? $_ : [ '!!dummy', $_ ] } @$extra_bind)
1254 return ($sql, \@bind);
1257 sub _fix_bind_params {
1258 my ($self, @bind) = @_;
1260 ### Turn @bind from something like this:
1261 ### ( [ "artist", 1 ], [ "cdid", 1, 3 ] )
1263 ### ( "'1'", "'1'", "'3'" )
1266 if ( defined( $_ && $_->[1] ) ) {
1267 map { qq{'$_'}; } @{$_}[ 1 .. $#$_ ];
1274 my ( $self, $sql, @bind ) = @_;
1276 if ( $self->debug ) {
1277 @bind = $self->_fix_bind_params(@bind);
1279 $self->debugobj->query_start( $sql, @bind );
1284 my ( $self, $sql, @bind ) = @_;
1286 if ( $self->debug ) {
1287 @bind = $self->_fix_bind_params(@bind);
1288 $self->debugobj->query_end( $sql, @bind );
1293 my ($self, $dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_;
1295 my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args);
1297 $self->_query_start( $sql, @$bind );
1299 my $sth = $self->sth($sql,$op);
1301 my $placeholder_index = 1;
1303 foreach my $bound (@$bind) {
1304 my $attributes = {};
1305 my($column_name, @data) = @$bound;
1307 if ($bind_attributes) {
1308 $attributes = $bind_attributes->{$column_name}
1309 if defined $bind_attributes->{$column_name};
1312 foreach my $data (@data) {
1313 my $ref = ref $data;
1314 $data = $ref && $ref ne 'ARRAY' ? ''.$data : $data; # stringify args (except arrayrefs)
1316 $sth->bind_param($placeholder_index, $data, $attributes);
1317 $placeholder_index++;
1321 # Can this fail without throwing an exception anyways???
1322 my $rv = $sth->execute();
1323 $self->throw_exception($sth->errstr) if !$rv;
1325 $self->_query_end( $sql, @$bind );
1327 return (wantarray ? ($rv, $sth, @$bind) : $rv);
1332 $self->dbh_do('_dbh_execute', @_)
1336 my ($self, $source, $to_insert) = @_;
1338 my $ident = $source->from;
1339 my $bind_attributes = $self->source_bind_attributes($source);
1341 my $updated_cols = {};
1343 $self->ensure_connected;
1344 foreach my $col ( $source->columns ) {
1345 if ( !defined $to_insert->{$col} ) {
1346 my $col_info = $source->column_info($col);
1348 if ( $col_info->{auto_nextval} ) {
1349 $updated_cols->{$col} = $to_insert->{$col} = $self->_sequence_fetch( 'nextval', $col_info->{sequence} || $self->_dbh_get_autoinc_seq($self->dbh, $source) );
1354 $self->_execute('insert' => [], $source, $bind_attributes, $to_insert);
1356 return $updated_cols;
1359 ## Still not quite perfect, and EXPERIMENTAL
1360 ## Currently it is assumed that all values passed will be "normal", i.e. not
1361 ## scalar refs, or at least, all the same type as the first set, the statement is
1362 ## only prepped once.
1364 my ($self, $source, $cols, $data) = @_;
1366 my $table = $source->from;
1367 @colvalues{@$cols} = (0..$#$cols);
1368 my ($sql, @bind) = $self->sql_maker->insert($table, \%colvalues);
1370 $self->_query_start( $sql, @bind );
1371 my $sth = $self->sth($sql);
1373 # @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
1375 ## This must be an arrayref, else nothing works!
1376 my $tuple_status = [];
1378 ## Get the bind_attributes, if any exist
1379 my $bind_attributes = $self->source_bind_attributes($source);
1381 ## Bind the values and execute
1382 my $placeholder_index = 1;
1384 foreach my $bound (@bind) {
1386 my $attributes = {};
1387 my ($column_name, $data_index) = @$bound;
1389 if( $bind_attributes ) {
1390 $attributes = $bind_attributes->{$column_name}
1391 if defined $bind_attributes->{$column_name};
1394 my @data = map { $_->[$data_index] } @$data;
1396 $sth->bind_param_array( $placeholder_index, [@data], $attributes );
1397 $placeholder_index++;
1399 my $rv = $sth->execute_array({ArrayTupleStatus => $tuple_status});
1400 $self->throw_exception($sth->errstr) if !$rv;
1402 $self->_query_end( $sql, @bind );
1403 return (wantarray ? ($rv, $sth, @bind) : $rv);
1407 my $self = shift @_;
1408 my $source = shift @_;
1409 my $bind_attributes = $self->source_bind_attributes($source);
1411 return $self->_execute('update' => [], $source, $bind_attributes, @_);
1416 my $self = shift @_;
1417 my $source = shift @_;
1419 my $bind_attrs = {}; ## If ever it's needed...
1421 return $self->_execute('delete' => [], $source, $bind_attrs, @_);
1426 my $sql_maker = $self->sql_maker;
1427 local $sql_maker->{for};
1428 return $self->_execute($self->_select_args(@_));
1432 my ($self, $ident, $select, $condition, $attrs) = @_;
1433 my $order = $attrs->{order_by};
1435 my $for = delete $attrs->{for};
1436 my $sql_maker = $self->sql_maker;
1437 $sql_maker->{for} = $for;
1439 if (exists $attrs->{group_by} || $attrs->{having}) {
1441 group_by => $attrs->{group_by},
1442 having => $attrs->{having},
1443 ($order ? (order_by => $order) : ())
1446 my $bind_attrs = {}; ## Future support
1447 my @args = ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $condition, $order);
1448 if ($attrs->{software_limit} ||
1449 $self->sql_maker->_default_limit_syntax eq "GenericSubQ") {
1450 $attrs->{software_limit} = 1;
1452 $self->throw_exception("rows attribute must be positive if present")
1453 if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
1455 # MySQL actually recommends this approach. I cringe.
1456 $attrs->{rows} = 2**48 if not defined $attrs->{rows} and defined $attrs->{offset};
1457 push @args, $attrs->{rows}, $attrs->{offset};
1462 sub source_bind_attributes {
1463 my ($self, $source) = @_;
1465 my $bind_attributes;
1466 foreach my $column ($source->columns) {
1468 my $data_type = $source->column_info($column)->{data_type} || '';
1469 $bind_attributes->{$column} = $self->bind_attribute_by_data_type($data_type)
1473 return $bind_attributes;
1480 =item Arguments: $ident, $select, $condition, $attrs
1484 Handle a SQL select statement.
1490 my ($ident, $select, $condition, $attrs) = @_;
1491 return $self->cursor_class->new($self, \@_, $attrs);
1496 my ($rv, $sth, @bind) = $self->_select(@_);
1497 my @row = $sth->fetchrow_array;
1498 my @nextrow = $sth->fetchrow_array if @row;
1499 if(@row && @nextrow) {
1500 carp "Query returned more than one row. SQL that returns multiple rows is DEPRECATED for ->find and ->single";
1502 # Need to call finish() to work round broken DBDs
1511 =item Arguments: $sql
1515 Returns a L<DBI> sth (statement handle) for the supplied SQL.
1520 my ($self, $dbh, $sql) = @_;
1522 # 3 is the if_active parameter which avoids active sth re-use
1523 my $sth = $self->disable_sth_caching
1524 ? $dbh->prepare($sql)
1525 : $dbh->prepare_cached($sql, {}, 3);
1527 # XXX You would think RaiseError would make this impossible,
1528 # but apparently that's not true :(
1529 $self->throw_exception($dbh->errstr) if !$sth;
1535 my ($self, $sql) = @_;
1536 $self->dbh_do('_dbh_sth', $sql);
1539 sub _dbh_columns_info_for {
1540 my ($self, $dbh, $table) = @_;
1542 if ($dbh->can('column_info')) {
1545 my ($schema,$tab) = $table =~ /^(.+?)\.(.+)$/ ? ($1,$2) : (undef,$table);
1546 my $sth = $dbh->column_info( undef,$schema, $tab, '%' );
1548 while ( my $info = $sth->fetchrow_hashref() ){
1550 $column_info{data_type} = $info->{TYPE_NAME};
1551 $column_info{size} = $info->{COLUMN_SIZE};
1552 $column_info{is_nullable} = $info->{NULLABLE} ? 1 : 0;
1553 $column_info{default_value} = $info->{COLUMN_DEF};
1554 my $col_name = $info->{COLUMN_NAME};
1555 $col_name =~ s/^\"(.*)\"$/$1/;
1557 $result{$col_name} = \%column_info;
1560 return \%result if !$@ && scalar keys %result;
1564 my $sth = $dbh->prepare($self->sql_maker->select($table, undef, \'1 = 0'));
1566 my @columns = @{$sth->{NAME_lc}};
1567 for my $i ( 0 .. $#columns ){
1569 $column_info{data_type} = $sth->{TYPE}->[$i];
1570 $column_info{size} = $sth->{PRECISION}->[$i];
1571 $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0;
1573 if ($column_info{data_type} =~ m/^(.*?)\((.*?)\)$/) {
1574 $column_info{data_type} = $1;
1575 $column_info{size} = $2;
1578 $result{$columns[$i]} = \%column_info;
1582 foreach my $col (keys %result) {
1583 my $colinfo = $result{$col};
1584 my $type_num = $colinfo->{data_type};
1586 if(defined $type_num && $dbh->can('type_info')) {
1587 my $type_info = $dbh->type_info($type_num);
1588 $type_name = $type_info->{TYPE_NAME} if $type_info;
1589 $colinfo->{data_type} = $type_name if $type_name;
1596 sub columns_info_for {
1597 my ($self, $table) = @_;
1598 $self->dbh_do('_dbh_columns_info_for', $table);
1601 =head2 last_insert_id
1603 Return the row id of the last insert.
1607 sub _dbh_last_insert_id {
1608 # All Storage's need to register their own _dbh_last_insert_id
1609 # the old SQLite-based method was highly inappropriate
1612 my $class = ref $self;
1613 $self->throw_exception (<<EOE);
1615 No _dbh_last_insert_id() method found in $class.
1616 Since the method of obtaining the autoincrement id of the last insert
1617 operation varies greatly between different databases, this method must be
1618 individually implemented for every storage class.
1622 sub last_insert_id {
1624 $self->dbh_do('_dbh_last_insert_id', @_);
1629 Returns the database driver name.
1633 sub sqlt_type { shift->dbh->{Driver}->{Name} }
1635 =head2 bind_attribute_by_data_type
1637 Given a datatype from column info, returns a database specific bind
1638 attribute for C<< $dbh->bind_param($val,$attribute) >> or nothing if we will
1639 let the database planner just handle it.
1641 Generally only needed for special case column types, like bytea in postgres.
1645 sub bind_attribute_by_data_type {
1649 =head2 create_ddl_dir
1653 =item Arguments: $schema \@databases, $version, $directory, $preversion, \%sqlt_args
1657 Creates a SQL file based on the Schema, for each of the specified
1658 database types, in the given directory.
1660 By default, C<\%sqlt_args> will have
1662 { add_drop_table => 1, ignore_constraint_names => 1, ignore_index_names => 1 }
1664 merged with the hash passed in. To disable any of those features, pass in a
1665 hashref like the following
1667 { ignore_constraint_names => 0, # ... other options }
1671 sub create_ddl_dir {
1672 my ($self, $schema, $databases, $version, $dir, $preversion, $sqltargs) = @_;
1674 if(!$dir || !-d $dir) {
1675 warn "No directory given, using ./\n";
1678 $databases ||= ['MySQL', 'SQLite', 'PostgreSQL'];
1679 $databases = [ $databases ] if(ref($databases) ne 'ARRAY');
1681 my $schema_version = $schema->schema_version || '1.x';
1682 $version ||= $schema_version;
1685 add_drop_table => 1,
1686 ignore_constraint_names => 1,
1687 ignore_index_names => 1,
1691 $self->throw_exception(q{Can't create a ddl file without SQL::Translator 0.09003: '}
1692 . $self->_check_sqlt_message . q{'})
1693 if !$self->_check_sqlt_version;
1695 my $sqlt = SQL::Translator->new( $sqltargs );
1697 $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
1698 my $sqlt_schema = $sqlt->translate({ data => $schema }) or die $sqlt->error;
1700 foreach my $db (@$databases) {
1702 $sqlt->{schema} = $sqlt_schema;
1703 $sqlt->producer($db);
1706 my $filename = $schema->ddl_filename($db, $version, $dir);
1707 if (-e $filename && ($version eq $schema_version )) {
1708 # if we are dumping the current version, overwrite the DDL
1709 warn "Overwriting existing DDL file - $filename";
1713 my $output = $sqlt->translate;
1715 warn("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
1718 if(!open($file, ">$filename")) {
1719 $self->throw_exception("Can't open $filename for writing ($!)");
1722 print $file $output;
1725 next unless ($preversion);
1727 require SQL::Translator::Diff;
1729 my $prefilename = $schema->ddl_filename($db, $preversion, $dir);
1730 if(!-e $prefilename) {
1731 warn("No previous schema file found ($prefilename)");
1735 my $difffile = $schema->ddl_filename($db, $version, $dir, $preversion);
1737 warn("Overwriting existing diff file - $difffile");
1743 my $t = SQL::Translator->new($sqltargs);
1746 $t->parser( $db ) or die $t->error;
1747 my $out = $t->translate( $prefilename ) or die $t->error;
1748 $source_schema = $t->schema;
1749 unless ( $source_schema->name ) {
1750 $source_schema->name( $prefilename );
1754 # The "new" style of producers have sane normalization and can support
1755 # diffing a SQL file against a DBIC->SQLT schema. Old style ones don't
1756 # And we have to diff parsed SQL against parsed SQL.
1757 my $dest_schema = $sqlt_schema;
1759 unless ( "SQL::Translator::Producer::$db"->can('preprocess_schema') ) {
1760 my $t = SQL::Translator->new($sqltargs);
1763 $t->parser( $db ) or die $t->error;
1764 my $out = $t->translate( $filename ) or die $t->error;
1765 $dest_schema = $t->schema;
1766 $dest_schema->name( $filename )
1767 unless $dest_schema->name;
1770 my $diff = SQL::Translator::Diff::schema_diff($source_schema, $db,
1774 if(!open $file, ">$difffile") {
1775 $self->throw_exception("Can't write to $difffile ($!)");
1783 =head2 deployment_statements
1787 =item Arguments: $schema, $type, $version, $directory, $sqlt_args
1791 Returns the statements used by L</deploy> and L<DBIx::Class::Schema/deploy>.
1792 The database driver name is given by C<$type>, though the value from
1793 L</sqlt_type> is used if it is not specified.
1795 C<$directory> is used to return statements from files in a previously created
1796 L</create_ddl_dir> directory and is optional. The filenames are constructed
1797 from L<DBIx::Class::Schema/ddl_filename>, the schema name and the C<$version>.
1799 If no C<$directory> is specified then the statements are constructed on the
1800 fly using L<SQL::Translator> and C<$version> is ignored.
1802 See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>.
1806 sub deployment_statements {
1807 my ($self, $schema, $type, $version, $dir, $sqltargs) = @_;
1808 # Need to be connected to get the correct sqlt_type
1809 $self->ensure_connected() unless $type;
1810 $type ||= $self->sqlt_type;
1811 $version ||= $schema->schema_version || '1.x';
1813 my $filename = $schema->ddl_filename($type, $version, $dir);
1817 open($file, "<$filename")
1818 or $self->throw_exception("Can't open $filename ($!)");
1821 return join('', @rows);
1824 $self->throw_exception(q{Can't deploy without SQL::Translator 0.09003: '}
1825 . $self->_check_sqlt_message . q{'})
1826 if !$self->_check_sqlt_version;
1828 require SQL::Translator::Parser::DBIx::Class;
1829 eval qq{use SQL::Translator::Producer::${type}};
1830 $self->throw_exception($@) if $@;
1832 # sources needs to be a parser arg, but for simplicty allow at top level
1834 $sqltargs->{parser_args}{sources} = delete $sqltargs->{sources}
1835 if exists $sqltargs->{sources};
1837 my $tr = SQL::Translator->new(%$sqltargs);
1838 SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema );
1839 return "SQL::Translator::Producer::${type}"->can('produce')->($tr);
1843 my ($self, $schema, $type, $sqltargs, $dir) = @_;
1846 return if($line =~ /^--/);
1848 # next if($line =~ /^DROP/m);
1849 return if($line =~ /^BEGIN TRANSACTION/m);
1850 return if($line =~ /^COMMIT/m);
1851 return if $line =~ /^\s+$/; # skip whitespace only
1852 $self->_query_start($line);
1854 $self->dbh->do($line); # shouldn't be using ->dbh ?
1857 warn qq{$@ (running "${line}")};
1859 $self->_query_end($line);
1861 my @statements = $self->deployment_statements($schema, $type, undef, $dir, { no_comments => 1, %{ $sqltargs || {} } } );
1862 if (@statements > 1) {
1863 foreach my $statement (@statements) {
1864 $deploy->( $statement );
1867 elsif (@statements == 1) {
1868 foreach my $line ( split(";\n", $statements[0])) {
1874 =head2 datetime_parser
1876 Returns the datetime parser class
1880 sub datetime_parser {
1882 return $self->{datetime_parser} ||= do {
1883 $self->ensure_connected;
1884 $self->build_datetime_parser(@_);
1888 =head2 datetime_parser_type
1890 Defines (returns) the datetime parser class - currently hardwired to
1891 L<DateTime::Format::MySQL>
1895 sub datetime_parser_type { "DateTime::Format::MySQL"; }
1897 =head2 build_datetime_parser
1899 See L</datetime_parser>
1903 sub build_datetime_parser {
1905 my $type = $self->datetime_parser_type(@_);
1907 $self->throw_exception("Couldn't load ${type}: $@") if $@;
1912 my $_check_sqlt_version; # private
1913 my $_check_sqlt_message; # private
1914 sub _check_sqlt_version {
1915 return $_check_sqlt_version if defined $_check_sqlt_version;
1916 eval 'use SQL::Translator "0.09003"';
1917 $_check_sqlt_message = $@ || '';
1918 $_check_sqlt_version = !$@;
1921 sub _check_sqlt_message {
1922 _check_sqlt_version if !defined $_check_sqlt_message;
1923 $_check_sqlt_message;
1927 =head2 is_replicating
1929 A boolean that reports if a particular L<DBIx::Class::Storage::DBI> is set to
1930 replicate from a master database. Default is undef, which is the result
1931 returned by databases that don't support replication.
1935 sub is_replicating {
1940 =head2 lag_behind_master
1942 Returns a number that represents a certain amount of lag behind a master db
1943 when a given storage is replicating. The number is database dependent, but
1944 starts at zero and increases with the amount of lag. Default in undef
1948 sub lag_behind_master {
1954 return if !$self->_dbh;
1963 =head2 DBIx::Class and AutoCommit
1965 DBIx::Class can do some wonderful magic with handling exceptions,
1966 disconnections, and transactions when you use C<< AutoCommit => 1 >>
1967 combined with C<txn_do> for transaction support.
1969 If you set C<< AutoCommit => 0 >> in your connect info, then you are always
1970 in an assumed transaction between commits, and you're telling us you'd
1971 like to manage that manually. A lot of the magic protections offered by
1972 this module will go away. We can't protect you from exceptions due to database
1973 disconnects because we don't know anything about how to restart your
1974 transactions. You're on your own for handling all sorts of exceptional
1975 cases if you choose the C<< AutoCommit => 0 >> path, just as you would
1981 The module defines a set of methods within the DBIC::SQL::Abstract
1982 namespace. These build on L<SQL::Abstract::Limit> to provide the
1983 SQL query functions.
1985 The following methods are extended:-
1999 See L</connect_info> for details.
2003 See L</connect_info> for details.
2007 See L</connect_info> for details.
2013 Matt S. Trout <mst@shadowcatsystems.co.uk>
2015 Andy Grundman <andy@hybridized.org>
2019 You may distribute this code under the same terms as Perl itself.