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=3f49f23d40454de26419cdbf0890ebed3162f3e3;hpb=ec77fadc80e2ce78abf208f2126b74e5445bec22;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/CDBICompat/ColumnCase.pm b/lib/DBIx/Class/CDBICompat/ColumnCase.pm index 3f49f23..56bef61 100644 --- a/lib/DBIx/Class/CDBICompat/ColumnCase.pm +++ b/lib/DBIx/Class/CDBICompat/ColumnCase.pm @@ -1,38 +1,41 @@ -package DBIx::Class::CDBICompat::ColumnCase; +package # hide from PAUSE + DBIx::Class::CDBICompat::ColumnCase; use strict; use warnings; -use base qw/DBIx::Class/; +use base 'DBIx::Class'; sub _register_column_group { my ($class, $group, @cols) = @_; return $class->next::method($group => map lc, @cols); } -sub _register_columns { - my ($class, @cols) = @_; - return $class->next::method(map lc, @cols); -} - sub add_columns { my ($class, @cols) = @_; - $class->table_instance->add_columns(map lc, @cols); - $class->_mk_column_accessors(@cols); + return $class->result_source_instance->add_columns(map lc, @cols); } sub has_a { - my ($class, $col, @rest) = @_; - $class->next::method(lc($col), @rest); - $class->mk_group_accessors('inflated_column' => $col); - return 1; + 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); + return $class->next::method( + $rel, + $f_class, + (ref($f_key) ? + $f_key : + lc($f_key||'') + ), + @rest + ); } sub get_inflated_column { @@ -70,30 +73,29 @@ sub find_column { return $class->next::method(lc($col)); } -sub _mk_group_accessors { - my ($class, $type, $group, @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::method($type, $group, - @fields, @extra); -} +# _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::method($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::method($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;