[Bast-commits] r7314 - in DBIx-Class/0.08/trunk: .
lib/DBIx/Class/Storage lib/DBIx/Class/Storage/DBI
lib/DBIx/Class/Storage/DBI/ODBC lib/DBIx/Class/Storage/DBI/Oracle
lib/DBIx/Class/Storage/DBI/Sybase t
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Thu Aug 13 05:40:45 GMT 2009
Author: ribasushi
Date: 2009-08-13 05:40:44 +0000 (Thu, 13 Aug 2009)
New Revision: 7314
Modified:
DBIx-Class/0.08/trunk/Changes
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MSSQL.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ODBC.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Pg.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/mysql.pm
DBIx-Class/0.08/trunk/t/92storage_ping_count.t
Log:
Caelum was right to make _get_dbh private - reverting (and some code refactoring)
Modified: DBIx-Class/0.08/trunk/Changes
===================================================================
--- DBIx-Class/0.08/trunk/Changes 2009-08-12 14:16:08 UTC (rev 7313)
+++ DBIx-Class/0.08/trunk/Changes 2009-08-13 05:40:44 UTC (rev 7314)
@@ -33,9 +33,6 @@
prefetch
- Massive optimization of the DBI storage layer - reduce the
amount of connected() calls
- - New ::Storage::DBI method last_dbh() - it will still return a
- newly connected $dbh if we start unconnected, but will not ping
- the server on every invocation unlike dbh()
- Some fixes of multi-create corner cases
- Multiple POD improvements
- Added exception when resultset is called without an argument
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MSSQL.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MSSQL.pm 2009-08-12 14:16:08 UTC (rev 7313)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MSSQL.pm 2009-08-13 05:40:44 UTC (rev 7314)
@@ -30,14 +30,14 @@
if ($identity_insert) {
my $table = $source->from;
- $self->last_dbh->do("SET IDENTITY_INSERT $table ON");
+ $self->_get_dbh->do("SET IDENTITY_INSERT $table ON");
}
$self->next::method(@_);
if ($identity_insert) {
my $table = $source->from;
- $self->last_dbh->do("SET IDENTITY_INSERT $table OFF");
+ $self->_get_dbh->do("SET IDENTITY_INSERT $table OFF");
}
}
@@ -68,7 +68,7 @@
grep { not exists $to_insert->{$_} } (@pk_guids, @auto_guids);
for my $guid_col (@get_guids_for) {
- my ($new_guid) = $self->last_dbh->selectrow_array('SELECT NEWID()');
+ my ($new_guid) = $self->_get_dbh->selectrow_array('SELECT NEWID()');
$updated_cols->{$guid_col} = $to_insert->{$guid_col} = $new_guid;
}
@@ -145,7 +145,7 @@
sub _svp_begin {
my ($self, $name) = @_;
- $self->last_dbh->do("SAVE TRANSACTION $name");
+ $self->_get_dbh->do("SAVE TRANSACTION $name");
}
# A new SAVE TRANSACTION with the same name releases the previous one.
@@ -154,7 +154,7 @@
sub _svp_rollback {
my ($self, $name) = @_;
- $self->last_dbh->do("ROLLBACK TRANSACTION $name");
+ $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
}
sub build_datetime_parser {
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm 2009-08-12 14:16:08 UTC (rev 7313)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm 2009-08-13 05:40:44 UTC (rev 7314)
@@ -137,7 +137,7 @@
my $self = shift;
my $sql_rowset_size = shift || 2;
- $self->_dbh->{odbc_SQL_ROWSET_SIZE} = $sql_rowset_size;
+ $self->_get_dbh->{odbc_SQL_ROWSET_SIZE} = $sql_rowset_size;
}
=head2 connect_call_use_MARS
@@ -165,9 +165,9 @@
if ($dsn !~ /MARS_Connection=/) {
$self->_dbi_connect_info->[0] = "$dsn;MARS_Connection=Yes";
- my $connected = defined $self->_dbh;
+ my $was_connected = defined $self->_dbh;
$self->disconnect;
- $self->ensure_connected if $connected;
+ $self->ensure_connected if $was_connected;
}
}
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ODBC.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ODBC.pm 2009-08-12 14:16:08 UTC (rev 7313)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ODBC.pm 2009-08-13 05:40:44 UTC (rev 7314)
@@ -8,7 +8,7 @@
sub _rebless {
my ($self) = @_;
- my $dbtype = eval { $self->last_dbh->get_info(17) };
+ my $dbtype = eval { $self->_get_dbh->get_info(17) };
unless ( $@ ) {
# Translate the backend name into a perl identifier
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2009-08-12 14:16:08 UTC (rev 7313)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2009-08-13 05:40:44 UTC (rev 7314)
@@ -76,7 +76,7 @@
sub _sequence_fetch {
my ( $self, $type, $seq ) = @_;
- my ($id) = $self->last_dbh->selectrow_array("SELECT ${seq}.${type} FROM DUAL");
+ my ($id) = $self->_get_dbh->selectrow_array("SELECT ${seq}.${type} FROM DUAL");
return $id;
}
@@ -209,7 +209,7 @@
sub _svp_begin {
my ($self, $name) = @_;
- $self->last_dbh->do("SAVEPOINT $name");
+ $self->_get_dbh->do("SAVEPOINT $name");
}
=head2 source_bind_attributes
@@ -263,7 +263,7 @@
sub _svp_rollback {
my ($self, $name) = @_;
- $self->last_dbh->do("ROLLBACK TO SAVEPOINT $name")
+ $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
}
=head1 AUTHOR
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle.pm 2009-08-12 14:16:08 UTC (rev 7313)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle.pm 2009-08-13 05:40:44 UTC (rev 7314)
@@ -9,7 +9,7 @@
sub _rebless {
my ($self) = @_;
- my $version = eval { $self->last_dbh->get_info(18); };
+ my $version = eval { $self->_get_dbh->get_info(18); };
if ( !$@ ) {
my ($major, $minor, $patchlevel) = split(/\./, $version);
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Pg.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Pg.pm 2009-08-12 14:16:08 UTC (rev 7313)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Pg.pm 2009-08-13 05:40:44 UTC (rev 7314)
@@ -15,7 +15,7 @@
sub with_deferred_fk_checks {
my ($self, $sub) = @_;
- $self->last_dbh->do('SET CONSTRAINTS ALL DEFERRED');
+ $self->_get_dbh->do('SET CONSTRAINTS ALL DEFERRED');
$sub->();
}
@@ -90,26 +90,26 @@
sub _sequence_fetch {
my ( $self, $type, $seq ) = @_;
- my ($id) = $self->last_dbh->selectrow_array("SELECT nextval('${seq}')");
+ my ($id) = $self->_get_dbh->selectrow_array("SELECT nextval('${seq}')");
return $id;
}
sub _svp_begin {
my ($self, $name) = @_;
- $self->last_dbh->pg_savepoint($name);
+ $self->_get_dbh->pg_savepoint($name);
}
sub _svp_release {
my ($self, $name) = @_;
- $self->last_dbh->pg_release($name);
+ $self->_get_dbh->pg_release($name);
}
sub _svp_rollback {
my ($self, $name) = @_;
- $self->last_dbh->pg_rollback_to($name);
+ $self->_get_dbh->pg_rollback_to($name);
}
1;
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm 2009-08-12 14:16:08 UTC (rev 7313)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm 2009-08-13 05:40:44 UTC (rev 7314)
@@ -29,7 +29,7 @@
sub _placeholders_supported {
my $self = shift;
- my $dbh = $self->last_dbh;
+ my $dbh = $self->_get_dbh;
return eval {
# There's also $dbh->{syb_dynamic_supported} but it can be inaccurate for this
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm 2009-08-12 14:16:08 UTC (rev 7313)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm 2009-08-13 05:40:44 UTC (rev 7314)
@@ -11,7 +11,7 @@
sub _rebless {
my $self = shift;
- my $dbh = $self->last_dbh;
+ my $dbh = $self->_get_dbh;
if (not $self->_placeholders_supported) {
bless $self,
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-08-12 14:16:08 UTC (rev 7313)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-08-13 05:40:44 UTC (rev 7314)
@@ -13,7 +13,7 @@
my $self = shift;
my $dbtype = eval {
- @{$self->last_dbh
+ @{$self->_get_dbh
->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})
}[2]
};
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/mysql.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/mysql.pm 2009-08-12 14:16:08 UTC (rev 7313)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/mysql.pm 2009-08-13 05:40:44 UTC (rev 7314)
@@ -40,28 +40,28 @@
sub _svp_begin {
my ($self, $name) = @_;
- $self->last_dbh->do("SAVEPOINT $name");
+ $self->_get_dbh->do("SAVEPOINT $name");
}
sub _svp_release {
my ($self, $name) = @_;
- $self->last_dbh->do("RELEASE SAVEPOINT $name");
+ $self->_get_dbh->do("RELEASE SAVEPOINT $name");
}
sub _svp_rollback {
my ($self, $name) = @_;
- $self->last_dbh->do("ROLLBACK TO SAVEPOINT $name")
+ $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
}
sub is_replicating {
- my $status = shift->last_dbh->selectrow_hashref('show slave status');
+ my $status = shift->_get_dbh->selectrow_hashref('show slave status');
return ($status->{Slave_IO_Running} eq 'Yes') && ($status->{Slave_SQL_Running} eq 'Yes');
}
sub lag_behind_master {
- return shift->last_dbh->selectrow_hashref('show slave status')->{Seconds_Behind_Master};
+ return shift->_get_dbh->selectrow_hashref('show slave status')->{Seconds_Behind_Master};
}
# MySql can not do subquery update/deletes, only way is slow per-row operations.
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm 2009-08-12 14:16:08 UTC (rev 7313)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm 2009-08-13 05:40:44 UTC (rev 7314)
@@ -452,7 +452,11 @@
}
sub _default_dbi_connect_attributes {
- return { AutoCommit => 1 };
+ return {
+ AutoCommit => 1,
+ RaiseError => 1,
+ PrintError => 0,
+ };
}
=head2 on_connect_do
@@ -551,6 +555,7 @@
}
};
+ # ->connected might unset $@ - copy
my $exception = $@;
if(!$exception) { return $want_array ? @result : $result[0] }
@@ -598,6 +603,7 @@
$self->txn_commit;
};
+ # ->connected might unset $@ - copy
my $exception = $@;
if(!$exception) { return $want_array ? @result : $result[0] }
@@ -687,22 +693,32 @@
=cut
sub connected {
- my ($self) = @_;
+ my $self = shift;
+ return 0 unless $self->_seems_connected;
- if(my $dbh = $self->_dbh) {
- if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
- $self->_dbh(undef);
- $self->{_dbh_gen}++;
- return;
- }
- else {
- $self->_verify_pid;
- return 0 if !$self->_dbh;
- }
- return ($dbh->FETCH('Active') && $self->_ping);
+ #be on the safe side
+ local $self->_dbh->{RaiseError} = 1;
+
+ return $self->_ping;
+}
+
+sub _seems_connected {
+ my $self = shift;
+
+ my $dbh = $self->_dbh
+ or return 0;
+
+ if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
+ $self->_dbh(undef);
+ $self->{_dbh_gen}++;
+ return 0;
}
+ else {
+ $self->_verify_pid;
+ return 0 if !$self->_dbh;
+ }
- return 0;
+ return $dbh->FETCH('Active');
}
sub _ping {
@@ -739,7 +755,9 @@
Returns a C<$dbh> - a data base handle of class L<DBI>. The returned handle
is guaranteed to be healthy by implicitly calling L</connected>, and if
-necessary performing a reconnection before returning.
+necessary performing a reconnection before returning. Keep in mind that this
+is very B<expensive> on some database engines. Consider using L<dbh_do>
+instead.
=cut
@@ -754,17 +772,8 @@
return $self->_dbh;
}
-=head2 last_dbh
-
-This returns the B<last> available C<$dbh> if any, or attempts to
-connect and returns the resulting handle. This method differs from
-L</dbh> by not validating if a preexisting handle is still healthy
-via L</connected>. Make sure you take appropriate precautions
-when using this method, as the C<$dbh> may be useless at this point.
-
-=cut
-
-sub last_dbh {
+# this is the internal "get dbh or connect (don't check)" method
+sub _get_dbh {
my $self = shift;
$self->_populate_dbh unless $self->_dbh;
return $self->_dbh;
@@ -776,7 +785,7 @@
return (
bindtype=>'columns',
array_datatypes => 1,
- limit_dialect => $self->last_dbh,
+ limit_dialect => $self->_get_dbh,
%{$self->_sql_maker_opts}
);
}
@@ -797,6 +806,7 @@
my ($self) = @_;
my @info = @{$self->_dbi_connect_info || []};
+ $self->_dbh(undef); # in case ->connected failed we might get sent here
$self->_dbh($self->_connect(@info));
$self->_conn_pid($$);
@@ -1235,7 +1245,7 @@
$updated_cols->{$col} = $to_insert->{$col} = $self->_sequence_fetch(
'nextval',
$col_info->{sequence} ||
- $self->_dbh_get_autoinc_seq($self->last_dbh, $source)
+ $self->_dbh_get_autoinc_seq($self->_get_dbh, $source)
);
}
}
@@ -2025,7 +2035,7 @@
=cut
-sub sqlt_type { shift->last_dbh->{Driver}->{Name} }
+sub sqlt_type { shift->_get_dbh->{Driver}->{Name} }
=head2 bind_attribute_by_data_type
@@ -2271,8 +2281,6 @@
sub deployment_statements {
my ($self, $schema, $type, $version, $dir, $sqltargs) = @_;
- # Need to be connected to get the correct sqlt_type
- $self->last_dbh() unless $type;
$type ||= $self->sqlt_type;
$version ||= $schema->schema_version || '1.x';
$dir ||= './';
@@ -2317,10 +2325,9 @@
return if $line =~ /^\s+$/; # skip whitespace only
$self->_query_start($line);
eval {
- # a previous error may invalidate $dbh - thus we need to use dbh()
- # to guarantee a healthy $dbh (this is temporary until we get
- # proper error handling on deploy() )
- $self->dbh->do($line);
+ # do a dbh_do cycle here, as we need some error checking in
+ # place (even though we will ignore errors)
+ $self->dbh_do (sub { $_[1]->do($line) });
};
if ($@) {
carp qq{$@ (running "${line}")};
@@ -2349,7 +2356,7 @@
sub datetime_parser {
my $self = shift;
return $self->{datetime_parser} ||= do {
- $self->last_dbh;
+ $self->_populate_dbh unless $self->_dbh;
$self->build_datetime_parser(@_);
};
}
Modified: DBIx-Class/0.08/trunk/t/92storage_ping_count.t
===================================================================
--- DBIx-Class/0.08/trunk/t/92storage_ping_count.t 2009-08-12 14:16:08 UTC (rev 7313)
+++ DBIx-Class/0.08/trunk/t/92storage_ping_count.t 2009-08-13 05:40:44 UTC (rev 7314)
@@ -22,16 +22,14 @@
}
-# We do not count pings during deploy() because of the flux
-# around sqlt. Eventually there should be no pings at all
+# measure pings around deploy() separately
my $schema = DBICTest->init_schema( sqlite_use_file => 1, no_populate => 1 );
-TODO: {
- local $TODO = 'Unable to fix before proper deploy() error handling';
- is ($ping_count, 0, 'no _ping() calls during deploy');
- $ping_count = 0;
-}
+is ($ping_count, 0, 'no _ping() calls during deploy');
+$ping_count = 0;
+
+
DBICTest->populate_schema ($schema);
# perform some operations and make sure they don't ping
More information about the Bast-commits
mailing list