[Catalyst-commits] r7893 - in Catalyst-Runtime/5.80/branches/moose: lib/Catalyst t

[groditi at dev.catalyst.perl.org]

Author: groditi
Date: 2008-06-04 17:15:25 +0100 (Wed, 04 Jun 2008)
New Revision: 7893

Added:
   Catalyst-Runtime/5.80/branches/moose/t/unit_core_component_mro.t
Modified:
   Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/Component.pm
Log:
backcompat for NEXT in &COMPONENT + test

Modified: Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/Component.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/Component.pm	2008-06-04 14:37:17 UTC (rev 7892)
+++ Catalyst-Runtime/5.80/branches/moose/lib/Catalyst/Component.pm	2008-06-04 16:15:25 UTC (rev 7893)
@@ -1,8 +1,11 @@
 package Catalyst::Component;
 
 use Moose;
+use Class::MOP;
 use MooseX::Adopt::Class::Accessor::Fast;
 use Catalyst::Utils;
+use MRO::Compat;
+use mro 'c3';
 
 with 'MooseX::Emulate::Class::Accessor::Fast';
 with 'Catalyst::ClassData';
@@ -70,6 +73,12 @@
 
     # Temporary fix, some components does not pass context to constructor
     my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
+    if( my $next = $self->next::can ){
+      my $class = blessed $self || $self;
+      my ($next_package) = Class::MOP::get_code_info($next);
+      warn "There is a COMPONENT method resolving after Catalyst::Component in ${next_package}. This behavior is deprecated and will stop working in future releases.";
+      return $next->($self, $arguments);
+    }
     return $self->new($c, $arguments);
 }
 

Added: Catalyst-Runtime/5.80/branches/moose/t/unit_core_component_mro.t
===================================================================
--- Catalyst-Runtime/5.80/branches/moose/t/unit_core_component_mro.t	                        (rev 0)
+++ Catalyst-Runtime/5.80/branches/moose/t/unit_core_component_mro.t	2008-06-04 16:15:25 UTC (rev 7893)
@@ -0,0 +1,26 @@
+use Test::More tests => 2;
+use strict;
+use warnings;
+
+{
+  package MyApp::Component;
+  use Test::More;
+
+  sub COMPONENT{
+    my $caller = caller;
+    is($caller, 'Catalyst::Component', 'Correct method resolution');
+  }
+
+  package MyApp::MyComponent;
+
+  use base 'Catalyst::Component', 'MyApp::Component';
+
+}
+
+{
+  my $expects = qr/after Catalyst::Component in MyApp::Component/;
+  local $SIG{__WARN__} = sub {
+    like($_[0], $expects, 'correct warning thrown');
+  };
+  MyApp::MyComponent->COMPONENT('MyApp');
+}