use Try::Tiny;
use overload ();
use Data::Compare (); # no imports!!! guard against insane architecture
+use DBI::Const::GetInfoType (); # no import of retarded global hash
use namespace::clean;
# default cursor class, overridable in connect_info attributes
}
sub _get_server_version {
- shift->_dbh_get_info(18);
+ shift->_dbh_get_info('SQL_DBMS_VER');
}
sub _dbh_get_info {
my ($self, $info) = @_;
+ if ($info =~ /[^0-9]/) {
+ $info = $DBI::Const::GetInfoType::GetInfoType{$info};
+ $self->throw_exception("Info type '$_[1]' not provided by DBI::Const::GetInfoType")
+ unless defined $info;
+ }
+
return try { $self->_get_dbh->get_info($info) } || undef;
}
sub _rebless {
my $self = shift;
- my $dbtype = $self->_dbh_get_info(17);
+ my $dbtype = $self->_dbh_get_info('SQL_DBMS_NAME');
if (not $dbtype) {
warn "Unable to determine ADO driver, failling back to generic support.\n";
my $v = $self->next::method(@_);
if (! defined $v and ! @_) {
- $v = $self->next::method($self->_dbh_get_info(41) || '.');
+ $v = $self->next::method($self->_dbh_get_info('SQL_QUALIFIER_NAME_SEPARATOR') || '.');
}
return $v;
sub _rebless {
my ($self) = @_;
- if (my $dbtype = $self->_dbh_get_info(17)) {
+ if (my $dbtype = $self->_dbh_get_info('SQL_DBMS_NAME')) {
# Translate the backend name into a perl identifier
$dbtype =~ s/\W/_/gi;
my $subclass = "DBIx::Class::Storage::DBI::ODBC::${dbtype}";
$dsn = '' if ref $dsn eq 'CODE';
return 1 if $dsn =~ /driver=FreeTDS/i
- || ($self->_dbh_get_info(6)||'') =~ /tdsodbc/i;
+ || ($self->_dbh_get_info('SQL_DRIVER_NAME')||'') =~ /tdsodbc/i;
return 0;
}
my $maker = $self->next::method (@_);
# mysql 3 does not understand a bare JOIN
- my $mysql_ver = $self->_dbh_get_info(18);
+ my $mysql_ver = $self->_dbh_get_info('SQL_DBMS_VER');
$maker->{_default_jointype} = 'INNER' if $mysql_ver =~ /^3/;
}
Data::Compare
DBI
+ DBI::Const::GetInfoType
SQL::Abstract
Carp
}
SKIP: {
- my $mysql_version = $dbh->get_info( $GetInfoType{SQL_DBMS_VER} );
- skip "Cannot determine MySQL server version", 1 if !$mysql_version;
+ my $norm_version = $schema->storage->_server_info->{normalized_dbms_version}
+ or skip "Cannot determine MySQL server version", 1;
- my ($v1, $v2, $v3) = $mysql_version =~ /^(\d+)\.(\d+)(?:\.(\d+))?/;
- skip "Cannot determine MySQL server version", 1 if !$v1 || !defined($v2);
-
- $v3 ||= 0;
-
- if( ($v1 < 5) || ($v1 == 5 && $v2 == 0 && $v3 <= 3) ) {
+ if ($norm_version < 5.000003_01) {
$test_type_info->{charfield}->{data_type} = 'VARCHAR';
}
# check if we indeed do support stuff
my $test_server_supports_insert_returning = do {
- my $v = DBICTest::Schema->connect($dsn, $user, $pass)
- ->storage
- ->_get_dbh
- ->get_info(18);
- $v =~ /^(\d+)\.(\d+)/
- or die "Unparseable Pg server version: $v\n";
-
- ( sprintf ('%d.%d', $1, $2) >= 8.2 ) ? 1 : 0;
+
+ my $si = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_server_info;
+ die "Unparseable Pg server version: $si->{dbms_version}\n"
+ unless $si->{normalized_dbms_version};
+
+ $si->{normalized_dbms_version} < 8.002 ? 0 : 1;
};
is (
DBICTest::Schema->connect($dsn, $user, $pass)->storage->_use_insert_returning,
# check if we indeed do support stuff
my $v = do {
- my $v = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_dbh_get_info(18);
- $v =~ /^(\d+)\.(\d+)/
- or die "Unparseable Oracle server version: $v\n";
-
- sprintf('%d.%03d', $1, $2);
+ my $si = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_server_info;
+ $si->{normalized_dbms_version}
+ or die "Unparseable Oracle server version: $si->{dbms_version}\n";
};
my $test_server_supports_only_orajoins = $v < 9;
$ENV{NLS_LANG} = "AMERICAN";
my $v = do {
- my $v = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_dbh_get_info(18);
- $v =~ /^(\d+)\.(\d+)/
- or die "Unparseable Oracle server version: $v\n";
-
- sprintf('%d.%03d', $1, $2);
+ my $si = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_server_info;
+ $si->{normalized_dbms_version}
+ or die "Unparseable Oracle server version: $si->{dbms_version}\n";
};
+
##########
# the recyclebin (new for 10g) sometimes comes in the way
my $on_connect_sql = $v >= 10 ? ["ALTER SESSION SET recyclebin = OFF"] : [];
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
+my $name_sep = $schema->storage->_dbh_get_info('SQL_QUALIFIER_NAME_SEPARATOR');
+
my $dbh = $schema->storage->dbh;
# test RNO and name_sep detection
-my $name_sep = $dbh->get_info(41);
is $schema->storage->sql_maker->name_sep, $name_sep,
'name_sep detection';
use_ok('DBIC::DebugObj');
my $schema = DBICTest->init_schema();
-#diag('Testing against ' . join(' ', map { $schema->storage->dbh->get_info($_) } qw/17 18/));
-
$schema->storage->sql_maker->quote_char('`');
$schema->storage->sql_maker->name_sep('.');
my $schema = DBICTest->init_schema();
-#diag('Testing against ' . join(' ', map { $schema->storage->dbh->get_info($_) } qw/17 18/));
-
my $dsn = $schema->storage->_dbi_connect_info->[0];
$schema->connection(
$dsn,