From: Tomas Doran <bobtfish@bobtfish.net>
Date: Wed, 4 Mar 2009 21:52:30 +0000 (+0000)
Subject: Make Moose components collaberate with non-Moose Catalyst
X-Git-Tag: 5.71001~12
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=f04fdedae056296d0fa97fbdcaa85b9811ca6a5b

Make Moose components collaberate with non-Moose Catalyst
---

diff --git a/Changes b/Changes
index 53d3d18..70938c5 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,10 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+5.71000_01 UNRELEASED
+        - Support Moose components so that attribute defaults work
+          and BUILD methods are correctly called (t0m)
+          - Add tests for this (Florian Ragwitz)
+
 5.71000   2009-01-19 17:50:00
         - Text::SimpleTable's go as wide as $ENV{COLUMNS} (jhannah)
           Patch written by Oleg Kostyuk <cub.uanic@gmail.com>
diff --git a/lib/Catalyst/Component.pm b/lib/Catalyst/Component.pm
index 0b48725..c895b45 100644
--- a/lib/Catalyst/Component.pm
+++ b/lib/Catalyst/Component.pm
@@ -5,6 +5,14 @@ use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
 use NEXT;
 use Catalyst::Utils;
 
+BEGIN {
+    if (eval 'require Moose; 1') {
+        *__HAVE_MOOSE = sub () { 1 };
+    }
+    else {
+        *__HAVE_MOOSE = sub () { 0 };
+    }
+}
 
 =head1 NAME
 
@@ -54,13 +62,28 @@ __PACKAGE__->mk_classdata($_) for qw/_config _plugins/;
 
 
 sub new {
-    my ( $self, $c ) = @_;
+    my ( $class, $c ) = @_;
 
     # Temporary fix, some components does not pass context to constructor
     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
 
-    return $self->NEXT::new( 
-        $self->merge_config_hashes( $self->config, $arguments ) );
+    my $config = $class->merge_config_hashes( $class->config, $arguments );
+
+    my $self = $class->NEXT::new($config);
+
+    if (__HAVE_MOOSE) {
+        my $meta = Class::MOP::get_metaclass_by_name($class);
+        if ($meta) {
+            $self = $meta->new_object(
+                __INSTANCE__ => $self,
+                %$config
+            );
+            # May not inherit from Moose::Object at all, so
+            # call BUILDALL explicitly.
+            $self->Moose::Object::BUILDALL($config);
+        }
+    }
+    return $self;
 }
 
 sub COMPONENT {
diff --git a/t/lib/TestApp/Controller/Moose.pm b/t/lib/TestApp/Controller/Moose.pm
index d80102e..5783686 100644
--- a/t/lib/TestApp/Controller/Moose.pm
+++ b/t/lib/TestApp/Controller/Moose.pm
@@ -2,18 +2,40 @@ package TestApp::Controller::Moose;
 
 use Moose;
 
-use namespace::clean -except => 'meta';
-
 BEGIN { extends qw/Catalyst::Controller/; }
 
-has attribute => (
+has attribute => ( # Test defaults work
     is      => 'ro',
     default => 42,
 );
 
-sub get_attribute : Local {
+has other_attribute => ( # Test BUILD method is called
+    is => 'rw'
+);
+
+has punctuation => ( # Test BUILD method gets merged config
+    is => 'rw'
+);
+
+has space => ( # Test that attribute slots get filled from merged config
+    is => 'ro'
+);
+
+no Moose;
+
+__PACKAGE__->config(the_punctuation => ':');
+__PACKAGE__->config(space => ' '); # i am pbp, icm5ukp
+
+sub BUILD {
+    my ($self, $config) = @_;
+    # Note, not an example of something you would ever
+    $self->other_attribute('the meaning of life');
+    $self->punctuation( $config->{the_punctuation} );
+}
+
+sub the_answer : Local {
     my ($self, $c) = @_;
-    $c->response->body($self->attribute);
+    $c->response->body($self->other_attribute . $self->punctuation . $self->space . $self->attribute);
 }
 
 1;
diff --git a/t/live_component_controller_moose.t b/t/live_component_controller_moose.t
index 353e515..98912ba 100644
--- a/t/live_component_controller_moose.t
+++ b/t/live_component_controller_moose.t
@@ -17,7 +17,7 @@ use lib "$FindBin::Bin/lib";
 use Catalyst::Test 'TestApp';
 
 {
-    my $response = request('http://localhost/moose/get_attribute');
+    my $response = request('http://localhost/moose/the_answer');
     ok($response->is_success);
-    is($response->content, '42', 'attribute default values get set correctly');
+    is($response->content, 'the meaning of life: 42', 'attr defaults + BUILD works correctly');
 }