Commit | Line | Data |
e6b8b400 |
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 |