X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FCDBICompat%2FColumnCase.pm;h=4e6511752282a58b0664463d0f83a277b2e46ddf;hb=fef5d100c208d604c7a7b3c33eb6e32946d71848;hp=d6f527c2f55b878dcda9b29414a822471768b3ea;hpb=12bbb33986a29dc27dd3e2b9d082a87f50124ec1;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/CDBICompat/ColumnCase.pm b/lib/DBIx/Class/CDBICompat/ColumnCase.pm index d6f527c..4e65117 100644 --- a/lib/DBIx/Class/CDBICompat/ColumnCase.pm +++ b/lib/DBIx/Class/CDBICompat/ColumnCase.pm @@ -17,24 +17,30 @@ sub _register_columns { sub has_a { my ($class, $col, @rest) = @_; $class->NEXT::ACTUAL::has_a(lc($col), @rest); - $class->delete_accessor($col); - $class->mk_group_accessors('has_a' => $col); + $class->mk_group_accessors('inflated_column' => $col); return 1; } -sub get_has_a { +sub has_many { + my ($class, $rel, $f_class, $f_key, @rest) = @_; + return $class->NEXT::ACTUAL::has_many($rel, $f_class, ( ref($f_key) ? + $f_key : + lc($f_key) ), @rest); +} + +sub get_inflated_column { my ($class, $get, @rest) = @_; - return $class->NEXT::ACTUAL::get_has_a(lc($get), @rest); + return $class->NEXT::ACTUAL::get_inflated_column(lc($get), @rest); } -sub store_has_a { +sub store_inflated_column { my ($class, $set, @rest) = @_; - return $class->NEXT::ACTUAL::store_has_a(lc($set), @rest); + return $class->NEXT::ACTUAL::store_inflated_column(lc($set), @rest); } -sub set_has_a { +sub set_inflated_column { my ($class, $set, @rest) = @_; - return $class->NEXT::ACTUAL::set_has_a(lc($set), @rest); + return $class->NEXT::ACTUAL::set_inflated_column(lc($set), @rest); } sub get_column { @@ -59,10 +65,16 @@ sub find_column { sub _mk_group_accessors { my ($class, $type, $group, @fields) = @_; - my %fields; - $fields{$_} = 1 for @fields, - map lc, grep { !defined &{"${class}::${_}"} } @fields; - return $class->NEXT::ACTUAL::_mk_group_accessors($type, $group, keys %fields); + #warn join(', ', map { ref $_ ? (@$_) : ($_) } @fields); + my @extra; + foreach (@fields) { + my ($acc, $field) = ref $_ ? @$_ : ($_, $_); + #warn "$acc ".lc($acc)." $field"; + next if defined &{"${class}::${acc}"}; + push(@extra, [ lc $acc => $field ]); + } + return $class->NEXT::ACTUAL::_mk_group_accessors($type, $group, + @fields, @extra); } sub _cond_key {