From: Dagfinn Ilmari Mannsåker Date: Fri, 14 Dec 2007 04:51:35 +0000 (+0000) Subject: Set is_auto_increment for auto-increment columns (RT #31473) X-Git-Tag: 0.04999_01~11 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=78b7ccaaaff070d6053dda2843007369d7501662;p=dbsrgits%2FDBIx-Class-Schema-Loader.git Set is_auto_increment for auto-increment columns (RT #31473) (Only SQLite, MySQL and PostgreSQL are currently supported) --- diff --git a/Changes b/Changes index 0dffa48..1eabbf2 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,8 @@ Revision history for Perl extension DBIx::Class::Schema::Loader 0.04999_01 Not yet released + - Set is_auto_increment for auto-increment columns (RT #31473) + (Only SQLite, MySQL and PostgreSQL are currently supported) - Generate one-to-one accessors for unique foreign keys (ilmari) - Fix Win32 test skip counts for good (RT #30568, Kenichi Ishigaki) - Default Oracle db_schema to db username (patch diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm index 8b36423..347a7e5 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI.pm @@ -222,6 +222,10 @@ sub _columns_info_for { my $col_name = $info->{COLUMN_NAME}; $col_name =~ s/^\"(.*)\"$/$1/; + if ($self->_column_is_auto_increment($info)) { + $column_info{is_auto_increment} = 1; + } + $result{$col_name} = \%column_info; } $sth->finish; @@ -247,6 +251,10 @@ sub _columns_info_for { $column_info{size} = $2; } + if ($self->_column_is_auto_increment($table, $columns[$i], $sth, $i)) { + $column_info{is_auto_increment} = 1; + } + $result{$columns[$i]} = \%column_info; } $sth->finish; @@ -265,6 +273,10 @@ sub _columns_info_for { return \%result; } +# Override this in vendor class to return whether a column is +# auto-incremented +sub _column_is_auto_increment {} + =head1 SEE ALSO L diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm index f742bb0..d5fc32e 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm @@ -95,6 +95,12 @@ sub _table_uniq_info { return \@uniqs; } +sub _column_is_auto_increment { + my ($self, $info) = @_; + + return $info->{COLUMN_DEF} && $info->{COLUMN_DEF} =~ /\bnextval\(/i; +} + =head1 SEE ALSO L, L, diff --git a/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm b/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm index 3a0cdd6..3998fe8 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm @@ -52,6 +52,7 @@ sub _sqlite_parse_table { my @rels; my @uniqs; + my %auto_inc; my $dbh = $self->schema->storage->dbh; my $sth = $self->{_cache}->{sqlite_master} @@ -110,6 +111,11 @@ sub _sqlite_parse_table { push(@uniqs, [ $name => \@cols ]); } + if ($col =~ /AUTOINCREMENT/i) { + $col =~ /^(\S+)/; + $auto_inc{lc $1} = 1; + } + next if $col !~ /^(.*\S)\s+REFERENCES\s+(\w+) (?: \s* \( (.*) \) )? /ix; my ($cols, $f_table, $f_cols) = ($1, $2, $3); @@ -137,7 +143,16 @@ sub _sqlite_parse_table { }); } - return { rels => \@rels, uniqs => \@uniqs }; + return { rels => \@rels, uniqs => \@uniqs, auto_inc => \%auto_inc }; +} + +sub _column_is_auto_increment { + my ($self, $table, $col_name, $sth, $col_num) = @_; + + $self->{_sqlite_parse_data}->{$table} ||= + $self->_sqlite_parse_table($table); + + return $self->{_sqlite_parse_data}->{$table}->{auto_inc}->{$col_name}; } sub _table_fk_info { diff --git a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm index 5b994ea..219f06b 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm @@ -121,6 +121,12 @@ sub _table_uniq_info { return \@uniqs; } +sub _column_is_auto_increment { + my ($self, $info) = @_; + + return $info->{mysql_is_auto_increment}; +} + =head1 SEE ALSO L, L, diff --git a/t/10sqlite_common.t b/t/10sqlite_common.t index 7899cf6..13bb045 100644 --- a/t/10sqlite_common.t +++ b/t/10sqlite_common.t @@ -8,7 +8,7 @@ my $class = $@ ? 'SQLite2' : 'SQLite'; { my $tester = dbixcsl_common_tests->new( vendor => 'SQLite', - auto_inc_pk => 'INTEGER NOT NULL PRIMARY KEY', + auto_inc_pk => 'INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT', dsn => "dbi:$class:dbname=./t/sqlite_test", user => '', password => '', diff --git a/t/13db2_common.t b/t/13db2_common.t index b52fa68..e616f21 100644 --- a/t/13db2_common.t +++ b/t/13db2_common.t @@ -13,6 +13,7 @@ my $tester = dbixcsl_common_tests->new( user => $user, password => $password, db_schema => uc $user, + no_auto_increment => 1 ); if( !$dsn || !$user ) { diff --git a/t/14ora_common.t b/t/14ora_common.t index ad63787..75bd98c 100644 --- a/t/14ora_common.t +++ b/t/14ora_common.t @@ -12,6 +12,7 @@ my $tester = dbixcsl_common_tests->new( dsn => $dsn, user => $user, password => $password, + no_auto_increment => 1, ); if( !$dsn || !$user ) { diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm index 2495b3b..b22d0b3 100644 --- a/t/lib/dbixcsl_common_tests.pm +++ b/t/lib/dbixcsl_common_tests.pm @@ -43,7 +43,7 @@ sub _monikerize { sub run_tests { my $self = shift; - plan tests => 97; + plan tests => 98; $self->create(); @@ -223,6 +223,14 @@ sub run_tests { #} } + SKIP: { + skip "This vendor doesn't detect auto-increment columns", 1 + if $self->{no_auto_increment}; + + is( $rsobj1->result_source->column_info('id')->{is_auto_increment}, 1, + 'Setting is_auto_incrment works' + ); + } my $obj = $rsobj1->find(1); is( $obj->id, 1 );