[Bast-commits] r3898 - in branches/DBIx-Class-Schema-Loader/current: . lib/DBIx/Class/Schema/Loader lib/DBIx/Class/Schema/Loader/DBI t t/lib

ilmari at dev.catalyst.perl.org ilmari at dev.catalyst.perl.org
Fri Dec 14 04:51:35 GMT 2007 

Author: ilmari
Date: 2007-12-14 04:51:35 +0000 (Fri, 14 Dec 2007)
New Revision: 3898

Modified:
   branches/DBIx-Class-Schema-Loader/current/Changes
   branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI.pm
   branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
   branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm
   branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
   branches/DBIx-Class-Schema-Loader/current/t/10sqlite_common.t
   branches/DBIx-Class-Schema-Loader/current/t/13db2_common.t
   branches/DBIx-Class-Schema-Loader/current/t/14ora_common.t
   branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm
Log:
Set is_auto_increment for auto-increment columns (RT #31473)
(Only SQLite, MySQL and PostgreSQL are currently supported)

Modified: branches/DBIx-Class-Schema-Loader/current/Changes
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/Changes	2007-12-11 01:29:51 UTC (rev 3897)
+++ branches/DBIx-Class-Schema-Loader/current/Changes	2007-12-14 04:51:35 UTC (rev 3898)
@@ -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

Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm	2007-12-11 01:29:51 UTC (rev 3897)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm	2007-12-14 04:51:35 UTC (rev 3898)
@@ -95,6 +95,12 @@
     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>,

Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm	2007-12-11 01:29:51 UTC (rev 3897)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm	2007-12-14 04:51:35 UTC (rev 3898)
@@ -52,6 +52,7 @@
 
     my @rels;
     my @uniqs;
+    my %auto_inc;
 
     my $dbh = $self->schema->storage->dbh;
     my $sth = $self->{_cache}->{sqlite_master}
@@ -110,6 +111,11 @@
             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,9 +143,18 @@
         });
     }
 
-    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 {
     my ($self, $table) = @_;
 

Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm	2007-12-11 01:29:51 UTC (rev 3897)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm	2007-12-14 04:51:35 UTC (rev 3898)
@@ -121,6 +121,12 @@
     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>,

Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI.pm	2007-12-11 01:29:51 UTC (rev 3897)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI.pm	2007-12-14 04:51:35 UTC (rev 3898)
@@ -222,6 +222,10 @@
                 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 @@
             $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 @@
     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>

Modified: branches/DBIx-Class-Schema-Loader/current/t/10sqlite_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/10sqlite_common.t	2007-12-11 01:29:51 UTC (rev 3897)
+++ branches/DBIx-Class-Schema-Loader/current/t/10sqlite_common.t	2007-12-14 04:51:35 UTC (rev 3898)
@@ -8,7 +8,7 @@
 {
     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        => '',

Modified: branches/DBIx-Class-Schema-Loader/current/t/13db2_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/13db2_common.t	2007-12-11 01:29:51 UTC (rev 3897)
+++ branches/DBIx-Class-Schema-Loader/current/t/13db2_common.t	2007-12-14 04:51:35 UTC (rev 3898)
@@ -13,6 +13,7 @@
     user           => $user,
     password       => $password,
     db_schema      => uc $user,
+    no_auto_increment => 1
 );
 
 if( !$dsn || !$user ) {

Modified: branches/DBIx-Class-Schema-Loader/current/t/14ora_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/14ora_common.t	2007-12-11 01:29:51 UTC (rev 3897)
+++ branches/DBIx-Class-Schema-Loader/current/t/14ora_common.t	2007-12-14 04:51:35 UTC (rev 3898)
@@ -12,6 +12,7 @@
     dsn         => $dsn,
     user        => $user,
     password    => $password,
+    no_auto_increment => 1,
 );
 
 if( !$dsn || !$user ) {

Modified: branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm	2007-12-11 01:29:51 UTC (rev 3897)
+++ branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm	2007-12-14 04:51:35 UTC (rev 3898)
@@ -43,7 +43,7 @@
 sub run_tests {
     my $self = shift;
 
-    plan tests => 97;
+    plan tests => 98;
 
     $self->create();
 
@@ -223,7 +223,15 @@
         #}
     }
 
+    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 );
     is( $obj->dat, "foo" );

More information about the Bast-commits mailing list