initialize result_component_map to empty hash if unset
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / Base.pm
index 66847c3..6eaaddc 100644 (file)
@@ -22,9 +22,10 @@ use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_withou
 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
 use Try::Tiny;
 use DBIx::Class ();
+use Class::Load 'load_class';
 use namespace::clean;
 
-our $VERSION = '0.07002';
+our $VERSION = '0.07010';
 
 __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 schema
@@ -39,7 +40,7 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 skip_relationships
                                 skip_load_external
                                 moniker_map
-                                column_accessor_map
+                                col_accessor_map
                                 custom_column_info
                                 inflect_singular
                                 inflect_plural
@@ -85,8 +86,11 @@ __PACKAGE__->mk_group_accessors('simple', qw/
                                 pod_comment_spillover_length
                                 preserve_case
                                 col_collision_map
+                                rel_collision_map
                                 real_dump_directory
+                                result_component_map
                                 datetime_undef_if_invalid
+                                _result_class_methods
 /);
 
 =head1 NAME
@@ -307,7 +311,7 @@ together. Examples:
     stations_visited | StationVisited
     routeChange      | RouteChange
 
-=head2 column_accessor_map
+=head2 col_accessor_map
 
 Same as moniker_map, but for column accessor names.  If a coderef is
 passed, the code is called with arguments of
@@ -363,6 +367,22 @@ List of additional components to be loaded into all of your table
 classes.  A good example would be
 L<InflateColumn::DateTime|DBIx::Class::InflateColumn::DateTime>
 
+=head2 result_component_map
+
+A hashref of moniker keys and component values.  Unlike C<components>, which loads the
+given components into every table class, this option allows you to load certain
+components for specified tables.  For example:
+
+  result_component_map => {
+      StationVisited => '+YourApp::Schema::Component::StationVisited',
+      RouteChange    => [
+                            '+YourApp::Schema::Component::RouteChange',
+                            'InflateColumn::DateTime',
+                        ],
+  }
+  
+You may use this in conjunction with C<components>.
+
 =head2 use_namespaces
 
 This is now the default, to go back to L<DBIx::Class::Schema/load_classes> pass
@@ -516,6 +536,14 @@ Examples:
 
     col_collision_map => { '(foo).*(bar)' => 'column_%s_%s' }
 
+=head2 rel_collision_map
+
+Works just like L</col_collision_map>, but for relationship names/accessors
+rather than column names/accessors.
+
+The default is to just append C<_rel> to the relationship name, see
+L</RELATIONSHIP NAME COLLISIONS>.
+
 =head1 METHODS
 
 None of these methods are intended for direct invocation by regular
