Add support for load_namespaces(lazy_load => 1, ...)

  All tests successful.
  Files=94, Tests=20844, 25 wallclock secs
  Result: PASS

  All database related tests was skipped when running this test suite.

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 1df1005..7bf0687 100644 (file)
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -101,6 +101,11 @@ All of the namespace and classname options are by default relative to
 the schema classname.  To specify a fully-qualified name, prefix it
 with a literal C<+>.  For example, C<+Other::NameSpace::Result>.
 
+Experimental: It is also possible to load the result source classes when they
+are requested by L</source>. Giving C<lazy_load> as an argument to
+L</load_namespaces> will enable this. This will decrease start up time if you
+have large schemas.
+
 =head3 Warnings
 
 You will be warned if ResultSet classes are discovered for which there
@@ -136,6 +141,12 @@ L</resultset_class> to some other class, you will be warned like this:
     resultset_namespace => '+Another::Place::RSets',
   );
 
+  # Postpone loading of result sources
+  My::Schema->load_namespaces(
+    lazy_load => 1,
+    # ...
+  );
+
 To search multiple namespaces for either Result or ResultSet classes,
 use an arrayref of namespaces for that option.  In the case that the
 same result (or resultset) class exists in multiple namespaces, later
@@ -211,6 +222,7 @@ sub load_namespaces {
   my $result_namespace = delete $args{result_namespace} || 'Result';
   my $resultset_namespace = delete $args{resultset_namespace} || 'ResultSet';
   my $default_resultset_class = delete $args{default_resultset_class};
+  my $lazy_load = delete $args{lazy_load};
 
   $class->throw_exception('load_namespaces: unknown option(s): '
     . join(q{,}, map { qq{'$_'} } keys %args))
@@ -232,7 +244,14 @@ sub load_namespaces {
   my %results = $class->_map_namespaces(@$result_namespace);
   my %resultsets = $class->_map_namespaces(@$resultset_namespace);
 
+  if($lazy_load) {
+    # abusing the attribute to store $moniker => [@classnames] information
+    $class->class_mappings->{$_} = [ $results{$_}, $resultsets{$_} || $default_resultset_class ] for keys %results;
+    return;
+  }
+
   my @to_register;
+
   {
     no warnings qw/redefine/;
     local *Class::C3::reinitialize = sub { } if DBIx::Class::_ENV_::OLD_MRO;
@@ -593,10 +612,31 @@ sub source {
   my $sreg = $self->source_registrations;
   return $sreg->{$source_name} if exists $sreg->{$source_name};
 
-  # if we got here, they probably passed a full class name
+  # if we got here, they probably passed a full class name or something to lazy load
   my $mapped = $self->class_mappings->{$source_name};
-  $self->throw_exception("Can't find source for ${source_name}")
-    unless $mapped && exists $sreg->{$mapped};
+
+  # if we got here, they probably passed a full class name
+  if(!$mapped) {
+    my $last;
+    for(%{ $self->class_mappings }) {
+      next unless ref $_ and $_->[0] eq $source_name;
+      $mapped = $_;
+      last;
+    }
+  }
+  if(ref $mapped eq 'ARRAY') {
+    my $source_class = $mapped->[0];
+    $self->ensure_class_loaded($source_class);
+    $source_class->resultset_class($mapped->[1]) if $mapped->[1];
+    $self->register_class($source_name, $source_class);
+    $mapped = $source_name;
+    $sreg = $self->source_registrations; # jhthorsen: No idea why data is copied all over the place instead of just changing the ref...
+  }
+
+  if(!$mapped or !exists $sreg->{$mapped}) {
+    $self->throw_exception("Can't find source for ${source_name}");
+  }
+
   return $sreg->{$mapped};
 }
 
@@ -1013,7 +1053,7 @@ sub clone {
   };
   bless $clone, (ref $self || $self);
 
-  $clone->$_(undef) for qw/class_mappings source_registrations storage/;
+  $clone->$_(undef) for qw/class_mappings source_registrations storage /;
 
   $clone->_copy_state_from($self);
 

diff --git a/t/39load_namespaces_lazy.t b/t/39load_namespaces_lazy.t
new file mode 100644 (file)
index 0000000..168ba33
--- /dev/null
+++ b/t/39load_namespaces_lazy.t
@@ -0,0 +1,34 @@
+use strict;
+use warnings;
+use Test::More;
+
+use lib qw(t/lib);
+use DBICTest; # do not remove even though it is not used
+
+plan tests => 9;
+
+my $warnings;
+eval {
+    local $SIG{__WARN__} = sub { $warnings .= shift };
+    package DBICNSTest;
+    use base qw/DBIx::Class::Schema/;
+    __PACKAGE__->load_namespaces(lazy_load => 1, default_resultset_class => 'RSBase');
+};
+ok !$@ or diag $@;
+ok !$warnings, 'no warnings';
+
+is int DBICNSTest->sources, 0, 'zero sources loaded';
+
+my $source_b = DBICNSTest->source('R');
+isa_ok($source_b, 'DBIx::Class::ResultSource::Table');
+my $rset_b   = DBICNSTest->resultset('R');
+isa_ok($rset_b, 'DBICNSTest::RSBase');
+ok ref $source_b->related_source('a'), 'managed to load related';
+
+my $source_a = DBICNSTest->source('A');
+isa_ok($source_a, 'DBIx::Class::ResultSource::Table');
+my $rset_a   = DBICNSTest->resultset('A');
+isa_ok($rset_a, 'DBICNSTest::ResultSet::A');
+
+
+is int DBICNSTest->sources, 3, 'two sources loaded';

diff --git a/t/lib/DBICNSTest/Result/R.pm b/t/lib/DBICNSTest/Result/R.pm
new file mode 100644 (file)
index 0000000..dd98019
--- /dev/null
+++ b/t/lib/DBICNSTest/Result/R.pm
@@ -0,0 +1,13 @@
+package DBICNSTest::Result::R;
+
+use warnings;
+use strict;
+
+use base qw/DBIx::Class::Core/;
+__PACKAGE__->table('r');
+__PACKAGE__->add_columns('r');
+__PACKAGE__->belongs_to(
+  a => 'DBICNSTest::Result::A',
+  { 'foreign.a' => 'this.r' },
+);
+1;