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 | |
91e80be9 |
9 | sub BEFORE_APPLY (&) { |
10 | push @{$Before{scalar caller}}, $_[0]; |
11 | $Class::C3::Componentised::APPLICATOR_FOR{scalar caller} = __PACKAGE__; |
12 | } |
13 | sub AFTER_APPLY (&) { |
14 | push @{$After {scalar caller}}, $_[0]; |
15 | $Class::C3::Componentised::APPLICATOR_FOR{scalar caller} = __PACKAGE__; |
16 | } |
17 | |
18 | sub _apply_component_to_class { |
19 | my ($me, $comp, $target, $apply) = @_; |
20 | my @heritage = @{mro::get_linear_isa($comp)}; |
21 | |
22 | my @before = map { |
23 | my $to_run = $Before{$_}; |
24 | ($to_run?[$_,$to_run]:()) |
25 | } @heritage; |
26 | |
27 | for my $todo (@before) { |
28 | my ($parent, $fn) = @$todo; |
29 | for my $f (reverse @$fn) { |
30 | $target->$f($parent) |
31 | } |
32 | } |
33 | |
34 | $apply->(); |
35 | |
36 | my @after = map { |
37 | my $to_run = $After{$_}; |
38 | ($to_run?[$_,$to_run]:()) |
39 | } @heritage; |
40 | |
41 | for my $todo (reverse @after) { |
42 | my ($parent, $fn) = @$todo; |
43 | for my $f (@$fn) { |
44 | $target->$f($parent) |
45 | } |
46 | } |
3a23b721 |
47 | } |
e6b8b400 |
48 | |
49 | { |
50 | no strict 'refs'; |
51 | sub import { |
52 | my ($from, @args) = @_; |
53 | my $to = caller; |
54 | |
55 | my $default = 1; |
56 | my $i = 0; |
57 | my $skip = 0; |
58 | my @import; |
59 | for my $arg (@args) { |
60 | if ($skip) { |
61 | $skip--; |
62 | $i++; |
63 | next |
64 | } |
65 | |
66 | if ($arg eq '-before_apply') { |
67 | $default = 0; |
68 | $skip = 1; |
91e80be9 |
69 | push @{$Before{$to}}, $args[$i + 1]; |
70 | $Class::C3::Componentised::APPLICATOR_FOR{$to} = $from; |
e6b8b400 |
71 | } elsif ($arg eq '-after_apply') { |
72 | $default = 0; |
73 | $skip = 1; |
74 | push @{$After{$to}}, $args[$i + 1]; |
91e80be9 |
75 | $Class::C3::Componentised::APPLICATOR_FOR{$to} = $from; |
e6b8b400 |
76 | } elsif ($arg =~ /^BEFORE_APPLY|AFTER_APPLY$/) { |
77 | $default = 0; |
78 | push @import, $arg |
79 | } |
80 | $i++; |
81 | } |
82 | @import = qw(BEFORE_APPLY AFTER_APPLY) |
83 | if $default; |
84 | |
85 | *{"$to\::$_"} = \&{"$from\::$_"} for @import |
86 | } |
87 | } |
88 | |
89 | 1; |
90 | |
91 | =head1 NAME |
92 | |
91dc3b98 |
93 | Class::C3::Componentised::ApplyHooks - Run methods before or after components are injected |
e6b8b400 |
94 | |
95 | =head1 SYNOPSIS |
96 | |
97 | package MyComponent; |
98 | |
99 | our %statistics; |
100 | |
101 | use Class::C3::Componentised::ApplyHooks |
102 | -before_apply => sub { |
103 | my ($class, $component) = @_; |
104 | |
105 | push @{$statistics{$class}}, '-before_apply'; |
106 | }, |
107 | -after_apply => sub { |
108 | my ($class, $component) = @_; |
109 | |
110 | push @{$statistics{$class}}, '-after_apply'; |
111 | }, qw(BEFORE_APPLY AFTER_APPLY); |
112 | |
113 | BEFORE_APPLY { push @{$statistics{$class}}, 'BEFORE_APPLY' }; |
114 | AFTER_APPLY { push @{$statistics{$class}}, 'AFTER_APPLY' }; |
115 | AFTER_APPLY { use Devel::Dwarn; Dwarn %statistics }; |
116 | |
117 | 1; |
118 | |
119 | =head1 DESCRIPTION |
120 | |
121 | This package allows a given component to run methods on the class that is being |
3a23b721 |
122 | injected into before or after the component is injected. Note from the |
e6b8b400 |
123 | L</SYNOPSIS> that all C<Load Actions> may be run more than once. |
124 | |
125 | =head1 IMPORT ACTION |
126 | |
127 | Both import actions simply run a list of coderefs that will be passed the class |
128 | that is being acted upon and the component that is being added to the class. |
129 | |
130 | =head1 IMPORT OPTIONS |
131 | |
132 | =head2 -before_apply |
133 | |
134 | Adds a before apply action for the current component without importing |
135 | any subroutines into your namespace. |
136 | |
137 | =head2 -after_apply |
138 | |
139 | Adds an after apply action for the current component without importing |
140 | any subroutines into your namespace. |
141 | |
142 | =head1 EXPORTED SUBROUTINES |
143 | |
144 | =head2 BEFORE_APPLY |
145 | |
146 | BEFORE_APPLY { warn "about to apply $_[1] to class $_[0]" }; |
147 | |
148 | Adds a before apply action for the current component. |
149 | |
150 | =head2 AFTER_APPLY |
151 | |
152 | AFTER_APPLY { warn "just applied $_[1] to class $_[0]" }; |
153 | |
154 | Adds an after apply action for the current component. |
155 | |
156 | =cut |