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=fe9084a327441c7037ec52e10e64be45d05e59a1;hpb=ea2e61bf5bb7187dc5e56513cd66c272d71d5074;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/CDBICompat/ColumnCase.pm b/lib/DBIx/Class/CDBICompat/ColumnCase.pm index fe9084a..56bef61 100644 --- a/lib/DBIx/Class/CDBICompat/ColumnCase.pm +++ b/lib/DBIx/Class/CDBICompat/ColumnCase.pm @@ -1,40 +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 { +sub get_inflated_column { my ($class, $get, @rest) = @_; - return $class->NEXT::get(lc $get, @rest); + return $class->next::method(lc($get), @rest); } -sub set { +sub store_inflated_column { my ($class, $set, @rest) = @_; - return $class->NEXT::set(lc $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::method(lc($get), @rest); +} + +sub set_column { + my ($class, $set, @rest) = @_; + return $class->next::method(lc($set), @rest); +} + +sub store_column { + my ($class, $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)); +} + +# _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 _mk_accessors { - my ($class, $type, @fields) = @_; - my %fields; - $fields{$_} = 1 for @fields, - map lc, grep { !defined &{"${class}::${_}"} } @fields; - return $class->NEXT::_mk_accessors($type, keys %fields); +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;