X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=e1d50efce1332bc461370323b876c021aab0a96f;hb=2c2a01a5bf8e194d30b3d9af3b09de21c7dca030;hp=941b6a4ca4d5968a84cf0d589a81e4716ef564ef;hpb=0b5dee17b40cc4029549209a6c84b14c3647a361;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 941b6a4..e1d50ef 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -12,10 +12,10 @@ use DBIx::Class::Storage::Statistics; use IO::File; use Scalar::Util 'blessed'; -__PACKAGE__->mk_group_accessors( - 'simple' => - qw/_connect_info _dbh _sql_maker _sql_maker_opts _conn_pid _conn_tid - disable_sth_caching cursor on_connect_do transaction_depth/ +__PACKAGE__->mk_group_accessors('simple' => + qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts + _conn_pid _conn_tid disable_sth_caching cursor on_connect_do + transaction_depth/ ); BEGIN { @@ -331,7 +331,13 @@ C here. The arrayref can either contain the same set of arguments one would normally pass to L, or a lone code reference which returns -a connected database handle. +a connected database handle. Please note that the L docs +recommend that you always explicitly set C to either +C<0> or C<1>. L further recommends that it be set +to C<1>, and that you perform transactions via our L +method. L will set it to C<1> if you do not do explicitly +set it to zero. This is the default for most DBDs. See below for more +details. In either case, if the final argument in your connect_info happens to be a hashref, C will look there for several @@ -390,6 +396,21 @@ might not work very well, YMMV. If you don't use a subref, DBIC will force this setting for you anyways. Setting HandleError to anything other than simple exception object wrapper might cause problems too. +Another Important Note: + +DBIC can do some wonderful magic with handling exceptions, +disconnections, and transactions when you use C +combined with C for transaction support. + +If you set C in your connect info, then you are always +in an assumed transaction between commits, and you're telling us you'd +like to manage that manually. A lot of DBIC's magic protections +go away. We can't protect you from exceptions due to database +disconnects because we don't know anything about how to restart your +transactions. You're on your own for handling all sorts of exceptional +cases if you choose the C path, just as you would +be with raw DBI. + Examples: # Simple SQLite connection @@ -404,7 +425,7 @@ Examples: 'dbi:Pg:dbname=foo', 'postgres', 'my_pg_password', - { AutoCommit => 0 }, + { AutoCommit => 1 }, { quote_char => q{"}, name_sep => q{.} }, ] ); @@ -415,7 +436,7 @@ Examples: 'dbi:Pg:dbname=foo', 'postgres', 'my_pg_password', - { AutoCommit => 0, quote_char => q{"}, name_sep => q{.} }, + { AutoCommit => 1, quote_char => q{"}, name_sep => q{.} }, ] ); @@ -443,9 +464,11 @@ sub connect_info { # the new set of options $self->_sql_maker(undef); $self->_sql_maker_opts({}); + $self->_connect_info([@$info_arg]); # copy for _connect_info - my $info = [ @$info_arg ]; # copy because we can alter it - my $last_info = $info->[-1]; + my $dbi_info = [@$info_arg]; # copy for _dbi_connect_info + + my $last_info = $dbi_info->[-1]; if(ref $last_info eq 'HASH') { for my $storage_opt (qw/on_connect_do disable_sth_caching/) { if(my $value = delete $last_info->{$storage_opt}) { @@ -459,10 +482,11 @@ sub connect_info { } # Get rid of any trailing empty hashref - pop(@$info) if !keys %$last_info; + pop(@$dbi_info) if !keys %$last_info; } + $self->_dbi_connect_info($dbi_info); - $self->_connect_info($info); + $self->_connect_info; } =head2 on_connect_do @@ -506,7 +530,9 @@ sub dbh_do { ref $coderef eq 'CODE' or $self->throw_exception ('$coderef must be a CODE reference'); - return $coderef->($self, $self->_dbh, @_) if $self->{_in_dbh_do}; + return $coderef->($self, $self->_dbh, @_) if $self->{_in_dbh_do} + || $self->{transaction_depth}; + local $self->{_in_dbh_do} = 1; my @result; @@ -683,9 +709,13 @@ sub sql_maker { sub _populate_dbh { my ($self) = @_; - my @info = @{$self->_connect_info || []}; + my @info = @{$self->_dbi_connect_info || []}; $self->_dbh($self->_connect(@info)); + # Always set the transaction depth on connect, since + # there is no transaction in progress by definition + $self->{transaction_depth} = $self->_dbh->{AutoCommit} ? 0 : 1; + if(ref $self eq 'DBIx::Class::Storage::DBI') { my $driver = $self->_dbh->{Driver}->{Name}; if ($self->load_optional_class("DBIx::Class::Storage::DBI::${driver}")) { @@ -732,82 +762,67 @@ sub _connect { $DBI::connect_via = $old_connect_via if $old_connect_via; - if (!$dbh || $@) { - $self->throw_exception("DBI Connection failed: " . ($@ || $DBI::errstr)); - } + $self->throw_exception("DBI Connection failed: " . ($@||$DBI::errstr)) + if !$dbh || $@; $dbh; } -sub _dbh_txn_begin { - my ($self, $dbh) = @_; - if ($dbh->{AutoCommit}) { - $self->debugobj->txn_begin() - if ($self->debug); - $dbh->begin_work; - } -} sub txn_begin { my $self = shift; - $self->dbh_do($self->can('_dbh_txn_begin')) - if $self->{transaction_depth}++ == 0; -} - -sub _dbh_txn_commit { - my ($self, $dbh) = @_; - if ($self->{transaction_depth} == 0) { - unless ($dbh->{AutoCommit}) { - $self->debugobj->txn_commit() - if ($self->debug); - $dbh->commit; - } - } - else { - if (--$self->{transaction_depth} == 0) { - $self->debugobj->txn_commit() - if ($self->debug); - $dbh->commit; - } + if($self->{transaction_depth}++ == 0) { + $self->debugobj->txn_begin() + if $self->debug; + # this isn't ->_dbh-> because + # we should reconnect on begin_work + # for AutoCommit users + $self->dbh->begin_work; } } sub txn_commit { my $self = shift; - $self->dbh_do($self->can('_dbh_txn_commit')); + if ($self->{transaction_depth} == 1) { + my $dbh = $self->_dbh; + $self->debugobj->txn_commit() + if ($self->debug); + $dbh->commit; + $self->{transaction_depth} = 0 + if $dbh->{AutoCommit}; + } + elsif($self->{transaction_depth} > 1) { + $self->{transaction_depth}-- + } } -sub _dbh_txn_rollback { - my ($self, $dbh) = @_; - if ($self->{transaction_depth} == 0) { - unless ($dbh->{AutoCommit}) { +sub txn_rollback { + my $self = shift; + my $dbh = $self->_dbh; + my $autocommit; + eval { + $autocommit = $dbh->{AutoCommit}; + if ($self->{transaction_depth} == 1) { $self->debugobj->txn_rollback() if ($self->debug); $dbh->rollback; + $self->{transaction_depth} = 0 + if $autocommit; } - } - else { - if (--$self->{transaction_depth} == 0) { - $self->debugobj->txn_rollback() - if ($self->debug); - $dbh->rollback; + elsif($self->{transaction_depth} > 1) { + $self->{transaction_depth}--; } else { die DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->new; } - } -} - -sub txn_rollback { - my $self = shift; - - eval { $self->dbh_do($self->can('_dbh_txn_rollback')) }; + }; if ($@) { my $error = $@; my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION"; $error =~ /$exception_class/ and $self->throw_exception($error); - $self->{transaction_depth} = 0; # ensure that a failed rollback - $self->throw_exception($error); # resets the transaction depth + # ensure that a failed rollback resets the transaction depth + $self->{transaction_depth} = $autocommit ? 0 : 1; + $self->throw_exception($error); } } @@ -815,15 +830,14 @@ sub txn_rollback { # easier to override in NoBindVars without duping the rest. It takes up # all of _execute's args, and emits $sql, @bind. sub _prep_for_execute { - my ($self, $op, $extra_bind, $ident, @args) = @_; + my ($self, $op, $extra_bind, $ident, $args) = @_; - my ($sql, @bind) = $self->sql_maker->$op($ident, @args); + my ($sql, @bind) = $self->sql_maker->$op($ident, @$args); unshift(@bind, map { ref $_ eq 'ARRAY' ? $_ : [ '!!dummy', $_ ] } @$extra_bind) if $extra_bind; - @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args - return ($sql, @bind); + return ($sql, \@bind); } sub _execute { @@ -832,71 +846,49 @@ sub _execute { if( blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) { $ident = $ident->from(); } - - my ($sql, @bind) = $self->sql_maker->$op($ident, @args); - unshift(@bind, - map { ref $_ eq 'ARRAY' ? $_ : [ '!!dummy', $_ ] } @$extra_bind) - if $extra_bind; + + my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args); + if ($self->debug) { my @debug_bind = - map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @bind; + map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @$bind; $self->debugobj->query_start($sql, @debug_bind); } - my ($rv, $sth); - RETRY: while (1) { - $sth = eval { $self->sth($sql,$op) }; + my $sth = eval { $self->sth($sql,$op) }; + $self->throw_exception("no sth generated via sql ($@): $sql") if $@; - if (!$sth || $@) { - $self->throw_exception( - 'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql" - ); - } + my $rv = eval { + my $placeholder_index = 1; - if ($sth) { - my $time = time(); - $rv = eval { - my $placeholder_index = 1; + foreach my $bound (@$bind) { + my $attributes = {}; + my($column_name, @data) = @$bound; - foreach my $bound (@bind) { - - my $attributes = {}; - my($column_name, @data) = @$bound; - - if( $bind_attributes ) { - $attributes = $bind_attributes->{$column_name} - if defined $bind_attributes->{$column_name}; - } + if ($bind_attributes) { + $attributes = $bind_attributes->{$column_name} + if defined $bind_attributes->{$column_name}; + } - foreach my $data (@data) - { - $data = ref $data ? ''.$data : $data; # stringify args + foreach my $data (@data) { + $data = ref $data ? ''.$data : $data; # stringify args - $sth->bind_param($placeholder_index, $data, $attributes); - $placeholder_index++; - } - } - $sth->execute(); - }; - - if ($@ || !$rv) { - $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr)) - if $self->connected; - $self->_populate_dbh; - } else { - last RETRY; + $sth->bind_param($placeholder_index, $data, $attributes); + $placeholder_index++; } - } else { - $self->throw_exception("'$sql' did not generate a statement."); } - } # While(1) to retry if disconencted + $sth->execute(); + }; + + $self->throw_exception("Error executing '$sql': " . ($@ || $sth->errstr)) + if $@ || !$rv; if ($self->debug) { my @debug_bind = - map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @bind; + map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @$bind; $self->debugobj->query_end($sql, @debug_bind); } - return (wantarray ? ($rv, $sth, @bind) : $rv); + return (wantarray ? ($rv, $sth, @$bind) : $rv); } sub insert { @@ -905,11 +897,13 @@ sub insert { my $ident = $source->from; my $bind_attributes = $self->source_bind_attributes($source); + eval { $self->_execute('insert' => [], $source, $bind_attributes, $to_insert) }; $self->throw_exception( "Couldn't insert ".join(', ', map "$_ => $to_insert->{$_}", keys %$to_insert - )." into ${ident}" - ) unless ($self->_execute('insert' => [], $source, $bind_attributes, $to_insert)); + )." into ${ident}: $@" + ) if $@; + return $to_insert; } @@ -1094,9 +1088,9 @@ sub _dbh_sth { ? $dbh->prepare($sql) : $dbh->prepare_cached($sql, {}, 3); - $self->throw_exception( - 'no sth generated via sql (' . ($@ || $dbh->errstr) . "): $sql" - ) if !$sth; + # XXX You would think RaiseError would make this impossible, + # but apparently that's not true :( + die $dbh->errstr if !$sth; $sth; } @@ -1131,18 +1125,12 @@ sub _dbh_columns_info_for { } my %result; - my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0"); + my $sth = $dbh->prepare($self->sql_maker->select($table, undef, \'1 = 0')); $sth->execute; my @columns = @{$sth->{NAME_lc}}; for my $i ( 0 .. $#columns ){ my %column_info; - my $type_num = $sth->{TYPE}->[$i]; - my $type_name; - if(defined $type_num && $dbh->can('type_info')) { - my $type_info = $dbh->type_info($type_num); - $type_name = $type_info->{TYPE_NAME} if $type_info; - } - $column_info{data_type} = $type_name ? $type_name : $type_num; + $column_info{data_type} = $sth->{TYPE}->[$i]; $column_info{size} = $sth->{PRECISION}->[$i]; $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0; @@ -1153,6 +1141,18 @@ sub _dbh_columns_info_for { $result{$columns[$i]} = \%column_info; } + $sth->finish; + + foreach my $col (keys %result) { + my $colinfo = $result{$col}; + my $type_num = $colinfo->{data_type}; + my $type_name; + if(defined $type_num && $dbh->can('type_info')) { + my $type_info = $dbh->type_info($type_num); + $type_name = $type_info->{TYPE_NAME} if $type_info; + $colinfo->{data_type} = $type_name if $type_name; + } + } return \%result; } @@ -1231,8 +1231,9 @@ sub create_ddl_dir $version ||= $schema->VERSION || '1.x'; $sqltargs = { ( add_drop_table => 1 ), %{$sqltargs || {}} }; - eval "use SQL::Translator"; - $self->throw_exception("Can't create a ddl file without SQL::Translator: $@") if $@; + $self->throw_exception(q{Can't create a ddl file without SQL::Translator 0.08: '} + . $self->_check_sqlt_message . q{'}) + if !$self->_check_sqlt_version; my $sqlt = SQL::Translator->new({ # debug => 1, @@ -1271,12 +1272,7 @@ sub create_ddl_dir if($preversion) { - eval "use SQL::Translator::Diff"; - if($@) - { - warn("Can't diff versions without SQL::Translator::Diff: $@"); - next; - } + require SQL::Translator::Diff; my $prefilename = $schema->ddl_filename($db, $dir, $preversion); # print "Previous version $prefilename\n"; @@ -1385,25 +1381,23 @@ sub deployment_statements { return join('', @rows); } - eval "use SQL::Translator"; - if(!$@) - { - eval "use SQL::Translator::Parser::DBIx::Class;"; - $self->throw_exception($@) if $@; - eval "use SQL::Translator::Producer::${type};"; - $self->throw_exception($@) if $@; - - # sources needs to be a parser arg, but for simplicty allow at top level - # coming in - $sqltargs->{parser_args}{sources} = delete $sqltargs->{sources} - if exists $sqltargs->{sources}; - - my $tr = SQL::Translator->new(%$sqltargs); - SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema ); - return "SQL::Translator::Producer::${type}"->can('produce')->($tr); - } + $self->throw_exception(q{Can't deploy without SQL::Translator 0.08: '} + . $self->_check_sqlt_message . q{'}) + if !$self->_check_sqlt_version; + + require SQL::Translator::Parser::DBIx::Class; + eval qq{use SQL::Translator::Producer::${type}}; + $self->throw_exception($@) if $@; + + # sources needs to be a parser arg, but for simplicty allow at top level + # coming in + $sqltargs->{parser_args}{sources} = delete $sqltargs->{sources} + if exists $sqltargs->{sources}; + + my $tr = SQL::Translator->new(%$sqltargs); + SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema ); + return "SQL::Translator::Producer::${type}"->can('produce')->($tr); - $self->throw_exception("No SQL::Translator, and no Schema file found, aborting deploy"); return; } @@ -1419,7 +1413,7 @@ sub deploy { next if($_ =~ /^COMMIT/m); next if $_ =~ /^\s+$/; # skip whitespace only $self->debugobj->query_start($_) if $self->debug; - $self->dbh->do($_) or warn "SQL was:\n $_"; # XXX exceptions? + $self->dbh->do($_); # shouldn't be using ->dbh ? $self->debugobj->query_end($_) if $self->debug; } } @@ -1459,6 +1453,22 @@ sub build_datetime_parser { return $type; } +{ + my $_check_sqlt_version; # private + my $_check_sqlt_message; # private + sub _check_sqlt_version { + return $_check_sqlt_version if defined $_check_sqlt_version; + eval 'use SQL::Translator 0.08'; + $_check_sqlt_message = $@ ? $@ : ''; + $_check_sqlt_version = $@ ? 0 : 1; + } + + sub _check_sqlt_message { + _check_sqlt_version if !defined $_check_sqlt_message; + $_check_sqlt_message; + } +} + sub DESTROY { my $self = shift; return if !$self->_dbh;