column_accessor_map implementation
Robert Buels [Sat, 14 Aug 2010 16:08:08 +0000 (09:08 -0700)]
Changes
lib/DBIx/Class/Schema/Loader/Base.pm
t/lib/dbixcsl_common_tests.pm

diff --git a/Changes b/Changes
index e3c4941..72bbde4 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - added column_accessor_map option
         - Preserve relationship names when redumping and another FK is added
           (RT#62424)
         - Remove resultset_components as ResultSetManager is deprecated
index 0f3aa0c..6754b0e 100644 (file)
@@ -39,6 +39,7 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 skip_relationships
                                 skip_load_external
                                 moniker_map
+                                column_accessor_map
                                 custom_column_info
                                 inflect_singular
                                 inflect_plural
@@ -305,6 +306,22 @@ together. Examples:
     stations_visited | StationVisited
     routeChange      | RouteChange
 
+=head2 column_accessor_map
+
+Same as moniker_map, but for column accessor names.  If a coderef is
+passed, the code is called with arguments of
+
+   the name of the column in the underlying database,
+   default accessor name that DBICSL would ordinarily give this column,
+   {
+      table_class     => name of the DBIC class we are building,
+      table_moniker   => calculated moniker for this table (after moniker_map if present),
+      table_name      => name of the database table,
+      full_table_name => schema-qualified name of the database table (RDBMS specific),
+      schema_class    => name of the schema class we are building,
+      column_info     => hashref of column info (data_type, is_nullable, etc),
+    }
+
 =head2 inflect_plural
 
 Just like L</moniker_map> above (can be hash/code-ref, falls back to default
@@ -1582,12 +1599,57 @@ EOF
             }
         }
     }
+
+    # FIXME: it appears that this method should also check that the
+    # default accessor (i.e. the column name itself) is not colliding
+    # with any of these methods
 }
 
