From: Peter Rabbitson Date: Fri, 7 Nov 2014 13:01:45 +0000 (+0100) Subject: Cleanup code in _dbh_columns_info_for, add stresstest var to smoke it X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f45dc928a3d4a50b495dde22a423b3ce0da5234c;p=dbsrgits%2FDBIx-Class.git Cleanup code in _dbh_columns_info_for, add stresstest var to smoke it --- diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 7122756..4e67f1b 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -2584,9 +2584,9 @@ see L. 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, '%' ); @@ -2603,39 +2603,75 @@ sub _dbh_columns_info_for { $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; diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm index 3eab868..f90c998 100644 --- a/lib/DBIx/Class/_Util.pm +++ b/lib/DBIx/Class/_Util.pm @@ -36,6 +36,8 @@ BEGIN { 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, diff --git a/t/60core.t b/t/60core.t index 9ee9b6d..77ee4f9 100644 --- a/t/60core.t +++ b/t/60core.t @@ -387,24 +387,29 @@ lives_ok (sub { my $newlink = $newbook->link}, "stringify to false value doesn't $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 @@ -426,7 +431,7 @@ lives_ok (sub { my $newlink = $newbook->link}, "stringify to false value doesn't { artistid => { data_type => "INTEGER", - default_value => undef, + @undef_default, is_nullable => 0, size => undef }, diff --git a/t/64db.t b/t/64db.t index d1284f8..1a0046d 100644 --- a/t/64db.t +++ b/t/64db.t @@ -62,7 +62,7 @@ is_deeply ( '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', diff --git a/t/71mysql.t b/t/71mysql.t index ef2c7de..2f99ff5 100644 --- a/t/71mysql.t +++ b/t/71mysql.t @@ -100,30 +100,35 @@ lives_ok { }); } '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, }, }; @@ -178,6 +183,10 @@ SKIP: { $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'); } diff --git a/t/72pg.t b/t/72pg.t index 857ff64..5f00ff9 100644 --- a/t/72pg.t +++ b/t/72pg.t @@ -196,14 +196,19 @@ for my $use_insert_returning ($test_server_supports_insert_returning 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