X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FCDBICompat%2FColumnCase.pm;h=56bef61b3fb24ecdc3587459197c66cb59074b4c;hb=5e0eea3522876a30453af24097507198bbbc9409;hp=e5c23d87af18ba9ac0e5d8bfd561f47228e45d54;hpb=510ca9120ab2fea50a0852ee4ed6a13735ed7ebc;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/CDBICompat/ColumnCase.pm b/lib/DBIx/Class/CDBICompat/ColumnCase.pm index e5c23d8..56bef61 100644 --- a/lib/DBIx/Class/CDBICompat/ColumnCase.pm +++ b/lib/DBIx/Class/CDBICompat/ColumnCase.pm @@ -1,45 +1,106 @@ -package DBIx::Class::CDBICompat::ColumnCase; +package # hide from PAUSE + DBIx::Class::CDBICompat::ColumnCase; use strict; use warnings; -use NEXT; + +use base 'DBIx::Class'; sub _register_column_group { my ($class, $group, @cols) = @_; - return $class->NEXT::_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::_register_columns(map lc, @cols); + return $class->result_source_instance->add_columns(map lc, @cols); +} + +sub has_a { + my($self, $col, @rest) = @_; + + $self->_declare_has_a(lc $col, @rest); + $self->_mk_inflated_column_accessor($col); + + return 1; +} + +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::method(lc($get), @rest); +} + +sub store_inflated_column { + my ($class, $set, @rest) = @_; + return $class->next::method(lc($set), @rest); +} + +sub set_inflated_column { + my ($class, $set, @rest) = @_; + return $class->next::method(lc($set), @rest); } sub get_column { my ($class, $get, @rest) = @_; - return $class->NEXT::get_column(lc $get, @rest); + return $class->next::method(lc($get), @rest); } sub set_column { my ($class, $set, @rest) = @_; - return $class->NEXT::set_column(lc $set, @rest); + return $class->next::method(lc($set), @rest); } sub store_column { my ($class, $set, @rest) = @_; - return $class->NEXT::store_column(lc $set, @rest); + return $class->next::method(lc($set), @rest); } sub find_column { my ($class, $col) = @_; - return $class->NEXT::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::_mk_group_accessors($type, $group, keys %fields); +# _build_query +# +# Build a query hash for find, et al. Overrides Retrieve::_build_query. + +sub _build_query { + my ($self, $query) = @_; + + my %new_query; + $new_query{lc $_} = $query->{$_} for keys %$query; + + return \%new_query; +} + +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::method(\%att, @rest); } 1;