Add support for nested hashref form of col_accessor_map

Thanks to @davorg++ for spotting the omission.

diff --git a/Changes b/Changes
index d71d1e0..de49c9c 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
         - Fix Pg date/time types with zero fractional second digits
+        - Add support for nested hashref form of col_accessor_map
 
 0.07043  2015-05-13
         - Fix many_to_many bridges with overlapping foreign keys

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 57b6f1c..1ad8474 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -20,6 +20,7 @@ use File::Temp ();
 use Class::Unload;
 use Class::Inspector ();
 use Scalar::Util 'looks_like_number';
+use DBIx::Class::Schema::Loader::Column;
 use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_package_without_redefine_warnings class_path slurp_file sigwarn_silencer firstidx uniq/;
 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
 use Try::Tiny;
@@ -657,10 +658,12 @@ L</moniker_map> takes precedence over this.
 
 =head2 col_accessor_map
 
-Same as moniker_map, but for column accessor names.  If a coderef is
+Same as moniker_map, but for column accessor names.  The nested
+hashref form is traversed according to L</moniker_parts>, with an
+extra level at the bottom for the column name.  If a coderef is
 passed, the code is called with arguments of
 
-    the name of the column in the underlying database,
+    the DBIx::Class::Schema::Loader::Column object for the column,
     default accessor name that DBICSL would ordinarily give this column,
     {
         table_class     => name of the DBIC class we are building,
@@ -672,8 +675,9 @@ passed, the code is called with arguments of
     }
     coderef ref that can be called with a hashref map
 
-the L<table object|DBIx::Class::Schema::Loader::Table> stringifies to the
-unqualified table name.
+The L<column|DBIx::Class::Schema::Loader::Table> and
+L<table|DBIx::Class::Schema::Loader::Table> objects stringify to their
+unqualified names.
 
 =head2 rel_name_map
 
@@ -2597,8 +2601,12 @@ sub _setup_src_meta {
             schema_class    => $schema_class,
             column_info     => $info,
         };
+        my $col_obj = DBIx::Class::Schema::Loader::Column->new(
+            table => $table,
+            name  => $col,
+        );
 
-        $info->{accessor} = $self->_make_column_accessor_name( $col, $context );
+        $info->{accessor} = $self->_make_column_accessor_name( $col_obj, $context );
     }
 
     $self->_resolve_col_accessor_collisions($table, $col_info);

diff --git a/lib/DBIx/Class/Schema/Loader/Column.pm b/lib/DBIx/Class/Schema/Loader/Column.pm
new file mode 100644 (file)
index 0000000..bbb016b
--- /dev/null
+++ b/lib/DBIx/Class/Schema/Loader/Column.pm
@@ -0,0 +1,67 @@
+package DBIx::Class::Schema::Loader::Column;
+
+use strict;
+use warnings;
+use base 'Class::Accessor::Grouped';
+use mro 'c3';
+use Carp::Clan qw/^DBIx::Class/;
+use Scalar::Util 'weaken';
+use namespace::clean;
+
+=head1 NAME
+
+DBIx::Class::Schema::Loader::Column - Class for Columns in
+L<DBIx::Class::Schema::Loader>
+
+=head1 DESCRIPTION
+
+Used for representing columns in
+L<DBIx::Class::Schema::Loader::Base/col_accessor_map>.
+
+Stringifies to L</name>, and arrayrefifies to the
+L<name_parts|DBIx::Class::Schema::Loader::Table/name_parts> of
+L</table> plus L</name>.
+
+=cut
+
+__PACKAGE__->mk_group_accessors(simple => qw/
+    table
+    name
+/);
+
+use overload
+    '""' => sub { $_[0]->name },
+    '@{}' => sub { [ @{$_[0]->table->name_parts}, $_[0]->name ] },
+    fallback => 1;
+
+=head1 METHODS
+
+=head2 new
+
+The constructor. Takes L</table> and L</name> key-value parameters.
+
+=cut
+
+sub new {
+    my $class = shift;
+
+    my $self = { @_ };
+    croak "table is required" unless ref $self->{table};
+
+    weaken $self->{table};
+
+    return bless $self, $class;
+}
+
+=head2 table
+
+The L</DBIx::Class::Schema::Loader::Table> object this column belongs to.
+Required parameter for L</new>
+
+=head2 name
+
+The name of the column. Required parameter for L</new>.
+
+=cut
+
+1;

diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index 15981df..94b8e5b 100644 (file)
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -122,7 +122,7 @@ sub run_tests {
     $num_rescans++ if $self->{vendor} eq 'Firebird';
 
     plan tests => @connect_info *
-        (232 + $num_rescans * $col_accessor_map_tests + $extra_count + ($self->{data_type_tests}{test_count} || 0));
+        (233 + $num_rescans * $col_accessor_map_tests + $extra_count + ($self->{data_type_tests}{test_count} || 0));
 
     foreach my $info_idx (0..$#connect_info) {
         my $info = $connect_info[$info_idx];
@@ -418,7 +418,7 @@ qr/\n__PACKAGE__->load_components\("TestSchemaComponent", "\+TestSchemaComponent
         'fully qualified schema component works';
 
     my @columns_lt2 = $class2->columns;
-    is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key can dbix_class_testcomponent dbix_class_testcomponentmap testcomponent_fqn meta test_role_method test_role_for_map_method crumb_crisp_coating/ ], "Column Ordering" );
+    is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key can dbix_class_testcomponent dbix_class_testcomponentmap testcomponent_fqn meta test_role_method test_role_for_map_method crumb_crisp_coating sticky_filling/ ], "Column Ordering" );
 
     is $class2->column_info('can')->{accessor}, 'caught_collision_can',
         'accessor for column name that conflicts with a UNIVERSAL method renamed based on col_collision_map';
@@ -622,6 +622,9 @@ qr/\n__PACKAGE__->load_components\("TestSchemaComponent", "\+TestSchemaComponent
     is( $class2->column_info('crumb_crisp_coating')->{accessor},  'trivet',
         'col_accessor_map is being run' );
 
+    is( $class2->column_info('sticky_filling')->{accessor},  'goo',
+        'multi-level hash col_accessor_map works' );
+
     is $class1->column_info('dat')->{is_nullable}, 0,
         'is_nullable=0 detection';
 
@@ -1581,7 +1584,7 @@ sub create {
         q{ INSERT INTO loader_test1s (dat) VALUES('baz') },
 
         # also test method collision
-        # crumb_crisp_coating is for col_accessor_map tests
+        # crumb_crisp_coating and sticky_filling are for col_accessor_map tests
         qq{
             CREATE TABLE loader_test2 (
                 id $self->{auto_inc_pk},
@@ -1596,6 +1599,7 @@ sub create {
                 test_role_method INTEGER $self->{null},
                 test_role_for_map_method INTEGER $self->{null},
                 crumb_crisp_coating VARCHAR(32) $self->{null},
+                sticky_filling VARCHAR(32) $self->{null},
                 UNIQUE (dat2, dat)
             ) $self->{innodb}
         },
@@ -2444,7 +2448,7 @@ sub rescan_without_warnings {
 }
 
 sub test_col_accessor_map {
-    my ( $column_name, $default_name, $context ) = @_;
+    my ( $column_name, $default_name, $context, $default_map ) = @_;
     if( lc($column_name) eq 'crumb_crisp_coating' ) {
 
         is( $default_name, 'crumb_crisp_coating', 'col_accessor_map was passed the default name' );
@@ -2453,7 +2457,11 @@ sub test_col_accessor_map {
 
         return 'trivet';
     } else {
-        return $default_name;
+        return $default_map->({
+            loader_test2 => {
+                sticky_filling => 'goo',
+            },
+        });
     }
 }