From: Michael G Schwern Date: Fri, 14 Mar 2008 01:41:32 +0000 (+0000) Subject: Move the code to create accessors out of ColumnCase and into ColumnGroups. X-Git-Tag: v0.08240~523 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8da46543004ecb546d27b1cc40450d7160e8178f;hp=03dc7a51297ef94935ec776ee35421a1e131fdbb;p=dbsrgits%2FDBIx-Class.git Move the code to create accessors out of ColumnCase and into ColumnGroups. This allows one to remove ColumnCase without effecting other features. --- diff --git a/lib/DBIx/Class/CDBICompat/ColumnCase.pm b/lib/DBIx/Class/CDBICompat/ColumnCase.pm index 0f847db..c1a1cd3 100644 --- a/lib/DBIx/Class/CDBICompat/ColumnCase.pm +++ b/lib/DBIx/Class/CDBICompat/ColumnCase.pm @@ -79,72 +79,16 @@ sub _build_query { return \%new_query; } +sub _deploy_accessor { + my($class, $name, $accessor) = @_; -# CDBI will never overwrite an accessor, but it only uses one -# accessor for all column types. DBIC uses many different -# accessor types so, for example, if you declare a column() -# and then a has_a() for that same column it must overwrite. -# -# To make this work CDBICompat has decide if an accessor -# method was put there by itself and only then overwrite. -{ - my %our_accessors; - - sub _has_custom_accessor { - my($class, $name) = @_; - - no strict 'refs'; - my $existing_accessor = *{$class .'::'. $name}{CODE}; - return $existing_accessor && !$our_accessors{$existing_accessor}; - } - - sub _deploy_accessor { - my($class, $name, $accessor) = @_; - - return if $class->_has_custom_accessor($name); - - for my $name ($name, lc $name) { - no strict 'refs'; - no warnings 'redefine'; - *{$class .'::'. $name} = $accessor; - } - - $our_accessors{$accessor}++; - - return 1; - } -} - -sub _mk_group_accessors { - my ($class, $type, $group, @fields) = @_; - - # So we don't have to do lots of lookups inside the loop. - my $maker = $class->can($type) unless ref $type; - - # warn "$class $type $group\n"; - foreach my $field (@fields) { - if( $field eq 'DESTROY' ) { - carp("Having a data accessor named DESTROY in ". - "'$class' is unwise."); - } + return if $class->_has_custom_accessor($name); - my $name = $field; - - ($name, $field) = @$field if ref $field; - - my $accessor = $class->$maker($group, $field); - my $alias = "_${name}_accessor"; - - # warn " $field $alias\n"; - { - no strict 'refs'; - - $class->_deploy_accessor($name, $accessor); - $class->_deploy_accessor($alias, $accessor); - } - } + $class->next::method(lc $name => $accessor); + return $class->next::method($name => $accessor); } + sub new { my ($class, $attrs, @rest) = @_; my %att; diff --git a/lib/DBIx/Class/CDBICompat/ColumnGroups.pm b/lib/DBIx/Class/CDBICompat/ColumnGroups.pm index 51a40f9..fa87ac1 100644 --- a/lib/DBIx/Class/CDBICompat/ColumnGroups.pm +++ b/lib/DBIx/Class/CDBICompat/ColumnGroups.pm @@ -55,6 +55,71 @@ sub _register_column_group { $class->_column_groups($groups); } +# CDBI will never overwrite an accessor, but it only uses one +# accessor for all column types. DBIC uses many different +# accessor types so, for example, if you declare a column() +# and then a has_a() for that same column it must overwrite. +# +# To make this work CDBICompat has decide if an accessor +# method was put there by itself and only then overwrite. +{ + my %our_accessors; + + sub _has_custom_accessor { + my($class, $name) = @_; + + no strict 'refs'; + my $existing_accessor = *{$class .'::'. $name}{CODE}; + return $existing_accessor && !$our_accessors{$existing_accessor}; + } + + sub _deploy_accessor { + my($class, $name, $accessor) = @_; + + return if $class->_has_custom_accessor($name); + + { + no strict 'refs'; + no warnings 'redefine'; + *{$class .'::'. $name} = $accessor; + } + + $our_accessors{$accessor}++; + + return 1; + } +} + +sub _mk_group_accessors { + my ($class, $type, $group, @fields) = @_; + + # So we don't have to do lots of lookups inside the loop. + my $maker = $class->can($type) unless ref $type; + + # warn "$class $type $group\n"; + foreach my $field (@fields) { + if( $field eq 'DESTROY' ) { + carp("Having a data accessor named DESTROY in ". + "'$class' is unwise."); + } + + my $name = $field; + + ($name, $field) = @$field if ref $field; + + my $accessor = $class->$maker($group, $field); + my $alias = "_${name}_accessor"; + + # warn " $field $alias\n"; + { + no strict 'refs'; + + $class->_deploy_accessor($name, $accessor); + $class->_deploy_accessor($alias, $accessor); + } + } +} + sub all_columns { return shift->result_source_instance->columns; } sub primary_column {