From: Rafael Kitover <rkitover@cpan.org>
Date: Fri, 28 Oct 2011 16:43:41 +0000 (-0400)
Subject: better dynamic schema_base_class implementation
X-Git-Tag: 0.07011~16
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=de89debaf038ba4afae1a3a56d03f43e9d8ca833;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

better dynamic schema_base_class implementation

Remove the restriction that dynamic schemas can't define a connection
method by finding the next method to call in mro::get_linear_isa.
---

diff --git a/lib/DBIx/Class/Schema/Loader.pm b/lib/DBIx/Class/Schema/Loader.pm
index 1c7b649..7e929a3 100644
--- a/lib/DBIx/Class/Schema/Loader.pm
+++ b/lib/DBIx/Class/Schema/Loader.pm
@@ -218,7 +218,8 @@ as soon as the connection information is defined.
 =cut
 
 sub connection {
-    my $self = shift;
+    my $self  = shift;
+    my $class = ref $self || $self;
 
     if($_[-1] && ref $_[-1] eq 'HASH') {
         for my $option (qw/loader_class loader_options/) {
@@ -243,10 +244,10 @@ sub connection {
         push @components, ('+'.$temp_loader->schema_base_class)
             if $temp_loader->schema_base_class;
 
-        $self->load_components(@components);
+        $class->load_components(@components);
 
         # This hack is necessary because we changed @ISA of $self through
-        # ->load_components.
+        # ->load_components and we are now in a different place in the mro.
         no warnings 'redefine';
 
         local *connection = subname __PACKAGE__.'::connection' => sub {
@@ -254,13 +255,22 @@ sub connection {
             $self->next::method(@_);
         };
 
-        $self = $self->connection(@_);
+        my @linear_isa = @{ mro::get_linear_isa($class) };
+
+        my $next_method;
+
+        foreach my $i (1..$#linear_isa) {
+            no strict 'refs';
+            $next_method = *{$linear_isa[$i].'::connection'}{CODE};
+            last if $next_method;
+        }
+
+        $self = $self->$next_method(@_);
     }
     else {
         $self = $self->next::method(@_);
     }
 
-    my $class = ref $self || $self;
     if(!$class->_loader_invoked) {
         $self->_invoke_loader
     }
diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index b2c99c7..3b74da4 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -545,19 +545,10 @@ Default behavior is to utilize L<Lingua::EN::Inflect::Phrase/to_S>.
 
 Base class for your schema classes. Defaults to 'DBIx::Class::Schema'.
 
-B<WARNING>: if you define schema_base_class for a dynamic schema, you cannot
-define a L<connection|DBIx::Class::Schema/connection> method in your schema
-class, it must be in the schema base class, due to the limits of L<mro>.
-
 =head2 schema_components
 
 List of components to load into the Schema class.
 
-B<WARNING>: if you define schema_components for a dynamic schema, you cannot
-define a L<connection|DBIx::Class::Schema/connection> method in your schema
-class, it must be in L</schema_base_class> or a component, due to the limits of
-L<mro>.
-
 =head2 result_base_class
 
 Base class for your table classes (aka result classes). Defaults to
diff --git a/t/70schema_base_dispatched.t b/t/70schema_base_dispatched.t
index b0dae81..feacd28 100644
--- a/t/70schema_base_dispatched.t
+++ b/t/70schema_base_dispatched.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 no warnings 'once';
-use Test::More tests => 2;
+use Test::More tests => 8;
 use DBIx::Class::Schema::Loader 'make_schema_at';
 use lib 't/lib';
 use make_dbictest_db;
@@ -21,3 +21,45 @@ ok $TestSchemaBaseClass::test_ok,
 
 ok $DBIx::Class::TestSchemaComponent::test_component_ok,
     'connected using schema_components';
+
+# try an explicit dynamic schema
+
+$TestSchemaBaseClass::test_ok = 0;
+$DBIx::Class::TestSchemaComponent::test_component_ok = 0;
+
+{
+    package DBICTest::Schema::_test_schema_base_dynamic;
+    use base 'DBIx::Class::Schema::Loader';
+    __PACKAGE__->loader_options({
+        naming => 'current',
+        schema_base_class => 'TestSchemaBaseClass',
+        schema_components => ['TestSchemaComponent'],
+    });
+    # check that connection doesn't cause an infinite loop
+    sub connection { my $self = shift; return $self->next::method(@_) }
+}
+
+ok(my $schema =
+    DBICTest::Schema::_test_schema_base_dynamic->connect($make_dbictest_db::dsn),
+    'connected dynamic schema');
+
+ok $TestSchemaBaseClass::test_ok,
+    'connected using schema_base_class in dynamic schema';
+
+ok $DBIx::Class::TestSchemaComponent::test_component_ok,
+    'connected using schema_components in dynamic schema';
+
+# connect a second time
+
+$TestSchemaBaseClass::test_ok = 0;
+$DBIx::Class::TestSchemaComponent::test_component_ok = 0;
+
+ok($schema =
+    DBICTest::Schema::_test_schema_base_dynamic->connect($make_dbictest_db::dsn),
+    'connected dynamic schema a second time');
+
+ok $TestSchemaBaseClass::test_ok,
+    'connected using schema_base_class in dynamic schema a second time';
+
+ok $DBIx::Class::TestSchemaComponent::test_component_ok,
+    'connected using schema_components in dynamic schema a second time';