From: Arthur Axel 'fREW' Schmidt <frioux@gmail.com>
Date: Sat, 17 Jul 2010 18:05:51 +0000 (-0500)
Subject: Initial, ghetto, but working version of resultset components
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=93b64751a7cd088a50b9a145c92e2d39317ec821;p=dbsrgits%2FDBIx-Class.git

Initial, ghetto, but working version of resultset components
---

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 46ad67a..e8920b0 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -1884,4 +1884,16 @@ You may distribute this code under the same terms as Perl itself.
 
 =cut
 
+sub inject_resultset_components {
+   my $self       = shift;
+   my @components = @{shift @_};
+
+   # this generation of class bit needs to go into CCC
+   my $class = $self->resultset_class . '::' . rand(100);
+   Class::C3::Componentised->inject_base($class, $self->resultset_class);
+   $self->resultset_class($class);
+
+   $self->resultset_class->load_components(@components);
+}
+
 1;
diff --git a/lib/DBIx/Class/ResultSourceProxy.pm b/lib/DBIx/Class/ResultSourceProxy.pm
index 1f74eea..8489c8a 100644
--- a/lib/DBIx/Class/ResultSourceProxy.pm
+++ b/lib/DBIx/Class/ResultSourceProxy.pm
@@ -80,6 +80,8 @@ for my $method_to_proxy (qw/
   relationships
   relationship_info
   has_relationship
+
+  inject_resultset_components
 /) {
   no strict qw/refs/;
   *{__PACKAGE__."::$method_to_proxy"} = subname $method_to_proxy => sub {
diff --git a/t/lib/A/Useless.pm b/t/lib/A/Useless.pm
new file mode 100644
index 0000000..d1a038d
--- /dev/null
+++ b/t/lib/A/Useless.pm
@@ -0,0 +1,3 @@
+package A::Useless;
+
+1;
diff --git a/t/lib/DBICTest/Schema/Artist.pm b/t/lib/DBICTest/Schema/Artist.pm
index b089287..530ee89 100644
--- a/t/lib/DBICTest/Schema/Artist.pm
+++ b/t/lib/DBICTest/Schema/Artist.pm
@@ -1,4 +1,4 @@
-package # hide from PAUSE 
+package # hide from PAUSE
     DBICTest::Schema::Artist;
 
 use base qw/DBICTest::BaseResult/;
@@ -65,6 +65,7 @@ __PACKAGE__->has_many(
 );
 __PACKAGE__->many_to_many('artworks', 'artwork_to_artist', 'artwork');
 
+__PACKAGE__->result_source_instance->inject_resultset_components(['+A::Useless']);
 
 sub sqlt_deploy_hook {
   my ($self, $sqlt_table) = @_;
diff --git a/t/resultset/components.t b/t/resultset/components.t
new file mode 100644
index 0000000..c4b54b6
--- /dev/null
+++ b/t/resultset/components.t
@@ -0,0 +1,14 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema;
+
+isa_ok $schema->resultset('Artist'), 'A::Useless', 'Artist RS';
+ok !$schema->resultset('CD')->isa('A::Useless'), 'CD RS is not A::Useless';
+
+done_testing;