[Bast-commits] r9104 - in DBIx-Class/0.08/trunk: lib/DBIx/Class/Storage lib/DBIx/Class/Storage/DBI lib/DBIx/Class/Storage/DBI/Sybase t

ribasushi at dev.catalyst.perl.org ribasushi at dev.catalyst.perl.org
Thu Apr 8 10:36:05 GMT 2010


Author: ribasushi
Date: 2010-04-08 11:36:05 +0100 (Thu, 08 Apr 2010)
New Revision: 9104

Modified:
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/InterBase.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MSSQL.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Pg.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/SQLite.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
   DBIx-Class/0.08/trunk/t/72pg.t
Log:
Refactor the version handling
Clean up normalization wrt non-numeric version parts (i.e. mysql)

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/InterBase.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/InterBase.pm	2010-04-08 10:10:12 UTC (rev 9103)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/InterBase.pm	2010-04-08 10:36:05 UTC (rev 9104)
@@ -155,7 +155,7 @@
   }
 }
 
-sub _populate_server_info {
+sub _get_server_version {
   my $self = shift;
 
   return $self->next::method(@_) if ref $self ne __PACKAGE__;

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	2010-04-08 10:10:12 UTC (rev 9103)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MSSQL.pm	2010-04-08 10:36:05 UTC (rev 9104)
@@ -206,8 +206,7 @@
   unless ($self->_sql_maker) {
     unless ($self->{_sql_maker_opts}{limit_dialect}) {
 
-      my ($version) = $self->_server_info->{dbms_ver} =~ /^(\d+)/;
-      $version ||= 0;
+      my $version = $self->_server_info->{normalized_dbms_version} || 0;
 
       $self->{_sql_maker_opts} = {
         limit_dialect => ($version >= 9 ? 'RowNumberOver' : 'Top'),

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	2010-04-08 10:10:12 UTC (rev 9103)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Pg.pm	2010-04-08 10:36:05 UTC (rev 9104)
@@ -20,7 +20,7 @@
   my $self = shift;
 
   return 1
-    if $self->_server_info->{dbms_ver_normalized} >= 8.002;
+    if $self->_server_info->{normalized_dbms_version} >= 8.002;
 
   return 0;
 }

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated.pm	2010-04-08 10:10:12 UTC (rev 9103)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated.pm	2010-04-08 10:36:05 UTC (rev 9104)
@@ -367,9 +367,17 @@
     _dbh_sth
     _dbh_execute
     _prefetch_insert_auto_nextvals
+  /,
+
+  # TODO these need to be spread out to ALL servers not just the master
+  qw/
+    _get_server_version
+    _server_info
+    _server_info_hash
   /],
 );
 
+
 has _master_connect_info_opts =>
   (is => 'rw', isa => HashRef, default => sub { {} });
 

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/SQLite.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/SQLite.pm	2010-04-08 10:10:12 UTC (rev 9103)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/SQLite.pm	2010-04-08 10:36:05 UTC (rev 9104)
@@ -50,14 +50,14 @@
 
   $sqltargs ||= {};
 
-  my $sqlite_version = eval { $self->_server_info->{dbms_ver} };
-  $sqlite_version ||= '';
+  # it'd be cool to use the normalized perl-style version but this needs sqlt hacking as well
+  if (my $sqlite_version = $self->_server_info->{dbms_version}) {
+    # numify, SQLT does a numeric comparison
+    $sqlite_version =~ s/^(\d+) \. (\d+) (?: \. (\d+))? .*/${1}.${2}/x;
 
-  # numify, SQLT does a numeric comparison
-  $sqlite_version =~ s/^(\d+) \. (\d+) (?: \. (\d+))? .*/${1}.${2}/x;
+    $sqltargs->{producer_args}{sqlite_version} = $sqlite_version if $sqlite_version;
+  }
 
-  $sqltargs->{producer_args}{sqlite_version} = $sqlite_version if $sqlite_version;
-
   $self->next::method($schema, $type, $version, $dir, $sqltargs, @rest);
 }
 

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	2010-04-08 10:10:12 UTC (rev 9103)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm	2010-04-08 10:36:05 UTC (rev 9104)
@@ -55,23 +55,19 @@
   $dbh->do('ROLLBACK');
 }
 
