X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=e07181029523848a00cef7a0259590e9b7c0631b;hb=5ef3e508fa20d477b62406146cdca0ae658c10dd;hp=cb1dbd70050d760a7631fb6bc1f6c569b8f85cdf;hpb=486ad69b83e990c883ce142c0a5b6c4f181f5584;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index cb1dbd7..e071810 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -130,9 +130,18 @@ sub _join_condition { sub _quote { my ($self, $label) = @_; return '' unless defined $label; + return $label unless $self->{quote_char}; return $self->SUPER::_quote($label); } +sub _RowNum { + my $self = shift; + my $c; + $_[0] =~ s/SELECT (.*?) FROM/ + 'SELECT '.join(', ', map { $_.' AS col'.++$c } split(', ', $1)).' FROM'/e; + $self->SUPER::_RowNum(@_); +} + # Accessor for setting limit dialect. This is useful # for JDBC-bridge among others where the remote SQL-dialect cannot # be determined by the name of the driver alone. @@ -158,7 +167,8 @@ use base qw/DBIx::Class/; __PACKAGE__->load_components(qw/AccessorGroup/); __PACKAGE__->mk_group_accessors('simple' => - qw/connect_info _dbh _sql_maker debug debugfh cursor on_connect_do transaction_depth/); + qw/connect_info _dbh _sql_maker _connection_pid debug debugfh cursor + on_connect_do transaction_depth/); sub new { my $new = bless({}, ref $_[0] || $_[0]); @@ -222,7 +232,11 @@ sub debugcb { sub disconnect { my ($self) = @_; - $self->_dbh->disconnect if $self->_dbh; + if( $self->connected ) { + $self->_dbh->rollback unless $self->_dbh->{AutoCommit}; + $self->_dbh->disconnect; + $self->_dbh(undef); + } } sub connected { @@ -243,6 +257,8 @@ sub ensure_connected { sub dbh { my ($self) = @_; + $self->_dbh(undef) + if $self->_connection_pid && $self->_connection_pid != $$; $self->ensure_connected; return $self->_dbh; } @@ -264,11 +280,22 @@ sub _populate_dbh { foreach my $sql_statement (@{$self->on_connect_do || []}) { $self->_dbh->do($sql_statement); } + + $self->_connection_pid($$); } sub _connect { my ($self, @info) = @_; - return DBI->connect(@info); + + if ($INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}) { + my $old_connect_via = $DBI::connect_via; + $DBI::connect_via = 'connect'; + my $dbh = DBI->connect(@info); + $DBI::connect_via = $old_connect_via; + return $dbh; + } + + DBI->connect(@info); } =head2 txn_begin @@ -318,8 +345,12 @@ sub _execute { my ($self, $op, $extra_bind, $ident, @args) = @_; my ($sql, @bind) = $self->sql_maker->$op($ident, @args); unshift(@bind, @$extra_bind) if $extra_bind; - $self->debugfh->print("$sql: @bind\n") if $self->debug; + if ($self->debug) { + my @debug_bind = map { defined $_ ? $_ : 'NULL' } @bind; + $self->debugfh->print("$sql: @debug_bind\n"); + } my $sth = $self->sth($sql,$op); + croak "no sth generated via sql: $sql" unless $sth; @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args my $rv; if ($sth) { @@ -417,6 +448,8 @@ sub columns_info_for { return \%result; } +sub DESTROY { shift->disconnect } + 1; =head1 ENVIRONMENT VARIABLES