@@ -553,6 +581,10 @@ by L<DBIx::Class::Schema::Loader>.
 sub new {
     my ( $class, %args ) = @_;
 
+    if (exists $args{column_accessor_map}) {
+        $args{col_accessor_map} = delete $args{column_accessor_map};
+    }
+
     my $self = { %args };
 
     # don't lose undef options
@@ -582,6 +614,18 @@ sub new {
 
     $self->_validate_class_args;
 
+    if ($self->result_component_map) {
+        my %rc_map = %{ $self->result_component_map };
+        foreach my $moniker (keys %rc_map) {
+            $rc_map{$moniker} = [ $rc_map{$moniker} ] unless ref $rc_map{$moniker};
+        }
+        $self->result_component_map(\%rc_map);
+    }
+    else {
+        $self->result_component_map({});
+    }
+    $self->_validate_result_component_map;
+
     if ($self->use_moose) {
         if (not DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose')) {
             die sprintf "You must install the following CPAN modules to enable the use_moose option: %s.\n",
@@ -775,32 +819,51 @@ EOF
 
 sub _validate_class_args {
     my $self = shift;
-    my $args = shift;
 
     foreach my $k (@CLASS_ARGS) {
         next unless $self->$k;
 
         my @classes = ref $self->$k eq 'ARRAY' ? @{ $self->$k } : $self->$k;
-        foreach my $c (@classes) {
-            # components default to being under the DBIx::Class namespace unless they
-            # are preceeded with a '+'
-            if ( $k =~ m/components$/ && $c !~ s/^\+// ) {
-                $c = 'DBIx::Class::' . $c;
-            }
+        $self->_validate_classes($k, \@classes);
+    }
+}
 
-            # 1 == installed, 0 == not installed, undef == invalid classname
-            my $installed = Class::Inspector->installed($c);
-            if ( defined($installed) ) {
-                if ( $installed == 0 ) {
-                    croak qq/$c, as specified in the loader option "$k", is not installed/;
-                }
-            } else {
-                croak qq/$c, as specified in the loader option "$k", is an invalid class name/;
+sub _validate_result_component_map {
+    my $self = shift;
+
+    my $map = $self->result_component_map;
+    return unless $map && ref $map eq 'HASH';
+
+    foreach my $classes (values %$map) {
+        $self->_validate_classes('result_component_map', [@$classes]);
+    }
+}
+
+sub _validate_classes {
+    my $self = shift;
+    my $key  = shift;
+    my $classes = shift;
+
+    foreach my $c (@$classes) {
+        # components default to being under the DBIx::Class namespace unless they
+        # are preceeded with a '+'
+        if ( $key =~ m/component/ && $c !~ s/^\+// ) {
+            $c = 'DBIx::Class::' . $c;
+        }
+
+        # 1 == installed, 0 == not installed, undef == invalid classname
+        my $installed = Class::Inspector->installed($c);
+        if ( defined($installed) ) {
+            if ( $installed == 0 ) {
+                croak qq/$c, as specified in the loader option "$key", is not installed/;
             }
+        } else {
+            croak qq/$c, as specified in the loader option "$key", is an invalid class name/;
         }
     }
 }
 
+
 sub _find_file_in_inc {
     my ($self, $file) = @_;
 
@@ -1008,7 +1071,7 @@ sub _relbuilder {
             ->{ $self->naming->{relationships}};
 
         my $relbuilder_class = 'DBIx::Class::Schema::Loader::RelBuilder'.$relbuilder_suff;
-        eval "require $relbuilder_class"; die $@ if $@;
+        load_class $relbuilder_class;
         $relbuilder_class->new( $self );
 
     };
@@ -1220,7 +1283,7 @@ sub _dump_to_dir {
         . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|;
 
     if ($self->use_moose) {
-        $schema_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends '$schema_base_class';\n\n|;
+        $schema_text.= qq|use Moose;\nuse namespace::autoclean;\nextends '$schema_base_class';\n\n|;
     }
     else {
         $schema_text .= qq|use strict;\nuse warnings;\n\nuse base '$schema_base_class';\n\n|;
@@ -1343,7 +1406,7 @@ sub _write_classfile {
         }
     }
 
-    $custom_content ||= $self->_default_custom_content;
+    $custom_content ||= $self->_default_custom_content($is_schema);
 
     # If upgrading to use_moose=1 replace default custom content with default Moose custom content.
     # If there is already custom content, which does not have the Moose content, add it.
@@ -1355,10 +1418,10 @@ sub _write_classfile {
         };
 
         if ($custom_content eq $non_moose_custom_content) {
-            $custom_content = $self->_default_custom_content;
+            $custom_content = $self->_default_custom_content($is_schema);
         }
-        elsif ($custom_content !~ /\Q@{[$self->_default_moose_custom_content]}\E/) {
-            $custom_content .= $self->_default_custom_content;
+        elsif ($custom_content !~ /\Q@{[$self->_default_moose_custom_content($is_schema)]}\E/) {
+            $custom_content .= $self->_default_custom_content($is_schema);
         }
     }
     elsif (defined $self->use_moose && $old_gen) {
@@ -1404,15 +1467,21 @@ sub _write_classfile {
 }
 
 sub _default_moose_custom_content {
-    return qq|\n__PACKAGE__->meta->make_immutable;|;
+    my ($self, $is_schema) = @_;
+
+    if (not $is_schema) {
+        return qq|\n__PACKAGE__->meta->make_immutable;|;
+    }
+    
+    return qq|\n__PACKAGE__->meta->make_immutable(inline_constructor => 0);|;
 }
 
 sub _default_custom_content {
-    my $self = shift;
+    my ($self, $is_schema) = @_;
     my $default = qq|\n\n# You can replace this text with custom|
          . qq| code or comments, and it will be preserved on regeneration|;
     if ($self->use_moose) {
-        $default .= $self->_default_moose_custom_content;
+        $default .= $self->_default_moose_custom_content($is_schema);
     }
     $default .= qq|\n1;\n|;
     return $default;
@@ -1553,44 +1622,65 @@ sub _make_src_class {
     $self->_use   ($table_class, @{$self->additional_classes});
     $self->_inject($table_class, @{$self->left_base_classes});
 
-    if (my @components = @{ $self->components }) {
-        $self->_dbic_stmt($table_class, 'load_components', @components);
-    }
+    my @components = @{ $self->components || [] };
+
+    push @components, @{ $self->result_component_map->{$table_moniker} }
+        if exists $self->result_component_map->{$table_moniker};
+
+    $self->_dbic_stmt($table_class, 'load_components', @components) if @components;
 
     $self->_inject($table_class, @{$self->additional_base_classes});
 }
 
-sub _resolve_col_accessor_collisions {
-    my ($self, $table, $col_info) = @_;
+sub _is_result_class_method {
+    my ($self, $name, $table_name) = @_;
 
-    my $base       = $self->result_base_class || 'DBIx::Class::Core';
-    my @components = map "DBIx::Class::$_", @{ $self->components || [] };
+    my $table_moniker = $table_name ? $self->_table2moniker($table_name) : '';
 
-    my $table_name = ref $table ? $$table : $table;
+    if (not $self->_result_class_methods) {
+        my (@methods, %methods);
+        my $base       = $self->result_base_class || 'DBIx::Class::Core';
 
-    my @methods;
+        my @components = @{ $self->components || [] };
 
-    for my $class ($base, @components, $self->use_moose ? 'Moose::Object' : ()) {
-        eval "require ${class};";
-        die $@ if $@;
+        push @components, @{ $self->result_component_map->{$table_moniker} }
+            if exists $self->result_component_map->{$table_moniker};
 
-        push @methods, @{ Class::Inspector->methods($class) || [] };
+        for my $c (@components) {
+            $c = $c =~ /^\+/ ? substr($c,1) : "DBIx::Class::$c";
+        }
+
+        for my $class ($base, @components, $self->use_moose ? 'Moose::Object' : ()) {
+            load_class $class;
+
+            push @methods, @{ Class::Inspector->methods($class) || [] };
+        }
+
+        push @methods, @{ Class::Inspector->methods('UNIVERSAL') };
+
+        @methods{@methods} = ();
+
+        # futureproof meta
+        $methods{meta} = undef;
+
+        $self->_result_class_methods(\%methods);
     }
+    my $result_methods = $self->_result_class_methods;
 
-    push @methods, @{ Class::Inspector->methods('UNIVERSAL') };
+    return exists $result_methods->{$name};
+}
 
-    my %methods;
-    @methods{@methods} = ();
+sub _resolve_col_accessor_collisions {
+    my ($self, $table, $col_info) = @_;
 
-    # futureproof meta
-    $methods{meta} = undef;
+    my $table_name = ref $table ? $$table : $table;
 
     while (my ($col, $info) = each %$col_info) {
         my $accessor = $info->{accessor} || $col;
 
         next if $accessor eq 'id'; # special case (very common column)
 
-        if (exists $methods{$accessor}) {
+        if ($self->_is_result_class_method($accessor, $table_name)) {
             my $mapped = 0;
 
             if (my $map = $self->col_collision_map) {
@@ -1604,7 +1694,7 @@ sub _resolve_col_accessor_collisions {
 
             if (not $mapped) {
                 warn <<"EOF";
-Column $col in table $table_name collides with an inherited method.
+Column '$col' in table '$table_name' collides with an inherited method.
 See "COLUMN ACCESSOR COLLISIONS" in perldoc DBIx::Class::Schema::Loader::Base .
 EOF
                 $info->{accessor} = undef;
@@ -1613,7 +1703,7 @@ EOF
     }
 }
 
-# use the same logic to run moniker_map, column_accessor_map, and
+# use the same logic to run moniker_map, col_accessor_map, and
 # relationship_name_map
 sub _run_user_map {
     my ( $self, $map, $default_code, $ident, @extra ) = @_;
@@ -1651,7 +1741,7 @@ sub _make_column_accessor_name {
     my ($self, $column_name, $column_context_info ) = @_;
 
     my $accessor = $self->_run_user_map(
-        $self->column_accessor_map,
+        $self->col_accessor_map,
         sub { $self->_default_column_accessor_name( shift ) },
         $column_name,
         $column_context_info,
@@ -2079,6 +2169,20 @@ below the md5:
 
 Another option is to use the L</col_collision_map> option.
 
+=head1 RELATIONSHIP NAME COLLISIONS
+
+In very rare cases, you may get a collision between a generated relationship
+name and a method in your Result class, for example if you have a foreign key
+called C<belongs_to>.
+
+This is a problem because relationship names are also relationship accessor
+methods in L<DBIx::Class>.
+
+The default behavior is to append C<_rel> to the relationship name and print
+out a warning that refers to this text.
+
+You can also control the renaming with the L</rel_collision_map> option.
+
 =head1 SEE ALSO
 
 L<DBIx::Class::Schema::Loader>