[Bast-commits] r6957 - in branches/DBIx-Class-Schema-Loader/mssql_tweaks: lib/DBIx/Class/Schema/Loader lib/DBIx/Class/Schema/Loader/DBI t/lib

[caelum at dev.catalyst.perl.org]

Author: caelum
Date: 2009-07-03 01:29:49 +0000 (Fri, 03 Jul 2009)
New Revision: 6957

Modified:
   branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/Base.pm
   branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI.pm
   branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
   branches/DBIx-Class-Schema-Loader/mssql_tweaks/t/lib/dbixcsl_common_tests.pm
Log:
rels are still fucked in sybase

Modified: branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/Base.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/Base.pm	2009-07-03 00:32:48 UTC (rev 6956)
+++ branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/Base.pm	2009-07-03 01:29:49 UTC (rev 6957)
@@ -688,25 +688,23 @@
         $self->_dbic_stmt($table_class,'add_columns',@$cols);
     }
     else {
-        my %col_info_lc;
         for my $col (keys %$col_info) {
-            my $lc_col = lc $col;
-            $col_info_lc{$lc_col} = $col_info->{$_};
-
-            $col_info_lc{$lc_col}->{accessor} = $lc_col
-                if $col ne $lc_col;
+            $col_info->{$col}{accessor} = lc $col
+                if $col ne lc($col);
         }
 
         my $fks = $self->_table_fk_info($table);
+
         for my $fkdef (@$fks) {
             for my $col (@{ $fkdef->{local_columns} }) {
-                $col_info_lc{$col}->{is_foreign_key} = 1;
+                $col = lc $col unless $self->_is_case_sensitive;
+                $col_info->{$col}{is_foreign_key} = 1;
             }
         }
         $self->_dbic_stmt(
             $table_class,
             'add_columns',
-            map { $_, ($col_info_lc{$_}||{}) } @$cols
+            map { $_, ($col_info->{$_}||{}) } @$cols
         );
     }
 
@@ -830,6 +828,20 @@
     push(@{$self->{_ext_storage}->{$class}}, $stmt);
 }
 
+sub _quote_table_name {
+    my ($self, $table) = @_;
+
+    my $qt = $self->schema->storage->sql_maker->quote_char;
+
+    if (ref $qt) {
+        return $qt->[0] . $table . $qt->[1];
+    }
+
+    return $qt . $table . $qt;
+}
+
+sub _is_case_sensitive { 0 }
+
 =head2 monikers
 
 Returns a hashref of loaded table to moniker mappings.  There will

Modified: branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm	2009-07-03 00:32:48 UTC (rev 6956)
+++ branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm	2009-07-03 01:29:49 UTC (rev 6957)
@@ -30,6 +30,8 @@
 
 =cut
 
+sub _is_case_sensitive { 1 }
+
 sub _setup {
     my $self = shift;
 
@@ -82,17 +84,22 @@
 
     my ($local_cols, $remote_cols, $remote_table, @rels);
     my $dbh = $self->schema->storage->dbh;
+
+    local $dbh->{FetchHashKeyName} = 'NAME_lc';
+
     # hide "Object does not exist in this database." when trying to fetch fkeys
     $dbh->{syb_err_handler} = sub { return 0 if $_[0] == 17461; }; 
-    my $sth = $dbh->prepare(qq{sp_fkeys \@FKTABLE_NAME = '$table'});
+    my $sth = $dbh->prepare(qq{sp_fkeys \@fktable_name = '$table'});
     $sth->execute;
 
     while (my $row = $sth->fetchrow_hashref) {
-        next unless $row->{FK_NAME};
-        my $fk = $row->{FK_NAME};
-        push @{$local_cols->{$fk}}, $row->{FKCOLUMN_NAME};
-        push @{$remote_cols->{$fk}}, $row->{PKCOLUMN_NAME};
-        $remote_table->{$fk} = $row->{PKTABLE_NAME};
+        my $fk = $row->{fk_name} ||
+'fk_'.$row->{fktable_qualifier}.'_'.$row->{fktable_owner}.'_'
+.$row->{fktable_name}.'_'.$row->{fkcolumn_name};
+
+        push @{$local_cols->{$fk}}, $row->{fkcolumn_name};
+        push @{$remote_cols->{$fk}}, $row->{pkcolumn_name};
+        $remote_table->{$fk} = $row->{pktable_name};
     }
 
     foreach my $fk (keys %$remote_table) {

Modified: branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI.pm	2009-07-03 00:32:48 UTC (rev 6956)
+++ branches/DBIx-Class-Schema-Loader/mssql_tweaks/lib/DBIx/Class/Schema/Loader/DBI.pm	2009-07-03 01:29:49 UTC (rev 6957)
@@ -116,18 +116,6 @@
     $self->next::method(@_);
 }
 
-sub _quote_table_name {
-    my ($self, $table) = @_;
-
-    my $qt = $self->schema->storage->sql_maker->quote_char;
-
-    if (ref $qt) {
-        return $qt->[0] . $table . $qt->[1];
-    }
-
-    return $qt . $table . $qt;
-}
-
 # Returns an arrayref of column names
 sub _table_columns {
     my ($self, $table) = @_;

Modified: branches/DBIx-Class-Schema-Loader/mssql_tweaks/t/lib/dbixcsl_common_tests.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/mssql_tweaks/t/lib/dbixcsl_common_tests.pm	2009-07-03 00:32:48 UTC (rev 6956)
+++ branches/DBIx-Class-Schema-Loader/mssql_tweaks/t/lib/dbixcsl_common_tests.pm	2009-07-03 01:29:49 UTC (rev 6957)
@@ -391,7 +391,7 @@
         isa_ok( $rs_rel4->first, $class4);
 
         # find on multi-col pk
-        my $obj5 = $rsobj5->find({id1 => 1, id2 => 1});
+        my $obj5 = $rsobj5->find({id1 => 1, iD2 => 1});
         is( $obj5->id2, 1, "Find on multi-col PK" );
 
         # mulit-col fk def
@@ -1184,9 +1184,10 @@
 
 sub DESTROY {
     my $self = shift;
-    $self->drop_tables if $self->{_created};
-    rmtree $DUMP_DIR
-	unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP};
+    unless ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
+	$self->drop_tables if $self->{_created};
+	rmtree $DUMP_DIR
+    }
 }
 
 1;