X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FCDBICompat%2FColumnCase.pm;h=13bec9cbe77eeb800dcb560557a2cfd6106e9b72;hb=fcf32d045;hp=d6f527c2f55b878dcda9b29414a822471768b3ea;hpb=12bbb33986a29dc27dd3e2b9d082a87f50124ec1;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/CDBICompat/ColumnCase.pm b/lib/DBIx/Class/CDBICompat/ColumnCase.pm index d6f527c..13bec9c 100644 --- a/lib/DBIx/Class/CDBICompat/ColumnCase.pm +++ b/lib/DBIx/Class/CDBICompat/ColumnCase.pm @@ -1,85 +1,104 @@ -package DBIx::Class::CDBICompat::ColumnCase; +package # hide from PAUSE + DBIx::Class::CDBICompat::ColumnCase; use strict; use warnings; -use NEXT; sub _register_column_group { my ($class, $group, @cols) = @_; - return $class->NEXT::ACTUAL::_register_column_group($group => map lc, @cols); + return $class->next::method($group => map lc, @cols); } -sub _register_columns { +sub add_columns { my ($class, @cols) = @_; - return $class->NEXT::ACTUAL::_register_columns(map lc, @cols); + return $class->result_source_instance->add_columns(map lc, @cols); } 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); - return 1; + my($self, $col, @rest) = @_; + + $self->_declare_has_a(lc $col, @rest); + $self->_mk_inflated_column_accessor($col); + + return 1; } -sub get_has_a { +sub has_many { + my ($class, $rel, $f_class, $f_key, @rest) = @_; + return $class->next::method( + $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::method(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::method(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::method(lc($set), @rest); } sub get_column { my ($class, $get, @rest) = @_; - return $class->NEXT::ACTUAL::get_column(lc($get), @rest); + return $class->next::method(lc($get), @rest); } sub set_column { my ($class, $set, @rest) = @_; - return $class->NEXT::ACTUAL::set_column(lc($set), @rest); + return $class->next::method(lc($set), @rest); } sub store_column { my ($class, $set, @rest) = @_; - return $class->NEXT::ACTUAL::store_column(lc($set), @rest); + return $class->next::method(lc($set), @rest); } sub find_column { my ($class, $col) = @_; - return $class->NEXT::ACTUAL::find_column(lc($col)); + return $class->next::method(lc($col)); } -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); -} +# _build_query +# +# Build a query hash for find, et al. Overrides Retrieve::_build_query. -sub _cond_key { - my ($class, $attrs, $key, @rest) = @_; - return $class->NEXT::ACTUAL::_cond_key($attrs, lc($key), @rest); +sub _build_query { + my ($self, $query) = @_; + + my %new_query; + $new_query{lc $_} = $query->{$_} for keys %$query; + + return \%new_query; } -sub _cond_value { - my ($class, $attrs, $key, @rest) = @_; - return $class->NEXT::ACTUAL::_cond_value($attrs, lc($key), @rest); +sub _deploy_accessor { + my($class, $name, $accessor) = @_; + + return if $class->_has_custom_accessor($name); + + $class->next::method(lc $name => $accessor); + return $class->next::method($name => $accessor); } + sub new { my ($class, $attrs, @rest) = @_; my %att; $att{lc $_} = $attrs->{$_} for keys %$attrs; - return $class->NEXT::ACTUAL::new(\%att, @rest); + return $class->next::method(\%att, @rest); } 1;