From: Rafael Kitover <rkitover@cpan.org>
Date: Sat, 22 Jan 2011 15:22:10 +0000 (-0500)
Subject: fix bug with result class methods being cached on in a closure instead of the object... 
X-Git-Tag: 0.07004~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=26c546800f9a3beacb1392c819cbbbea5c686946;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

fix bug with result class methods being cached on in a closure instead of the object, which breaks for multiple dynamic schemas in a single perl instance
---

diff --git a/Changes b/Changes
index e6d071a..2202f0b 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - fix bug with result class methods being cached on in a closure instead
+          of the object, which breaks for multiple dynamic schemas in a single
+          perl instance
+
 0.07003  2011-01-21 06:43:05
         - fix relname/method collisions (RT#62648)
         - fix fully qualified component classes (RT#62624)
diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 48b6cd5..da225f2 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -89,6 +89,7 @@ __PACKAGE__->mk_group_accessors('simple', qw/
                                 rel_collision_map
                                 real_dump_directory
                                 datetime_undef_if_invalid
+                                _result_class_methods
 /);
 
 =head1 NAME
@@ -1576,33 +1577,32 @@ sub _make_src_class {
     $self->_inject($table_class, @{$self->additional_base_classes});
 }
 
-{
-    my %result_methods;
-
-    sub _is_result_class_method {
-        my ($self, $name) = @_;
+sub _is_result_class_method {
+    my ($self, $name) = @_;
 
-        %result_methods || do {
-            my @methods;
-            my $base       = $self->result_base_class || 'DBIx::Class::Core';
-            my @components = map { /^\+/ ? substr($_,1) : "DBIx::Class::$_" } @{ $self->components || [] };
+    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 || [] };
 
-            for my $class ($base, @components, $self->use_moose ? 'Moose::Object' : ()) {
-                load_class $class;
+        for my $class ($base, @components, $self->use_moose ? 'Moose::Object' : ()) {
+            load_class $class;
 
-                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} = ();
+        @methods{@methods} = ();
 
-            # futureproof meta
-            $result_methods{meta} = undef;
-        };
+        # futureproof meta
+        $methods{meta} = undef;
 
-        return exists $result_methods{$name};
+        $self->_result_class_methods(\%methods);
     }
+    my $result_methods = $self->_result_class_methods;
+
+    return exists $result_methods->{$name};
 }
 
 sub _resolve_col_accessor_collisions {