handle "use warnings FATAL => 'all' and set use_namespaces=1 for dynamic schemas...
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / Base.pm
index da225f2..969ed30 100644 (file)
@@ -18,14 +18,13 @@ use Class::Unload;
 use Class::Inspector ();
 use Scalar::Util 'looks_like_number';
 use File::Slurp 'slurp';
-use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_without_redefine_warnings/;
+use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_package_without_redefine_warnings class_path/;
 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
 use Try::Tiny;
 use DBIx::Class ();
-use Class::Load 'load_class';
 use namespace::clean;
 
-our $VERSION = '0.07003';
+our $VERSION = '0.07010';
 
 __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 schema
@@ -40,7 +39,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
@@ -88,6 +87,7 @@ __PACKAGE__->mk_group_accessors('simple', qw/
                                 col_collision_map
                                 rel_collision_map
                                 real_dump_directory
+                                result_component_map
                                 datetime_undef_if_invalid
                                 _result_class_methods
 /);
@@ -310,7 +310,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
@@ -366,6 +366,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
@@ -564,6 +580,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
@@ -593,6 +613,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",
@@ -681,8 +713,6 @@ Dynamic schema detected, will run in 0.04006 mode.
 Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
 to disable this warning.
 
-Also consider setting 'use_namespaces => 1' if/when upgrading.
-
 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
 details.
 EOF
@@ -694,6 +724,11 @@ EOF
         $self->naming->{relationships} ||= 'v4';
         $self->naming->{monikers}      ||= 'v4';
 
+        if ((not defined $self->use_namespaces)
+            && $self->naming->{monikers} ne 'v4') {
+            $self->use_namespaces(1);
+        }
+
         if ($self->use_namespaces) {
             $self->_upgrading_from_load_classes(1);
         }
@@ -786,32 +821,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) = @_;
 
@@ -826,20 +880,10 @@ sub _find_file_in_inc {
     return;
 }
 
-sub _class_path {
-    my ($self, $class) = @_;
-
-    my $class_path = $class;
-    $class_path =~ s{::}{/}g;
-    $class_path .= '.pm';
-
-    return $class_path;
-}
-
 sub _find_class_in_inc {
     my ($self, $class) = @_;
 
-    return $self->_find_file_in_inc($self->_class_path($class));
+    return $self->_find_file_in_inc(class_path($class));
 }
 
 sub _rewriting {
@@ -893,7 +937,7 @@ sub _load_external {
         my $code = $self->_rewrite_old_classnames(scalar slurp $real_inc_path);
 
         if ($self->dynamic) { # load the class too
-            eval_without_redefine_warnings($code);
+            eval_package_without_redefine_warnings($class, $code);
         }
 
         $self->_ext_stmt($class,
@@ -934,7 +978,7 @@ been used by an older version of the Loader.
 * PLEASE RENAME THIS CLASS: from '$old_class' to '$class', as that is the
 new name of the Result.
 EOF
-            eval_without_redefine_warnings($code);
+            eval_package_without_redefine_warnings($class, $code);
         }
 
         chomp $code;
@@ -1019,7 +1063,7 @@ sub _relbuilder {
             ->{ $self->naming->{relationships}};
 
         my $relbuilder_class = 'DBIx::Class::Schema::Loader::RelBuilder'.$relbuilder_suff;
-        load_class $relbuilder_class;
+        $self->ensure_class_loaded($relbuilder_class);
         $relbuilder_class->new( $self );
 
     };
@@ -1161,12 +1205,10 @@ sub _moose_metaclass {
 sub _reload_class {
     my ($self, $class) = @_;
 
-    my $class_path = $self->_class_path($class);
-    delete $INC{ $class_path };
+    delete $INC{ +class_path($class) };
 
-# kill redefined warnings
     try {
-        eval_without_redefine_warnings ("require $class");
+        eval_package_without_redefine_warnings ($class, "require $class");
     }
     catch {
         my $source = slurp $self->_get_dump_filename($class);
@@ -1570,23 +1612,36 @@ 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 _is_result_class_method {
-    my ($self, $name) = @_;
+    my ($self, $name, $table_name) = @_;
+
+    my $table_moniker = $table_name ? $self->_table2moniker($table_name) : '';
 
     if (not $self->_result_class_methods) {
         my (@methods, %methods);
         my $base       = $self->result_base_class || 'DBIx::Class::Core';
-        my @components = map { /^\+/ ? substr($_,1) : "DBIx::Class::$_" } @{ $self->components || [] };
+
+        my @components = @{ $self->components || [] };
+
+        push @components, @{ $self->result_component_map->{$table_moniker} }
+            if exists $self->result_component_map->{$table_moniker};
+
+        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;
+            $self->ensure_class_loaded($class);
 
             push @methods, @{ Class::Inspector->methods($class) || [] };
         }
@@ -1595,9 +1650,6 @@ sub _is_result_class_method {
 
         @methods{@methods} = ();
 
-        # futureproof meta
-        $methods{meta} = undef;
-
         $self->_result_class_methods(\%methods);
     }
     my $result_methods = $self->_result_class_methods;
@@ -1615,7 +1667,7 @@ sub _resolve_col_accessor_collisions {
 
         next if $accessor eq 'id'; # special case (very common column)
 
-        if ($self->_is_result_class_method($accessor)) {
+        if ($self->_is_result_class_method($accessor, $table_name)) {
             my $mapped = 0;
 
             if (my $map = $self->col_collision_map) {
@@ -1638,7 +1690,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 ) = @_;
@@ -1676,7 +1728,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,