lib/Class/C3/Componentised/ApplyHooks.pm

   1 package Class::C3::Componentised::ApplyHooks;
   2
   3 use strict;
   4 use warnings;
   5
   6 our %Before;
   7 our %After;
   8
   9 sub BEFORE_APPLY (&) { push @{$Before{scalar caller}}, $_[0] };
  10 sub AFTER_APPLY  (&) { push @{$After {scalar caller}}, $_[0] };
  11
  12 {
  13    no strict 'refs';
  14    sub import {
  15       my ($from, @args) = @_;
  16       my $to = caller;
  17
  18       my $default = 1;
  19       my $i = 0;
  20       my $skip = 0;
  21       my @import;
  22       for my $arg (@args) {
  23          if ($skip) {
  24             $skip--;
  25             $i++;
  26             next
  27          }
  28
  29          if ($arg eq '-before_apply') {
  30             $default = 0;
  31             $skip = 1;
  32             push @{$Before{$to}}, $args[$i + 1]
  33          } elsif ($arg eq '-after_apply') {
  34             $default = 0;
  35             $skip = 1;
  36             push @{$After{$to}}, $args[$i + 1];
  37          } elsif ($arg =~ /^BEFORE_APPLY|AFTER_APPLY$/) {
  38             $default = 0;
  39             push @import, $arg
  40          }
  41          $i++;
  42       }
  43       @import = qw(BEFORE_APPLY AFTER_APPLY)
  44          if $default;
  45
  46       *{"$to\::$_"} = \&{"$from\::$_"} for @import
  47    }
  48 }
  49
  50 1;
  51
  52 =head1 NAME
  53
  54 Class::C3::Componentised::ApplyHooks
  55
  56 =head1 SYNOPSIS
  57
  58  package MyComponent;
  59
  60  our %statistics;
  61
  62  use Class::C3::Componentised::ApplyHooks
  63    -before_apply => sub {
  64      my ($class, $component) = @_;
  65
  66      push @{$statistics{$class}}, '-before_apply';
  67    },
  68    -after_apply  => sub {
  69      my ($class, $component) = @_;
  70
  71      push @{$statistics{$class}}, '-after_apply';
  72    }, qw(BEFORE_APPLY AFTER_APPLY);
  73
  74  BEFORE_APPLY { push @{$statistics{$class}}, 'BEFORE_APPLY' };
  75  AFTER_APPLY { push @{$statistics{$class}}, 'AFTER_APPLY' };
  76  AFTER_APPLY { use Devel::Dwarn; Dwarn %statistics };
  77
  78  1;
  79
  80 =head1 DESCRIPTION
  81
  82 This package allows a given component to run methods on the class that is being
  83 injected into before or after the component is injected.  Note from the
  84 L</SYNOPSIS> that all C<Load Actions> may be run more than once.
  85
  86 =head1 IMPORT ACTION
  87
  88 Both import actions simply run a list of coderefs that will be passed the class
  89 that is being acted upon and the component that is being added to the class.
  90
  91 =head1 IMPORT OPTIONS
  92
  93 =head2 -before_apply
  94
  95 Adds a before apply action for the current component without importing
  96 any subroutines into your namespace.
  97
  98 =head2 -after_apply
  99
 100 Adds an after apply action for the current component without importing
 101 any subroutines into your namespace.
 102
 103 =head1 EXPORTED SUBROUTINES
 104
 105 =head2 BEFORE_APPLY
 106
 107  BEFORE_APPLY { warn "about to apply $_[1] to class $_[0]"  };
 108
 109 Adds a before apply action for the current component.
 110
 111 =head2 AFTER_APPLY
 112
 113  AFTER_APPLY { warn "just applied $_[1] to class $_[0]"  };
 114
 115 Adds an after apply action for the current component.
 116
 117 =cut