From: Rafael Kitover <rkitover@cpan.org>
Date: Fri, 3 Jul 2009 01:29:49 +0000 (+0000)
Subject: rels are still fucked in sybase
X-Git-Tag: 0.04999_08~2^2~11
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=565335e6eef98b63fcabbb8e76117a13a8662a09;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

rels are still fucked in sybase
---

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index d79618d..ff336a0 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -688,25 +688,23 @@ sub _setup_src_meta {
         $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 @@ sub _ext_stmt {
     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
diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm
index 474d54b..0854358 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI.pm
@@ -116,18 +116,6 @@ sub load {
     $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) = @_;
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm b/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
index d5111e7..ae2d0ad 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/Sybase.pm
@@ -30,6 +30,8 @@ See L<DBIx::Class::Schema::Loader::Base>.
 
 =cut
 
+sub _is_case_sensitive { 1 }
+
 sub _setup {
     my $self = shift;
 
@@ -82,17 +84,22 @@ sub _table_fk_info {
 
     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) {
diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index f1e924f..669f135 100644
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -391,7 +391,7 @@ sub test_schema {
         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 drop_tables {
 
 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;