-sub _make_column_accessor_name {
-    my ($self, $column_name) = @_;
+# use the same logic to run moniker_map, column_accessor_map, and
+# relationship_name_map
+sub _run_user_map {
+    my ( $self, $map, $default_code, $ident, @extra ) = @_;
+
+    my $default_ident = $default_code->( $ident, @extra );
+    my $new_ident;
+    if( $map && ref $map eq 'HASH' ) {
+        $new_ident = $map->{ $ident };
+    }
+    elsif( $map && ref $map eq 'CODE' ) {
+        $new_ident = $map->( $ident, $default_ident, @extra );
+    }
+
+    $new_ident ||= $default_ident;
+
+    return $new_ident;
+}
+
+sub _default_column_accessor_name {
+    my ( $self, $column_name ) = @_;
+
+    my $accessor_name = $column_name;
+    $accessor_name =~ s/\W+/_/g;
+
+    # for backcompat
+    if( ($self->naming->{column_accessors}||'') =~ /(\d+)/ && $1 < 7 ) {
+        # older naming just lc'd the col accessor and that's all.
+        return lc $accessor_name;
+    }
 
     return join '_', map lc, split_name $column_name;
+
+}
+sub _make_column_accessor_name {
+    my ($self, $column_name, $column_context_info ) = @_;
+
+    my $accessor = $self->_run_user_map(
+        $self->column_accessor_map,
+        sub { $self->_default_column_accessor_name( shift ) },
+        $column_name,
+        $column_context_info,
+       );
+
+    return $accessor;
 }
 
 # Set up metadata (cols, pks, etc)
@@ -1614,34 +1676,33 @@ sub _setup_src_meta {
 
     $self->_dbic_stmt($table_class, 'table', $full_table_name);
 
-    my $cols = $self->_table_columns($table);
+    my $cols     = $self->_table_columns($table);
     my $col_info = $self->__columns_info_for($table);
 
+    ### generate all the column accessor names
     while (my ($col, $info) = each %$col_info) {
-        if ($col =~ /\W/) {
-            ($info->{accessor} = $col) =~ s/\W+/_/g;
-        }
-    }
+        # hashref of other info that could be used by
+        # user-defined accessor map functions
+        my $context = {
+            table_class     => $table_class,
+            table_moniker   => $table_moniker,
+            table_name      => $table_name,
+            full_table_name => $full_table_name,
+            schema_class    => $schema_class,
+            column_info     => $info,
+        };
 
-    if ($self->preserve_case) {
-        while (my ($col, $info) = each %$col_info) {
-            if ($col ne lc($col)) {
-                if ((not exists $self->naming->{column_accessors}) || (($self->naming->{column_accessors} =~ /(\d+)/)[0] >= 7)) {
-                    $info->{accessor} = $self->_make_column_accessor_name($info->{accessor} || $col);
-                }
-                else {
-                    $info->{accessor} = lc($info->{accessor} || $col);
-                }
-            }
-        }
-    }
-    else {
-        # XXX this needs to go away
-        $col_info = { map { lc($_), $col_info->{$_} } keys %$col_info };
+        $info->{accessor} = $self->_make_column_accessor_name( $col, $context );
     }
 
     $self->_resolve_col_accessor_collisions($full_table_name, $col_info);
 
+    # prune any redundant accessor names
+    while (my ($col, $info) = each %$col_info) {
+        no warnings 'uninitialized';
+        delete $info->{accessor} if $info->{accessor} eq $col;
+    }
+
     my $fks = $self->_table_fk_info($table);
 
     foreach my $fkdef (@$fks) {
@@ -1735,18 +1796,11 @@ sub _default_table2moniker {
 sub _table2moniker {
     my ( $self, $table ) = @_;
 
-    my $moniker;
-
-    if( ref $self->moniker_map eq 'HASH' ) {
-        $moniker = $self->moniker_map->{$table};
-    }
-    elsif( ref $self->moniker_map eq 'CODE' ) {
-        $moniker = $self->moniker_map->($table);
-    }
-
-    $moniker ||= $self->_default_table2moniker($table);
-
-    return $moniker;
+    $self->_run_user_map(
+        $self->moniker_map,
+        sub { $self->_default_table2moniker( shift ) },
+        $table
+       );
 }
 
 sub _load_relationships {
index d3b87f7..3503ebf 100644 (file)
@@ -94,7 +94,12 @@ sub run_tests {
 
     my $extra_count = $self->{extra}{count} || 0;
 
-    plan tests => @connect_info * (181 + $extra_count + ($self->{data_type_tests}{test_count} || 0));
+    my $column_accessor_map_tests = 5;
+    my $num_rescans = 5;
+    $num_rescans-- if $self->{vendor} eq 'sybase';
+
+    plan tests => @connect_info *
+        (182 + $num_rescans * $column_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];
@@ -203,6 +208,7 @@ sub setup_schema {
         datetime_locale         => 'de_DE',
         use_moose               => $ENV{SCHEMA_LOADER_TESTS_USE_MOOSE},
         col_collision_map       => { '^(can)\z' => 'caught_collision_%s' },
+        column_accessor_map     => \&test_column_accessor_map,
         %{ $self->{loader_options} || {} },
     );
 
@@ -594,6 +600,9 @@ sub test_schema {
         my $rs_rel4 = $obj3->search_related('loader_test4zes');
         isa_ok( $rs_rel4->first, $class4);
 
+        is( $class4->column_info('crumb_crisp_coating')->{accessor},  'trivet',
+            'column_accessor_map is being run' );
+
         # check rel naming with prepositions
         ok ($rsobj4->result_source->has_relationship('loader_test5s_to'),
             "rel with preposition 'to' pluralized correctly");
@@ -1238,6 +1247,7 @@ sub create {
                 id INTEGER NOT NULL PRIMARY KEY,
                 fkid INTEGER NOT NULL,
                 dat VARCHAR(32),
+                crumb_crisp_coating VARCHAR(32) $self->{null},
                 FOREIGN KEY( fkid ) REFERENCES loader_test3 (id)
             ) $self->{innodb}
         },
@@ -1859,6 +1869,20 @@ sub rescan_without_warnings {
     return $conn->rescan;
 }
 
+sub test_column_accessor_map {
+    my ( $column_name, $default_name, $context ) = @_;
+    if( $column_name eq 'crumb_crisp_coating' ) {
+
+        is( $default_name, 'crumb_crisp_coating', 'column_accessor_map was passed the default name' );
+        ok( $context->{$_}, "column_accessor_map func was passed the $_" )
+            for qw( table_name table_class table_moniker schema_class );
+
+        return 'trivet';
+    } else {
+        return $default_name;
+    }
+}
+
 sub DESTROY {
     my $self = shift;
     unless ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {