[Catalyst-commits] r9429 - in Catalyst-Runtime/5.70/trunk: . lib/Catalyst t t/lib/TestApp/Controller

[t0m at dev.catalyst.perl.org]

Author: t0m
Date: 2009-03-04 21:52:30 +0000 (Wed, 04 Mar 2009)
New Revision: 9429

Modified:
   Catalyst-Runtime/5.70/trunk/Changes
   Catalyst-Runtime/5.70/trunk/lib/Catalyst/Component.pm
   Catalyst-Runtime/5.70/trunk/t/lib/TestApp/Controller/Moose.pm
   Catalyst-Runtime/5.70/trunk/t/live_component_controller_moose.t
Log:
Make Moose components collaberate with non-Moose Catalyst

Modified: Catalyst-Runtime/5.70/trunk/Changes
===================================================================
--- Catalyst-Runtime/5.70/trunk/Changes	2009-03-04 16:53:02 UTC (rev 9428)
+++ Catalyst-Runtime/5.70/trunk/Changes	2009-03-04 21:52:30 UTC (rev 9429)
@@ -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 at gmail.com>

Modified: Catalyst-Runtime/5.70/trunk/lib/Catalyst/Component.pm
===================================================================
--- Catalyst-Runtime/5.70/trunk/lib/Catalyst/Component.pm	2009-03-04 16:53:02 UTC (rev 9428)
+++ Catalyst-Runtime/5.70/trunk/lib/Catalyst/Component.pm	2009-03-04 21:52:30 UTC (rev 9429)
@@ -5,6 +5,14 @@
 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 @@
 
 
 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 {

Modified: Catalyst-Runtime/5.70/trunk/t/lib/TestApp/Controller/Moose.pm
===================================================================
--- Catalyst-Runtime/5.70/trunk/t/lib/TestApp/Controller/Moose.pm	2009-03-04 16:53:02 UTC (rev 9428)
+++ Catalyst-Runtime/5.70/trunk/t/lib/TestApp/Controller/Moose.pm	2009-03-04 21:52:30 UTC (rev 9429)
@@ -2,18 +2,40 @@
 
 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;

Modified: Catalyst-Runtime/5.70/trunk/t/live_component_controller_moose.t
===================================================================
--- Catalyst-Runtime/5.70/trunk/t/live_component_controller_moose.t	2009-03-04 16:53:02 UTC (rev 9428)
+++ Catalyst-Runtime/5.70/trunk/t/live_component_controller_moose.t	2009-03-04 21:52:30 UTC (rev 9429)
@@ -17,7 +17,7 @@
 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');
 }