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 (file)
--- 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 (file)
--- 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<DBIx::Class::Schema::Loader>

diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
index f742bb0..d5fc32e 100644 (file)
--- 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<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,

diff --git a/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm b/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm
index 3a0cdd6..3998fe8 100644 (file)
--- 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 (file)
--- 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<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,

diff --git a/t/10sqlite_common.t b/t/10sqlite_common.t
index 7899cf6..13bb045 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 );