sub _dbh_columns_info_for {
my ($self, $dbh, $table) = @_;
- if ($dbh->can('column_info')) {
- my %result;
- my $caught;
+ my %result;
+
+ if (! DBIx::Class::_ENV_::STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE and $dbh->can('column_info')) {
try {
my ($schema,$tab) = $table =~ /^(.+?)\.(.+)$/ ? ($1,$2) : (undef,$table);
my $sth = $dbh->column_info( undef,$schema, $tab, '%' );
$result{$col_name} = \%column_info;
}
} catch {
- $caught = 1;
+ %result = ();
};
- return \%result if !$caught && scalar keys %result;
+
+ return \%result if keys %result;
}
- my %result;
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;
- $column_info{data_type} = $sth->{TYPE}->[$i];
- $column_info{size} = $sth->{PRECISION}->[$i];
- $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0;
-
- if ($column_info{data_type} =~ m/^(.*?)\((.*?)\)$/) {
- $column_info{data_type} = $1;
- $column_info{size} = $2;
+
+### The acrobatics with lc names is necessary to support both the legacy
+### API that used NAME_lc exclusively, *AND* at the same time work properly
+### with column names differing in cas eonly (thanks pg!)
+
+ my ($columns, $seen_lcs);
+
+ ++$seen_lcs->{lc($_)} and $columns->{$_} = {
+ idx => scalar keys %$columns,
+ name => $_,
+ lc_name => lc($_),
+ } for @{$sth->{NAME}};
+
+ $seen_lcs->{$_->{lc_name}} == 1
+ and
+ $_->{name} = $_->{lc_name}
+ for values %$columns;
+
+ for ( values %$columns ) {
+ my $inf = {
+ data_type => $sth->{TYPE}->[$_->{idx}],
+ size => $sth->{PRECISION}->[$_->{idx}],
+ is_nullable => $sth->{NULLABLE}->[$_->{idx}] ? 1 : 0,
+ };
+
+ if ($inf->{data_type} =~ m/^(.*?)\((.*?)\)$/) {
+ @{$inf}{qw( data_type size)} = ($1, $2);
}
- $result{$columns[$i]} = \%column_info;
+ $result{$_->{name}} = $inf;
}
+
$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;
+ if ($dbh->can('type_info')) {
+ for my $inf (values %result) {
+ next if ! defined $inf->{data_type};
+
+ $inf->{data_type} = (
+ (
+ (
+ $dbh->type_info( $inf->{data_type} )
+ ||
+ next
+ )
+ ||
+ next
+ )->{TYPE_NAME}
+ ||
+ next
+ );
+
+ # FIXME - this may be an artifact of the DBD::Pg implmentation alone
+ # needs more testing in the future...
+ $inf->{size} -= 4 if (
+ ( $inf->{size}||0 > 4 )
+ and
+ $inf->{data_type} =~ qr/^text$/i
+ );
}
+
}
return \%result;
STRESSTEST_UTF8_UPGRADE_GENERATED_COLLAPSER_SOURCE => $ENV{DBIC_STRESSTEST_UTF8_UPGRADE_GENERATED_COLLAPSER_SOURCE} ? 1 : 0,
+ STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE => $ENV{DBIC_STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE} ? 1 : 0,
+
IV_SIZE => $Config{ivsize},
OS_NAME => $^O,
$schema->source("Artist")->column_info_from_storage(1);
$schema->source("Artist")->{_columns_info_loaded} = 0;
+ my @undef_default = DBIx::Class::_ENV_::STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE
+ ? ()
+ : ( default_value => undef )
+ ;
+
is_deeply (
$schema->source('Artist')->columns_info,
{
artistid => {
data_type => "INTEGER",
- default_value => undef,
+ @undef_default,
is_nullable => 0,
size => undef
},
charfield => {
data_type => "char",
- default_value => undef,
+ @undef_default,
is_nullable => 1,
size => 10
},
name => {
data_type => "varchar",
- default_value => undef,
+ @undef_default,
is_nullable => 1,
is_numeric => 0,
size => 100
{
artistid => {
data_type => "INTEGER",
- default_value => undef,
+ @undef_default,
is_nullable => 0,
size => undef
},
'rank' => {
'data_type' => 'integer',
'is_nullable' => 0,
- 'default_value' => '13',
+ DBIx::Class::_ENV_::STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE ? () : ( 'default_value' => '13' ),
},
'charfield' => {
'data_type' => 'char',
});
} 'LOCK IN SHARE MODE select works';
+my ($int_type_name, @undef_default) = DBIx::Class::_ENV_::STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE
+ ? ('integer')
+ : ( 'INT', default_value => undef )
+;
+
my $test_type_info = {
'artistid' => {
- 'data_type' => 'INT',
+ 'data_type' => $int_type_name,
'is_nullable' => 0,
'size' => 11,
- 'default_value' => undef,
+ @undef_default,
},
'name' => {
'data_type' => 'VARCHAR',
'is_nullable' => 1,
'size' => 100,
- 'default_value' => undef,
+ @undef_default,
},
'rank' => {
- 'data_type' => 'INT',
+ 'data_type' => $int_type_name,
'is_nullable' => 0,
'size' => 11,
- 'default_value' => 13,
+ DBIx::Class::_ENV_::STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE ? () : ( 'default_value' => '13' ),
},
'charfield' => {
'data_type' => 'CHAR',
'is_nullable' => 1,
'size' => 10,
- 'default_value' => undef,
+ @undef_default,
},
};
$test_type_info->{charfield}->{data_type} = 'VARCHAR';
}
+ if (DBIx::Class::_ENV_::STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE) {
+ $_->{data_type} = lc $_->{data_type} for values %$test_type_info;
+ }
+
my $type_info = $schema->storage->columns_info_for('artist');
is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');
}
my $type_info = $schema->storage->columns_info_for('dbic_t_schema.artist');
my $artistid_defval = delete $type_info->{artistid}->{default_value};
- like($artistid_defval,
- qr/^nextval\('([^\.]*\.){0,1}artist_artistid_seq'::(?:text|regclass)\)/,
- 'columns_info_for - sequence matches Pg get_autoinc_seq expectations');
- is_deeply($type_info, $test_type_info,
- 'columns_info_for - column data types');
-
+ # The curor info is too radically different from what is in the column_info
+ # call - just punt it (DBD::SQLite tests the codepath plenty enough)
+ unless (DBIx::Class::_ENV_::STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE) {
+ like(
+ $artistid_defval,
+ qr/^nextval\('([^\.]*\.){0,1}artist_artistid_seq'::(?:text|regclass)\)/,
+ 'columns_info_for - sequence matches Pg get_autoinc_seq expectations'
+ );
+ is_deeply($type_info, $test_type_info,
+ 'columns_info_for - column data types');
+ }
####### Array tests
projects / dbsrgits/DBIx-Class.git / commitdiff