From: Rafael Kitover <rkitover@cpan.org>
Date: Wed, 3 Mar 2010 21:56:02 +0000 (-0500)
Subject: is_auto_increment for Firebird, refactor _extra_column_info
X-Git-Tag: 0.06000~68
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=45be2ce774dc5af71a60397db33bc952c22aa489;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

is_auto_increment for Firebird, refactor _extra_column_info
---

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index d41f823..5c395b9 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -1352,34 +1352,28 @@ sub _setup_src_meta {
     $self->_dbic_stmt($table_class,'table',$table_name);
 
     my $cols = $self->_table_columns($table);
-    my $col_info;
-    eval { $col_info = $self->__columns_info_for($table) };
-    if($@) {
-        $self->_dbic_stmt($table_class,'add_columns',@$cols);
-    }
-    else {
-        if ($self->_is_case_sensitive) {
-            for my $col (keys %$col_info) {
-                $col_info->{$col}{accessor} = lc $col
-                    if $col ne lc($col);
-            }
-        } else {
-            $col_info = { map { lc($_), $col_info->{$_} } keys %$col_info };
+    my $col_info = $self->__columns_info_for($table);
+    if ($self->_is_case_sensitive) {
+        for my $col (keys %$col_info) {
+            $col_info->{$col}{accessor} = lc $col
+                if $col ne lc($col);
         }
+    } else {
+        $col_info = { map { lc($_), $col_info->{$_} } keys %$col_info };
+    }
 
-        my $fks = $self->_table_fk_info($table);
+    my $fks = $self->_table_fk_info($table);
 
-        for my $fkdef (@$fks) {
-            for my $col (@{ $fkdef->{local_columns} }) {
-                $col_info->{$col}{is_foreign_key} = 1;
-            }
+    for my $fkdef (@$fks) {
+        for my $col (@{ $fkdef->{local_columns} }) {
+            $col_info->{$col}{is_foreign_key} = 1;
         }
-        $self->_dbic_stmt(
-            $table_class,
-            'add_columns',
-            map { $_, ($col_info->{$_}||{}) } @$cols
-        );
     }
+    $self->_dbic_stmt(
+        $table_class,
+        'add_columns',
+        map { $_, ($col_info->{$_}||{}) } @$cols
+    );
 
     my %uniq_tag; # used to eliminate duplicate uniqs
 
diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm
index 6229cf8..78205bf 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI.pm
@@ -290,7 +290,9 @@ sub _columns_info_for {
                 my $col_name = $info->{COLUMN_NAME};
                 $col_name =~ s/^\"(.*)\"$/$1/;
 
-                my $extra_info = $self->_extra_column_info($info) || {};
+                my $extra_info = $self->_extra_column_info(
+                    $table, $col_name, $column_info, $info
+                ) || {};
                 $column_info = { %$column_info, %$extra_info };
 
                 $result{$col_name} = $column_info;
@@ -315,7 +317,7 @@ sub _columns_info_for {
             $column_info->{size}    = $2;
         }
 
-        my $extra_info = $self->_extra_column_info($table, $columns[$i], $sth, $i) || {};
+        my $extra_info = $self->_extra_column_info($table, $columns[$i], $column_info) || {};
         $column_info = { %$column_info, %$extra_info };
 
         $result{$columns[$i]} = $column_info;
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm b/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
index debc230..0ceda3a 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/DB2.pm
@@ -108,11 +108,9 @@ sub _columns_info_for {
 }
 
 sub _extra_column_info {
-    my ($self, $info) = @_;
+    my ($self, $table, $column, $info, $dbi_info) = @_;
     my %extra_info;
 
-    my ($table, $column) = @$info{qw/TABLE_NAME COLUMN_NAME/};
-
     my $dbh = $self->schema->storage->dbh;
     my $sth = $dbh->prepare_cached(
         q{
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/InterBase.pm b/lib/DBIx/Class/Schema/Loader/DBI/InterBase.pm
index e731182..0ab1b3f 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/InterBase.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/InterBase.pm
@@ -2,7 +2,6 @@ package DBIx::Class::Schema::Loader::DBI::InterBase;
 
 use strict;
 use warnings;
-use namespace::autoclean;
 use Class::C3;
 use base qw/DBIx::Class::Schema::Loader::DBI/;
 use Carp::Clan qw/^DBIx::Class/;
@@ -103,6 +102,36 @@ EOF
     return \@uniqs;
 }
 
+sub _extra_column_info {
+    my ($self, $table, $column, $info, $dbi_info) = @_;
+    my %extra_info;
+
+    my $dbh = $self->schema->storage->dbh;
+
+    local $dbh->{LongReadLen} = 100000;
+    local $dbh->{LongTruncOk} = 1;
+
+    my $sth = $dbh->prepare(<<'EOF');
+SELECT t.rdb$trigger_source
+FROM rdb$triggers t
+WHERE t.rdb$relation_name = ?
+EOF
+
+    $sth->execute($table);
+
+    while (my ($trigger) = $sth->fetchrow_array) {
+        my ($trig_col, $generator) = $trigger =~
+/new\s*.\s*(\w+) \s* = \s* gen_id\s* \( \s* (\w+)/ix;
+
+        if ($trig_col eq $column) {
+            $extra_info{is_auto_increment} = 1;
+            $extra_info{sequence}          = $generator;
+        }
+    }
+
+    return \%extra_info;
+}
+
 =head1 SEE ALSO
 
 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm b/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm
index 34c01ae..406904c 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/MSSQL.pm
@@ -97,11 +97,9 @@ sub _table_uniq_info {
 }
 
 sub _extra_column_info {
-    my ($self, $info) = @_;
+    my ($self, $table, $column, $info, $dbi_info) = @_;
     my %extra_info;
 
-    my ($table, $column) = @$info{qw/TABLE_NAME COLUMN_NAME/};
-
     my $dbh = $self->schema->storage->dbh;
     my $sth = $dbh->prepare(qq{
         SELECT COLUMN_NAME 
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm b/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
index 3abe28b..c6f78f9 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
@@ -127,11 +127,9 @@ sub _columns_info_for {
 }
 
 sub _extra_column_info {
-    my ($self, $info) = @_;
+    my ($self, $table, $column, $info, $dbi_info) = @_;
     my %extra_info;
 
-    my ($table, $column) = @$info{qw/TABLE_NAME COLUMN_NAME/};
-
     my $dbh = $self->schema->storage->dbh;
     my $sth = $dbh->prepare_cached(
         q{
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
index 06c52ba..6d26474 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
@@ -200,10 +200,10 @@ EOF
 }
 
 sub _extra_column_info {
-    my ($self, $info) = @_;
+    my ($self, $table, $column, $info, $dbi_info) = @_;
     my %extra_info;
 
-    if ($info->{COLUMN_DEF} && $info->{COLUMN_DEF} =~ /\bnextval\(/i) {
+    if ($dbi_info->{COLUMN_DEF} && $dbi_info->{COLUMN_DEF} =~ /\bnextval\(/i) {
         $extra_info{is_auto_increment} = 1;
     }
 
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm b/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm
index 7f03dcb..b771681 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm
@@ -50,13 +50,12 @@ sub rescan {
 }
 
 sub _extra_column_info {
-    my ($self, $table, $col_name, $sth, $col_num) = @_;
-    ($table, $col_name) = @{$table}{qw/TABLE_NAME COLUMN_NAME/} if ref $table;
+    my ($self, $table, $col_name, $info, $dbi_info) = @_;
     my %extra_info;
 
     my $dbh = $self->schema->storage->dbh;
     my $has_autoinc = eval {
-      my $get_seq = $self->{_cache}->{sqlite_sequence}
+      my $get_seq = $self->{_cache}{sqlite_sequence}
         ||= $dbh->prepare(q{SELECT count(*) FROM sqlite_sequence WHERE name = ?});
       $get_seq->execute($table);
       my ($ret) = $get_seq->fetchrow_array;
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm b/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
index f980c00..68f7be9 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
@@ -287,11 +287,9 @@ WHERE o.name = @{[ $dbh->quote($table) ]} AND o.type = 'U'
 }
 
 sub _extra_column_info {
-    my ($self, $info) = @_;
+    my ($self, $table, $column, $info, $dbi_info) = @_;
     my %extra_info;
 
-    my ($table, $column) = @$info{qw/TABLE_NAME COLUMN_NAME/};
-
     my $dbh = $self->schema->storage->dbh;
     my $sth = $dbh->prepare(qq{SELECT name FROM syscolumns WHERE id = (SELECT id FROM sysobjects WHERE name = @{[ $dbh->quote($table) ]}) AND (status & 0x80) = 0x80 AND name = @{[ $dbh->quote($column) ]}});
     $sth->execute();
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
index 966cec3..f102b3f 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
@@ -117,20 +117,20 @@ sub _table_uniq_info {
 
 sub _extra_column_info {
     no warnings 'uninitialized';
-    my ($self, $info) = @_;
+    my ($self, $table, $col, $info, $dbi_info) = @_;
     my %extra_info;
 
-    if ($info->{mysql_is_auto_increment}) {
+    if ($dbi_info->{mysql_is_auto_increment}) {
         $extra_info{is_auto_increment} = 1
     }
-    if ($info->{mysql_type_name} =~ /\bunsigned\b/i) {
+    if ($dbi_info->{mysql_type_name} =~ /\bunsigned\b/i) {
         $extra_info{extra}{unsigned} = 1;
     }
-    if ($info->{mysql_values}) {
-        $extra_info{extra}{list} = $info->{mysql_values};
+    if ($dbi_info->{mysql_values}) {
+        $extra_info{extra}{list} = $dbi_info->{mysql_values};
     }
-    if (   $info->{COLUMN_DEF}      =~ /^CURRENT_TIMESTAMP\z/i
-        && $info->{mysql_type_name} =~ /^TIMESTAMP\z/i) {
+    if (   $dbi_info->{COLUMN_DEF}      =~ /^CURRENT_TIMESTAMP\z/i
+        && $dbi_info->{mysql_type_name} =~ /^TIMESTAMP\z/i) {
 
         $extra_info{default_value} = \'CURRENT_TIMESTAMP';
     }
diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index 3e67dac..1b3069f 100644
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -99,7 +99,6 @@ sub run_tests {
     # First, with in-memory classes
     my $schema_class = $self->setup_schema(@connect_info);
     $self->test_schema($schema_class);
-    $self->drop_tables;
 }
 
 # defined in sub create