From: Brandon Black <blblack@gmail.com>
Date: Fri, 17 Mar 2006 04:53:13 +0000 (+0000)
Subject: table/col case fixes, Changes updated, release 0.02006
X-Git-Tag: 0.03000~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ac5ad55744b535237c6f5f7cfeb60ae972e8a03a;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

table/col case fixes, Changes updated, release 0.02006
---

diff --git a/Changes b/Changes
index 9cf83a4..8cea979 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+0.02006 Fri Mar 17 04:55:55 UTC 2006
+        - Fix long-standing table/col-name case bugs
+
 0.02005 Mon Feb 27 23:53:17 UTC 2006
         - Move the external file loading to after everything else
 	  loader does, in case people want to define, override, or
diff --git a/META.yml b/META.yml
index 9a904e6..170818b 100644
--- a/META.yml
+++ b/META.yml
@@ -33,4 +33,4 @@ provides:
     file: lib/DBIx/Class/Schema/Loader/Writing.pm
   DBIx::Class::Schema::Loader::mysql:
     file: lib/DBIx/Class/Schema/Loader/mysql.pm
-generated_by: Module::Build version 0.2611
+generated_by: Module::Build version 0.2612
diff --git a/lib/DBIx/Class/Schema/Loader/DB2.pm b/lib/DBIx/Class/Schema/Loader/DB2.pm
index 9bfa285..967d135 100644
--- a/lib/DBIx/Class/Schema/Loader/DB2.pm
+++ b/lib/DBIx/Class/Schema/Loader/DB2.pm
@@ -34,7 +34,7 @@ sub _db_classes {
     return qw/PK::Auto::DB2/;
 }
 
