[Bast-commits] r9585 - in Class-C3-Componentised/branches/apply_actions: . lib/Class/C3 lib/Class/C3/Componentised t

frew at dev.catalyst.perl.org frew at dev.catalyst.perl.org
Wed Jun 23 03:44:10 GMT 2010


Author: frew
Date: 2010-06-23 04:44:10 +0100 (Wed, 23 Jun 2010)
New Revision: 9585

Added:
   Class-C3-Componentised/branches/apply_actions/lib/Class/C3/Componentised/
   Class-C3-Componentised/branches/apply_actions/lib/Class/C3/Componentised/LoadActions.pm
   Class-C3-Componentised/branches/apply_actions/t/03-on-apply.t
Modified:
   Class-C3-Componentised/branches/apply_actions/Makefile.PL
   Class-C3-Componentised/branches/apply_actions/lib/Class/C3/Componentised.pm
Log:
initial commit of LoadActions stuff

Modified: Class-C3-Componentised/branches/apply_actions/Makefile.PL
===================================================================
--- Class-C3-Componentised/branches/apply_actions/Makefile.PL	2010-06-22 16:49:42 UTC (rev 9584)
+++ Class-C3-Componentised/branches/apply_actions/Makefile.PL	2010-06-23 03:44:10 UTC (rev 9585)
@@ -6,6 +6,7 @@
 
 
 requires  'MRO::Compat';
+requires  'Sub::Exporter';
 requires  'Class::Inspector';
 requires  'Carp';
 requires  'Test::Exception';

Added: Class-C3-Componentised/branches/apply_actions/lib/Class/C3/Componentised/LoadActions.pm
===================================================================
--- Class-C3-Componentised/branches/apply_actions/lib/Class/C3/Componentised/LoadActions.pm	                        (rev 0)
+++ Class-C3-Componentised/branches/apply_actions/lib/Class/C3/Componentised/LoadActions.pm	2010-06-23 03:44:10 UTC (rev 9585)
@@ -0,0 +1,25 @@
+package Class::C3::Componentised::LoadActions;
+
+use strict;
+use warnings;
+
+our %Before;
+our %After;
+
+sub BEFORE_APPLY { $Before{scalar caller(1)} = $_[1] };
+sub AFTER_APPLY  { $After {scalar caller(1)} = $_[1] };
+
+sub _curry_class {
+   my ($class, $name) = @_;
+   sub { $class->$name(@_) }
+}
+
+use Sub::Exporter -setup => {
+   exports => [
+      map { $_ => \'_curry_class' }
+      qw(BEFORE_APPLY AFTER_APPLY)
+   ],
+   groups  => { default => [ qw(BEFORE_APPLY AFTER_APPLY) ] },
+};
+
+1;

Modified: Class-C3-Componentised/branches/apply_actions/lib/Class/C3/Componentised.pm
===================================================================
--- Class-C3-Componentised/branches/apply_actions/lib/Class/C3/Componentised.pm	2010-06-22 16:49:42 UTC (rev 9584)
+++ Class-C3-Componentised/branches/apply_actions/lib/Class/C3/Componentised.pm	2010-06-23 03:44:10 UTC (rev 9585)
@@ -172,8 +172,15 @@
   {
     no strict 'refs';
     foreach my $to (reverse @to_inject) {
-      unshift ( @{"${target}::ISA"}, $to )
-        unless ($target eq $to || $target->isa($to));
+      unless ($target eq $to || $target->isa($to)) {
+         if (my $fn = $Class::C3::Componentised::LoadActions::Before{$to}) {
+            $to->$fn($target)
+         }
+         unshift ( @{"${target}::ISA"}, $to );
+         if (my $fn = $Class::C3::Componentised::LoadActions::After{$to}) {
+            $to->$fn($target)
+         }
+      }
     }
   }
 

Added: Class-C3-Componentised/branches/apply_actions/t/03-on-apply.t
===================================================================
--- Class-C3-Componentised/branches/apply_actions/t/03-on-apply.t	                        (rev 0)
+++ Class-C3-Componentised/branches/apply_actions/t/03-on-apply.t	2010-06-23 03:44:10 UTC (rev 9585)
@@ -0,0 +1,32 @@
+use strict;
+use warnings;
+
+use FindBin;
+use Test::More;
+
+use lib "$FindBin::Bin/lib";
+
+my $awesome_robot = 0;
+my $first = 0;
+my $last = 0;
+
+BEGIN {
+  package MyModule::Plugin::TestActions;
+
+  use Class::C3::Componentised::LoadActions;
+
+  BEFORE_APPLY sub { $awesome_robot++; $first = $awesome_robot };
+  AFTER_APPLY  sub { $awesome_robot++;  $last  = $awesome_robot };
+
+  1;
+}
+
+use_ok('MyModule');
+is $first, 0, 'first starts at zero';
+is $last, 0, 'last starts at zero';
+
+MyModule->load_components('TestActions');
+is $first, 1, 'first gets value of 1 (it runs first)';
+is $last, 2, 'last gets value of 2 (it runs last)';
+
+done_testing;




More information about the Bast-commits mailing list