X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FBase.pm;h=c35226c57dcd3a8363d20779db1dd0fb60294f6c;hb=a7116285a72cb974e5e1848b8f202981b0106d98;hp=66847c3ed2b53012106d86e1511f157fe1ce0ed5;hpb=57a9fc92e7f892fa0bf37a537ec835000d087c85;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 66847c3..c35226c 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -22,6 +22,7 @@ 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';
@@ -85,6 +86,7 @@ __PACKAGE__->mk_group_accessors('simple', qw/
                                 pod_comment_spillover_length
                                 preserve_case
                                 col_collision_map
+                                rel_collision_map
                                 real_dump_directory
                                 datetime_undef_if_invalid
 /);
@@ -516,6 +518,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
@@ -1008,7 +1018,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 +1230,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 +1353,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 +1365,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 +1414,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;
@@ -1560,37 +1576,46 @@ sub _make_src_class {
     $self->_inject($table_class, @{$self->additional_base_classes});
 }
 
-sub _resolve_col_accessor_collisions {
-    my ($self, $table, $col_info) = @_;
+{
+    my %result_methods;
 
-    my $base       = $self->result_base_class || 'DBIx::Class::Core';
-    my @components = map "DBIx::Class::$_", @{ $self->components || [] };
+    sub _is_result_class_method {
+        my ($self, $name) = @_;
 
-    my $table_name = ref $table ? $$table : $table;
+        %result_methods || do {
+            my @methods;
+            my $base       = $self->result_base_class || 'DBIx::Class::Core';
+            my @components = map { /^\+/ ? substr($_,1) : "DBIx::Class::$_" } @{ $self->components || [] };
 
-    my @methods;
+            for my $class ($base, @components, $self->use_moose ? 'Moose::Object' : ()) {
+                load_class $class;
 
-    for my $class ($base, @components, $self->use_moose ? 'Moose::Object' : ()) {
-        eval "require ${class};";
-        die $@ if $@;
+                push @methods, @{ Class::Inspector->methods($class) || [] };
+            }
 
-        push @methods, @{ Class::Inspector->methods($class) || [] };
-    }
+            push @methods, @{ Class::Inspector->methods('UNIVERSAL') };
 
-    push @methods, @{ Class::Inspector->methods('UNIVERSAL') };
+            @result_methods{@methods} = ();
 
-    my %methods;
-    @methods{@methods} = ();
+            # futureproof meta
+            $result_methods{meta} = undef;
+        };
 
-    # futureproof meta
-    $methods{meta} = undef;
+        return exists $result_methods{$name};
+    }
+}
+
+sub _resolve_col_accessor_collisions {
+    my ($self, $table, $col_info) = @_;
+
+    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)) {
             my $mapped = 0;
 
             if (my $map = $self->col_collision_map) {
@@ -1604,7 +1629,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;
@@ -2079,6 +2104,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>