-sub _populate_server_info {
+sub _get_server_version {
   my $self = shift;
 
-  my $info = $self->next::method(@_);
-
   my $product_version = $self->_get_dbh->selectrow_hashref('xp_msver ProductVersion');
 
   if ((my $version = $data->{Character_Value}) =~ /^(\d+)\./) {
-    $info->{dbms_ver} = $version;
-  } else {
-    $self->throw_exception(q{
-MSSQL Version Retrieval Failed, Your ProductVersion's Character_Value is missing
-or malformed!
+    return $version;
+  }
+  else {
+    $self->throw_exception(
+      "MSSQL Version Retrieval Failed, Your ProductVersion's Character_Value is missing or malformed!"
     });
   }
-
-  return $info;
 }
 
 1;

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm	2010-04-08 10:10:12 UTC (rev 9103)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm	2010-04-08 10:36:05 UTC (rev 9104)
@@ -19,7 +19,7 @@
 __PACKAGE__->mk_group_accessors('simple' =>
   qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts _conn_pid
      _conn_tid transaction_depth _dbh_autocommit _driver_determined savepoints
-     __server_info/
+     _server_info_hash/
 );
 
 # the values for these accessors are picked out (and deleted) from
@@ -908,6 +908,7 @@
 
   my @info = @{$self->_dbi_connect_info || []};
   $self->_dbh(undef); # in case ->connected failed we might get sent here
+  $self->_server_info_hash (undef);
   $self->_dbh($self->_connect(@info));
 
   $self->_conn_pid($$);
@@ -920,8 +921,6 @@
   $self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
 
   $self->_run_connection_actions unless $self->{_in_determine_driver};
-
-  $self->_populate_server_info;
 }
 
 sub _run_connection_actions {
@@ -934,35 +933,39 @@
   $self->_do_connection_actions(connect_call_ => $_) for @actions;
 }
 
-sub _populate_server_info {
+sub _server_info {
   my $self = shift;
-  my %info;
 
-  my $dbms_ver = eval {
-      local $@;
-      $self->_get_dbh->get_info(18)
-  };
+  unless ($self->_server_info_hash) {
 
-  if (defined $dbms_ver) {
-    $info{dbms_ver} = $dbms_ver;
+    my %info;
 
-    ($dbms_ver) = $dbms_ver =~ /^(\S+)/;
+    my $server_version = $self->_get_server_version;
 
-    my @verparts = split /\./, $dbms_ver;
-    $info{dbms_ver_normalized} = sprintf "%d.%03d%03d", @verparts;
+    if (defined $server_version) {
+      $info{dbms_version} = $server_version;
+
+      my ($numeric_version) = $server_version =~ /^([\d\.]+)/;
+      my @verparts = split (/\./, $numeric_version);
+      if (
+        @verparts
+          &&
+        @verparts <= 3
+          &&
+        ! grep { $_ > 999 } (@verparts)
+      ) {
+        $info{normalized_dbms_version} = sprintf "%d.%03d%03d", @verparts;
+      }
+    }
+
+    $self->_server_info_hash(\%info);
   }
 
-  $self->__server_info(\%info);
-
-  return \%info;
+  return $self->_server_info_hash
 }
 
-sub _server_info {
-  my $self = shift;
-
-  $self->_get_dbh;
-
-  return $self->__server_info(@_);
+sub _get_server_version {
+  eval { shift->_get_dbh->get_info(18) };
 }
 
 sub _determine_driver {

Modified: DBIx-Class/0.08/trunk/t/72pg.t
===================================================================
--- DBIx-Class/0.08/trunk/t/72pg.t	2010-04-08 10:10:12 UTC (rev 9103)
+++ DBIx-Class/0.08/trunk/t/72pg.t	2010-04-08 10:36:05 UTC (rev 9104)
@@ -23,16 +23,20 @@
 our @test_classes; #< array that will be pushed into by test classes defined in this file
 DBICTest::Schema->load_classes( map {s/.+:://;$_} @test_classes ) if @test_classes;
 
+my $test_server_supports_insert_returning = do {
+  my $s = DBICTest::Schema->connect($dsn, $user, $pass);
+  $s->storage->_determine_driver;
+  $s->storage->_supports_insert_returning;
+};
+
 my $schema;
 
-require DBIx::Class::Storage::DBI::Pg;
-
-my $can_insert_returning =
-  DBIx::Class::Storage::DBI::Pg->can('can_insert_returning');
-
-for my $use_insert_returning (0..1) {
+for my $use_insert_returning ($test_server_supports_insert_returning
+  ? (0,1)
+  : (0)
+) {
   no warnings qw/redefine once/;
-  local *DBIx::Class::Storage::DBI::Pg::can_insert_returning = sub {
+  local *DBIx::Class::Storage::DBI::Pg::_supports_insert_returning = sub {
     $use_insert_returning
   };
 
@@ -69,13 +73,6 @@
   $schema = DBICTest::Schema->connect($dsn, $user, $pass);
   $schema->storage->ensure_connected;
 
-  if ($use_insert_returning && (not $can_insert_returning->($schema->storage)))
-  {
-    diag "Your version of PostgreSQL does not support INSERT ... RETURNING.";
-    diag "*** SKIPPING FURTHER TESTS";
-    last;
-  }
-
   drop_test_schema($schema);
   create_test_schema($schema);
 
@@ -281,7 +278,7 @@
 
 ######## test non-serial auto-pk
 
-  if ($schema->storage->can_insert_returning) {
+  if ($schema->storage->_supports_insert_returning) {
     $schema->source('TimestampPrimaryKey')->name('dbic_t_schema.timestamp_primary_key_test');
     my $row = $schema->resultset('TimestampPrimaryKey')->create({});
     ok $row->id;




More information about the Bast-commits mailing list