From: Rafael Kitover Date: Mon, 12 Apr 2010 23:42:24 +0000 (-0400) Subject: fix column name collisions with methods (RT#49443) X-Git-Tag: 0.07000~71 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9fdf3d5b3489415dbacf5d5724c6cb19acc9950d;p=dbsrgits%2FDBIx-Class-Schema-Loader.git fix column name collisions with methods (RT#49443) --- diff --git a/Changes b/Changes index 4253b04..b52165a 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,6 @@ Revision history for Perl extension DBIx::Class::Schema::Loader + - fix column name collisions with methods (RT#49443) - fix loading MySQL views on older MySQL versions (RT#47399) 0.06001 2010-04-10 01:31:12 diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 3514c57..f69f0ca 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -1397,6 +1397,35 @@ sub _make_src_class { $self->_inject($table_class, @{$self->additional_base_classes}); } +sub _resolve_col_accessor_collisions { + my ($self, $col_info) = @_; + + my $base = $self->result_base_class || 'DBIx::Class::Core'; + my @components = map "DBIx::Class::$_", @{ $self->components }; + + my @methods; + + for my $class ($base, @components) { + eval "require ${class};"; + die $@ if $@; + + push @methods, @{ Class::Inspector->methods($class) || [] }; + } + + my %methods; + @methods{@methods} = (); + + while (my ($col, $info) = each %$col_info) { + my $accessor = $info->{accessor} || $col; + + next if $accessor eq 'id'; # XXX fix this in DBIC + + if (exists $methods{$accessor}) { + $info->{accessor} = ucfirst $accessor; + } + } +} + # Set up metadata (cols, pks, etc) sub _setup_src_meta { my ($self, $table) = @_; @@ -1427,6 +1456,8 @@ sub _setup_src_meta { $col_info = { map { lc($_), $col_info->{$_} } keys %$col_info }; } + $self->_resolve_col_accessor_collisions($col_info); + my $fks = $self->_table_fk_info($table); for my $fkdef (@$fks) { diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm index 6f702a1..3ad36a3 100644 --- a/t/lib/dbixcsl_common_tests.pm +++ b/t/lib/dbixcsl_common_tests.pm @@ -87,7 +87,7 @@ sub run_tests { my $extra_count = $self->{extra}{count} || 0; - plan tests => @connect_info * (174 + $extra_count + ($self->{data_type_tests}{test_count} || 0)); + plan tests => @connect_info * (176 + $extra_count + ($self->{data_type_tests}{test_count} || 0)); foreach my $info_idx (0..$#connect_info) { my $info = $connect_info[$info_idx]; @@ -302,7 +302,13 @@ sub test_schema { isa_ok( $rsobj35, "DBIx::Class::ResultSet" ); my @columns_lt2 = $class2->columns; - is_deeply( \@columns_lt2, [ qw/id dat dat2/ ], "Column Ordering" ); + is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key dbix_class_testcomponent/ ], "Column Ordering" ); + + is $class2->column_info('set_primary_key')->{accessor}, 'Set_primary_key', + 'accessor for column name that conflicts with a result base class method renamed'; + + is $class2->column_info('dbix_class_testcomponent')->{accessor}, 'Dbix_class_testcomponent', + 'accessor for column name that conflicts with a component class method renamed'; my %uniq1 = $class1->unique_constraints; my $uniq1_test = 0; @@ -1040,11 +1046,14 @@ sub create { q{ INSERT INTO loader_test1s (dat) VALUES('bar') }, q{ INSERT INTO loader_test1s (dat) VALUES('baz') }, + # also test method collision qq{ CREATE TABLE loader_test2 ( id $self->{auto_inc_pk}, dat VARCHAR(32) NOT NULL, dat2 VARCHAR(32) NOT NULL, + set_primary_key INTEGER, + dbix_class_testcomponent INTEGER, UNIQUE (dat2, dat) ) $self->{innodb} },