From: Rafael Kitover <rkitover@cpan.org>
Date: Thu, 12 May 2011 09:48:29 +0000 (-0400)
Subject: fix mysql rel detection for mixed-case tables on mixed-case filesystems
X-Git-Tag: 0.07011~124
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c0767caf51045926284f203a7d59890db994aa76;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

fix mysql rel detection for mixed-case tables on mixed-case filesystems
---

diff --git a/Changes b/Changes
index 2e4a326..ecdc4a9 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - fix for mysql rel detection in mixed-case tables on mixed-case
+          filesystems (OSX and Windows)
         - support for DBD::Firebird
         - support for unicode Firebird data types
 
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
index a562422..8489e30 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
@@ -3,8 +3,9 @@ package DBIx::Class::Schema::Loader::DBI::mysql;
 use strict;
 use warnings;
 use base 'DBIx::Class::Schema::Loader::DBI';
-use Carp::Clan qw/^DBIx::Class/;
 use mro 'c3';
+use List::Util 'first';
+use namespace::clean;
 
 our $VERSION = '0.07010';
 
@@ -12,18 +13,9 @@ our $VERSION = '0.07010';
 
 DBIx::Class::Schema::Loader::DBI::mysql - DBIx::Class::Schema::Loader::DBI mysql Implementation.
 
-=head1 SYNOPSIS
-
-  package My::Schema;
-  use base qw/DBIx::Class::Schema::Loader/;
-
-  __PACKAGE__->loader_options( debug => 1 );
-
-  1;
-
 =head1 DESCRIPTION
 
-See L<DBIx::Class::Schema::Loader::Base>.
+See L<DBIx::Class::Schema::Loader> and L<DBIx::Class::Schema::Loader::Base>.
 
 =cut
 
@@ -71,10 +63,12 @@ sub _table_fk_info {
         my @f_cols = map { s/(?: \Q$self->{_quoter}\E | $qt )//x; $self->_lc($_) }
             split(/$qt?\s*$qt?,$qt?\s*$qt?/, $f_cols);
 
+        my $remote_table = first { $_ =~ /^${f_table}\z/i } $self->_tables_list;
+
         push(@rels, {
             local_columns => \@cols,
             remote_columns => \@f_cols,
-            remote_table => $f_table
+            remote_table => $remote_table,
         });
     }
 
diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index 136af6b..94bf90a 100644
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -102,7 +102,7 @@ sub run_tests {
     $num_rescans++ if $self->{vendor} eq 'Firebird';
 
     plan tests => @connect_info *
-        (192 + $num_rescans * $col_accessor_map_tests + $extra_count + ($self->{data_type_tests}{test_count} || 0));
+        (194 + $num_rescans * $col_accessor_map_tests + $extra_count + ($self->{data_type_tests}{test_count} || 0));
 
     foreach my $info_idx (0..$#connect_info) {
         my $info = $connect_info[$info_idx];
@@ -1132,10 +1132,16 @@ qq| INSERT INTO ${oqt}LoaderTest41${cqt} VALUES (1, 1) |,
     $self->rescan_without_warnings($conn);
 
     if (not $self->{skip_rels}) {
-        is try { $conn->resultset('LoaderTest41')->find(1)->loader_test40->foo3_bar }, 'foo',
-            'rel and accessor for mixed-case column name in mixed case table';
+        ok my $row = try { $conn->resultset('LoaderTest41')->find(1) },
+            'row in mixed-case table';
+        ok my $related_row = try { $row->loader_test40 },
+            'rel in mixed-case table';
+        is try { $related_row->foo3_bar }, 'foo',
+            'accessor for mixed-case column name in mixed case table';
     }
     else {
+        SKIP: { skip 'not testing mixed-case rels with skip_rels', 2 }
+
         is try { $conn->resultset('LoaderTest40')->find(1)->foo3_bar }, 'foo',
             'accessor for mixed-case column name in mixed case table';
     }