-sub _tables {
+sub _tables_list {
     my $self = shift;
     my %args = @_; 
     my $db_schema = uc $self->db_schema;
@@ -58,8 +58,7 @@ sub _table_info {
     my ( $self, $table ) = @_;
 #    $|=1;
 #    print "_table_info($table)\n";
-    my ($db_schema, $tabname) = split /\./, $table, 2;
-    # print "DB_Schema: $db_schema, Table: $tabname\n";
+    my $db_schema = $self->db_schema;
     
     # FIXME: Horribly inefficient and just plain evil. (JMM)
     my $dbh = $self->schema->storage->dbh;
@@ -71,7 +70,7 @@ FROM SYSCAT.COLUMNS as c
 WHERE c.TABSCHEMA = ? and c.TABNAME = ?
 SQL
 
-    $sth->execute($db_schema, $tabname) or die;
+    $sth->execute($db_schema, $table) or die;
     my @cols = map { lc } map { @$_ } @{$sth->fetchall_arrayref};
 
     undef $sth;
@@ -83,7 +82,7 @@ JOIN SYSCAT.KEYCOLUSE as kcu ON tc.constname = kcu.constname
 WHERE tc.TABSCHEMA = ? and tc.TABNAME = ? and tc.TYPE = 'P'
 SQL
 
-    $sth->execute($db_schema, $tabname) or die;
+    $sth->execute($db_schema, $table) or die;
 
     my @pri = map { lc } map { @$_ } @{$sth->fetchall_arrayref};
 
@@ -101,14 +100,15 @@ SELECT SR.COLCOUNT, SR.REFTBNAME, SR.PKCOLNAMES, SR.FKCOLNAMES
 FROM SYSIBM.SYSRELS SR WHERE SR.TBNAME = ?
 SQL
 
+    my $db_schema = $self->db_schema;
     foreach my $table ( $self->tables ) {
-        next if ! $sth->execute(uc $table);
+        $table =~ s/^$db_schema\.//;
+        next if ! $sth->execute($table);
         while(my $res = $sth->fetchrow_arrayref()) {
-            my ($colcount, $other, $other_column, $column) =
-                map { lc } @$res;
+            my ($colcount, $other, $other_column, $column) = @$res;
 
-            my @self_cols = split(' ',$column);
-            my @other_cols = split(' ',$other_column);
+            my @self_cols = map { lc } split(' ',$column);
+            my @other_cols = map { lc } split(' ',$other_column);
             if(@self_cols != $colcount || @other_cols != $colcount) {
                 die "Column count discrepancy while getting rel info";
             }
diff --git a/lib/DBIx/Class/Schema/Loader/Generic.pm b/lib/DBIx/Class/Schema/Loader/Generic.pm
index 5ecb46b..5112862 100644
--- a/lib/DBIx/Class/Schema/Loader/Generic.pm
+++ b/lib/DBIx/Class/Schema/Loader/Generic.pm
@@ -29,6 +29,7 @@ __PACKAGE__->mk_ro_accessors(qw/
                                 drop_db_schema
                                 debug
 
+                                _tables
                                 classes
                                 monikers
                              /);
@@ -233,7 +234,7 @@ sub load {
 sub _load_external {
     my $self = shift;
 
-    foreach my $table_class (values %{$self->classes}) {
+    foreach my $table_class (map { $self->classes->{$_} } $self->tables) {
         $table_class->require;
         if($@ && $@ !~ /^Can't locate /) {
             croak "Failed to load external class definition"
@@ -367,23 +368,24 @@ sub _inject {
 sub _load_classes {
     my $self = shift;
 
-    my @tables     = $self->_tables();
     my @db_classes = $self->_db_classes();
     my $schema     = $self->schema;
 
-    foreach my $table (@tables) {
-        my $constraint = $self->constraint;
-        my $exclude = $self->exclude;
+    my $constraint = $self->constraint;
+    my $exclude = $self->exclude;
+    my @tables = sort grep
+        { /$constraint/ && (!$exclude || ! /$exclude/) }
+            $self->_tables_list;
+
+    $self->{_tables} = \@tables;
 
-        next unless $table =~ /$constraint/;
-        next if defined $exclude && $table =~ /$exclude/;
+    foreach my $table (@tables) {
 
         my ($db_schema, $tbl) = split /\./, $table;
-        my $tablename = lc $table;
         if($tbl) {
-            $tablename = $self->drop_db_schema ? $tbl : lc $table;
+            $table = $self->drop_db_schema ? $tbl : $table;
         }
-        my $lc_tblname = lc $tablename;
+        my $lc_table = lc $table;
 
         my $table_moniker = $self->_table2moniker($db_schema, $tbl);
         my $table_class = $schema . q{::} . $table_moniker;
@@ -398,16 +400,16 @@ sub _load_classes {
             if @{$self->resultset_components};
         $self->_inject($table_class, @{$self->left_base_classes});
 
-        warn qq/\# Initializing table "$tablename" as "$table_class"\n/
+        warn qq/\# Initializing table "$table" as "$table_class"\n/
             if $self->debug;
-        $table_class->table($lc_tblname);
+        $table_class->table($table);
 
         my ( $cols, $pks ) = $self->_table_info($table);
         carp("$table has no primary key") unless @$pks;
         $table_class->add_columns(@$cols);
         $table_class->set_primary_key(@$pks) if @$pks;
 
-        warn qq/$table_class->table('$tablename');\n/ if $self->debug;
+        warn qq/$table_class->table('$table');\n/ if $self->debug;
         my $columns = join "', '", @$cols;
         warn qq/$table_class->add_columns('$columns')\n/ if $self->debug;
         my $primaries = join "', '", @$pks;
@@ -415,15 +417,17 @@ sub _load_classes {
             if $self->debug && @$pks;
 
         $schema->register_class($table_moniker, $table_class);
-        $self->classes->{$lc_tblname} = $table_class;
-        $self->monikers->{$lc_tblname} = $table_moniker;
+        $self->classes->{$lc_table} = $table_class;
+        $self->monikers->{$lc_table} = $table_moniker;
+        $self->classes->{$table} = $table_class;
+        $self->monikers->{$table} = $table_moniker;
     }
 }
 
 =head2 tables
 
 Returns a sorted list of loaded tables, using the original database table
-names.  Actually generated from the keys of the C<monikers> hash below.
+names.
 
   my @tables = $schema->loader->tables;
 
@@ -432,7 +436,7 @@ names.  Actually generated from the keys of the C<monikers> hash below.
 sub tables {
     my $self = shift;
 
-    return sort keys %{ $self->monikers };
+    return @{$self->_tables};
 }
 
 # Find and setup relationships
@@ -447,10 +451,10 @@ sub _load_relationships {
             $self->db_schema, '', '', '', $table );
         next if !$sth;
         while(my $raw_rel = $sth->fetchrow_hashref) {
-            my $uk_tbl  = lc $raw_rel->{UK_TABLE_NAME};
+            my $uk_tbl  = $raw_rel->{UK_TABLE_NAME};
             my $uk_col  = lc $raw_rel->{UK_COLUMN_NAME};
             my $fk_col  = lc $raw_rel->{FK_COLUMN_NAME};
-            my $relid   = lc $raw_rel->{UK_NAME};
+            my $relid   = $raw_rel->{UK_NAME};
             $uk_tbl =~ s/$quoter//g;
             $uk_col =~ s/$quoter//g;
             $fk_col =~ s/$quoter//g;
@@ -499,14 +503,17 @@ sub _table2moniker {
 }
 
 # Overload in driver class
-sub _tables { croak "ABSTRACT METHOD" }
+sub _tables_list { croak "ABSTRACT METHOD" }
 
 sub _table_info { croak "ABSTRACT METHOD" }
 
 =head2 monikers
 
 Returns a hashref of loaded table-to-moniker mappings for the original
-database table names.
+database table names.  In cases where the database driver returns table
+names as uppercase or mixed case, there will also be a duplicate entry
+here in all lowercase.  Best practice would be to use lower-case table
+names when accessing this.
 
   my $monikers = $schema->loader->monikers;
   my $foo_tbl_moniker = $monikers->{foo_tbl};
@@ -517,7 +524,9 @@ database table names.
 =head2 classes
 
 Returns a hashref of table-to-classname mappings for the original database
-table names.  You probably shouldn't be using this for any normal or simple
+table names.  Same lowercase stuff as above applies here. 
+
+You probably shouldn't be using this for any normal or simple
 usage of your Schema.  The usual way to run queries on your tables is via
 C<$schema-E<gt>resultset('FooTbl')>, where C<FooTbl> is a moniker as
 returned by C<monikers> above.
diff --git a/lib/DBIx/Class/Schema/Loader/Pg.pm b/lib/DBIx/Class/Schema/Loader/Pg.pm
index af579e7..e69ca38 100644
--- a/lib/DBIx/Class/Schema/Loader/Pg.pm
+++ b/lib/DBIx/Class/Schema/Loader/Pg.pm
@@ -48,7 +48,7 @@ sub _db_classes {
     return qw/PK::Auto::Pg/;
 }
 
-sub _tables {
+sub _tables_list {
     my $self = shift;
     my $dbh = $self->schema->storage->dbh;
     my $quoter = $dbh->get_info(29) || q{"};
@@ -70,10 +70,10 @@ sub _table_info {
     my $quoter = $dbh->get_info(29) || q{"};
 
     my $sth = $dbh->column_info(undef, $self->db_schema, $table, undef);
-    my @cols = map { $_->[3] } @{ $sth->fetchall_arrayref };
+    my @cols = map { lc $_->[3] } @{ $sth->fetchall_arrayref };
     s/$quoter//g for @cols;
     
-    my @primary = $dbh->primary_key(undef, $self->db_schema, $table);
+    my @primary = map { lc } $dbh->primary_key(undef, $self->db_schema, $table);
 
     s/$quoter//g for @primary;
 
diff --git a/lib/DBIx/Class/Schema/Loader/SQLite.pm b/lib/DBIx/Class/Schema/Loader/SQLite.pm
index f4065a1..e3425ba 100644
--- a/lib/DBIx/Class/Schema/Loader/SQLite.pm
+++ b/lib/DBIx/Class/Schema/Loader/SQLite.pm
@@ -94,8 +94,8 @@ SELECT sql FROM sqlite_master WHERE tbl_name = ?
             my $cond;
 
             if($f_cols) {
-                my @cols = map { s/\s*//g; $_ } split(/\s*,\s*/,$cols);
-                my @f_cols = map { s/\s*//g; $_ } split(/\s*,\s*/,$f_cols);
+                my @cols = map { s/\s*//g; lc $_ } split(/\s*,\s*/,$cols);
+                my @f_cols = map { s/\s*//g; lc $_ } split(/\s*,\s*/,$f_cols);
                 die "Mismatched column count in rel for $table => $f_table"
                   if @cols != @f_cols;
                 $cond = {};
@@ -105,7 +105,7 @@ SELECT sql FROM sqlite_master WHERE tbl_name = ?
                 eval { $self->_make_cond_rel( $table, $f_table, $cond ) };
             }
             else {
-                eval { $self->_make_simple_rel( $table, $f_table, $cols ) };
+                eval { $self->_make_simple_rel( $table, $f_table, lc $cols ) };
             }
 
             warn qq/\# belongs_to_many failed "$@"\n\n/
@@ -114,7 +114,7 @@ SELECT sql FROM sqlite_master WHERE tbl_name = ?
     }
 }
 
-sub _tables {
+sub _tables_list {
     my $self = shift;
     my $dbh = $self->schema->storage->dbh;
     my $sth  = $dbh->prepare("SELECT * FROM sqlite_master");
@@ -136,7 +136,7 @@ sub _table_info {
     $sth->execute();
     my @columns;
     while ( my $row = $sth->fetchrow_hashref ) {
-        push @columns, $row->{name};
+        push @columns, lc $row->{name};
     }
     $sth->finish;
 
@@ -156,11 +156,11 @@ SQL
     my @pks;
 
     if ($primary) {
-        @pks = ($primary);
+        @pks = (lc $primary);
     }
     else {
         my ($pks) = $sql =~ m/PRIMARY\s+KEY\s*\(\s*([^)]+)\s*\)/i;
-        @pks = split( m/\s*\,\s*/, $pks ) if $pks;
+        @pks = map { lc } split( m/\s*\,\s*/, $pks ) if $pks;
     }
     return ( \@columns, \@pks );
 }
diff --git a/lib/DBIx/Class/Schema/Loader/Writing.pm b/lib/DBIx/Class/Schema/Loader/Writing.pm
index 7ea1e53..77962af 100644
--- a/lib/DBIx/Class/Schema/Loader/Writing.pm
+++ b/lib/DBIx/Class/Schema/Loader/Writing.pm
@@ -25,7 +25,7 @@ DBIx::Class::Schema::Loader::Writing - Loader subclass writing guide
           # You may want to return more, or less, than this.
   }
 
-  sub _tables {
+  sub _tables_list {
       my $self = shift;
       my $dbh = $self->schema->storage->dbh;
       return $dbh->tables; # Your DBD may need something different
diff --git a/lib/DBIx/Class/Schema/Loader/mysql.pm b/lib/DBIx/Class/Schema/Loader/mysql.pm
index 7a7d322..64f7500 100644
--- a/lib/DBIx/Class/Schema/Loader/mysql.pm
+++ b/lib/DBIx/Class/Schema/Loader/mysql.pm
@@ -53,8 +53,8 @@ sub _load_relationships {
             my $f_table = shift @reldata;
             my $f_cols = shift @reldata;
 
-            my @cols = map { s/$quoter//; $_ } split(/\s*,\s*/,$cols);
-            my @f_cols = map { s/$quoter//; $_ } split(/\s*,\s*/,$f_cols);
+            my @cols = map { s/$quoter//; lc $_ } split(/\s*,\s*/,$cols);
+            my @f_cols = map { s/$quoter//; lc $_ } split(/\s*,\s*/,$f_cols);
             die "Mismatched column count in rel for $table => $f_table"
               if @cols != @f_cols;
             
@@ -71,7 +71,7 @@ sub _load_relationships {
     }
 }
 
-sub _tables {
+sub _tables_list {
     my $self = shift;
     my $dbh    = $self->schema->storage->dbh;
     my @tables;
@@ -95,8 +95,8 @@ sub _table_info {
     my ( @cols, @pri );
     while ( my $hash = $sth->fetchrow_hashref ) {
         my ($col) = $hash->{Field} =~ /(\w+)/;
-        push @cols, $col;
-        push @pri, $col if $hash->{Key} eq "PRI";
+        push @cols, lc $col;
+        push @pri, lc $col if $hash->{Key} eq "PRI";
     }
 
     return ( \@cols, \@pri );
diff --git a/t/13db2_common.t b/t/13db2_common.t
index b3ce5c9..149a0e9 100644
--- a/t/13db2_common.t
+++ b/t/13db2_common.t
@@ -12,7 +12,7 @@ my $tester = dbixcsl_common_tests->new(
     dsn            => $dsn,
     user           => $user,
     password       => $password,
-    db_schema      => $user,
+    db_schema      => uc $user,
     drop_db_schema => 1,
 );