| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Aspect; |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
require 5.008002; |
|
4
|
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
1727
|
use strict; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
52
|
|
|
6
|
1
|
|
|
1
|
|
8
|
use warnings; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
40
|
|
|
7
|
1
|
|
|
1
|
|
6
|
use Carp; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
82
|
|
|
8
|
1
|
|
|
1
|
|
523
|
use Aspect::Advice; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
91
|
|
|
9
|
1
|
|
|
1
|
|
9
|
use Aspect::Pointcut::Call; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
36
|
|
|
10
|
1
|
|
|
1
|
|
7
|
use Aspect::Pointcut::Cflow; |
|
|
1
|
|
|
|
|
4
|
|
|
|
1
|
|
|
|
|
39
|
|
|
11
|
|
|
|
|
|
|
|
|
12
|
1
|
|
|
1
|
|
8
|
use base 'Exporter'; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
700
|
|
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our $VERSION = '0.09_03'; |
|
15
|
|
|
|
|
|
|
our @EXPORT = qw(aspect before after call cflow); |
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
my (@Aspect_Store, @Advice_Store); |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub aspect { |
|
20
|
0
|
|
|
0
|
0
|
0
|
my ($name, @params) = @_; |
|
21
|
0
|
|
|
|
|
0
|
$name = "Aspect::Library::$name"; |
|
22
|
0
|
|
|
|
|
0
|
runtime_use($name); |
|
23
|
0
|
|
|
|
|
0
|
my $aspect = $name->new(@params); |
|
24
|
|
|
|
|
|
|
# if called in void context, aspect is for life |
|
25
|
0
|
0
|
|
|
|
0
|
push @Aspect_Store, $aspect unless defined wantarray; |
|
26
|
0
|
|
|
|
|
0
|
return $aspect; |
|
27
|
|
|
|
|
|
|
} |
|
28
|
|
|
|
|
|
|
|
|
29
|
9
|
|
|
9
|
0
|
3040
|
sub call ($) { Aspect::Pointcut::Call ->new(@_) } |
|
30
|
2
|
|
|
2
|
0
|
16
|
sub cflow ($$) { Aspect::Pointcut::Cflow->new(@_) } |
|
31
|
|
|
|
|
|
|
|
|
32
|
6
|
|
|
6
|
0
|
27
|
sub before (&$) { advice(before => @_) } |
|
33
|
3
|
|
|
3
|
0
|
13
|
sub after (&$) { advice(after => @_) } |
|
34
|
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub advice { |
|
36
|
9
|
|
|
9
|
0
|
61
|
my $advice = Aspect::Advice->new(@_); |
|
37
|
|
|
|
|
|
|
# if called in void context, advice is for life |
|
38
|
9
|
50
|
|
|
|
43
|
push @Advice_Store, $advice unless defined wantarray; |
|
39
|
9
|
|
|
|
|
78
|
return $advice; |
|
40
|
|
|
|
|
|
|
} |
|
41
|
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub runtime_use { |
|
43
|
0
|
|
|
0
|
0
|
|
my $package = shift; |
|
44
|
0
|
|
|
|
|
|
eval "use $package;"; |
|
45
|
0
|
0
|
|
|
|
|
croak "Cannot use [$package]: $@" if $@; |
|
46
|
|
|
|
|
|
|
} |
|
47
|
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
1; |
|
49
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head1 NAME |
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
Aspect - AOP for Perl |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
package Person; |
|
57
|
|
|
|
|
|
|
sub create { ... } |
|
58
|
|
|
|
|
|
|
sub set_name { ... } |
|
59
|
|
|
|
|
|
|
sub get_address { ... } |
|
60
|
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
package main; |
|
62
|
|
|
|
|
|
|
use Aspect; |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# using reusable aspects |
|
65
|
|
|
|
|
|
|
aspect Singleton => 'Person::create'; # let there be only one Person |
|
66
|
|
|
|
|
|
|
aspect Profiled => call qr/^Person::set_/; # profile calls to setters |
|
67
|
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
# append extra argument when Person::get_address is called: |
|
69
|
|
|
|
|
|
|
# the instance of the calling Company object, iff get_address |
|
70
|
|
|
|
|
|
|
# is in the call flow of Company::get_employee_addresses. |
|
71
|
|
|
|
|
|
|
# aspect will live as long as $wormhole reference is in scope |
|
72
|
|
|
|
|
|
|
$aspect = aspect Wormhole => 'Company::make_report', 'Person::get_address'; |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# writing your own advice |
|
75
|
|
|
|
|
|
|
$pointcut = call qr/^Person::[gs]et_/; # defines a collection of events |
|
76
|
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
# advice will live as long as $before is in scope |
|
78
|
|
|
|
|
|
|
$before = before { print "g/set will be called" } $pointcut; |
|
79
|
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# advice will live forever, because it is created in void context |
|
81
|
|
|
|
|
|
|
after { print "g/set has been called" } $pointcut; |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
before |
|
84
|
|
|
|
|
|
|
{ print "get will be called, if in the call flow of Tester::run_tests" } |
|
85
|
|
|
|
|
|
|
call qr/^Person::get_/ & cflow tester => 'Tester::run_tests'; |
|
86
|
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
88
|
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Aspect-oriented Programming (AOP) is a programming method developed by |
|
90
|
|
|
|
|
|
|
Xerox PARC and others. The basic idea is that in complex class systems |
|
91
|
|
|
|
|
|
|
there are certain aspects or behaviors that cannot normally be expressed |
|
92
|
|
|
|
|
|
|
in a coherent, concise and precise way. One example of such aspects are |
|
93
|
|
|
|
|
|
|
design patterns, which combine various kinds of classes to produce a |
|
94
|
|
|
|
|
|
|
common type of behavior. Another is logging. See L |
|
95
|
|
|
|
|
|
|
for more info. |
|
96
|
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
The Perl C module closely follows the terminology of the AspectJ |
|
98
|
|
|
|
|
|
|
project (L). However due to the dynamic |
|
99
|
|
|
|
|
|
|
nature of the Perl language, several C features are useless for |
|
100
|
|
|
|
|
|
|
us: exception softening, mixin support, out-of-class method declarations, |
|
101
|
|
|
|
|
|
|
and others. |
|
102
|
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
The Perl C module is focused on subroutine matching and wrapping. |
|
104
|
|
|
|
|
|
|
It allows you to select collections of subroutines using a flexible |
|
105
|
|
|
|
|
|
|
pointcut language, and modify their behavior in any way you want. |
|
106
|
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=head1 TERMINOLOGY |
|
108
|
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=over |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=item Join Point |
|
112
|
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
An event that occurs during the running of a program. Currently only |
|
114
|
|
|
|
|
|
|
calls to subroutines are recognized as join points. |
|
115
|
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=item Pointcut |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
An expression that selects a collection of join points. For example: all |
|
119
|
|
|
|
|
|
|
calls to the class C, that are in the call flow of some |
|
120
|
|
|
|
|
|
|
C, but I in the call flow of C. |
|
121
|
|
|
|
|
|
|
C supports C, and C pointcuts, and logical |
|
122
|
|
|
|
|
|
|
operators (C<&>, C<|>, C) for constructing more complex pointcuts. See |
|
123
|
|
|
|
|
|
|
the L documentation. |
|
124
|
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=item Advice |
|
126
|
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
A pointcut, with code that will run when it matches. The code can be run |
|
128
|
|
|
|
|
|
|
before or after the matched sub is run. |
|
129
|
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=item Advice Code |
|
131
|
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
The code that is run before or after a pointcut is matched. It can modify |
|
133
|
|
|
|
|
|
|
the way that the matched sub is run, and the value it returns. |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=item Weave |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
The installation of advice code on subs that match a pointcut. Weaving |
|
138
|
|
|
|
|
|
|
happens when you create the advice. Unweaving happens when the advice |
|
139
|
|
|
|
|
|
|
goes out of scope. |
|
140
|
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=item The Aspect |
|
142
|
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
An object that installs advice. A way to package advice and other Perl |
|
144
|
|
|
|
|
|
|
code, so that it is reusable. |
|
145
|
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=back |
|
147
|
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head1 FEATURES |
|
149
|
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=over |
|
151
|
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=item * |
|
153
|
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
Create and remove pointcuts, advice, and aspects. |
|
155
|
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=item * |
|
157
|
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
Flexible pointcut language: select subs to match using string equality, |
|
159
|
|
|
|
|
|
|
regexp, or C ref. Match currently running sub, or a sub in the call |
|
160
|
|
|
|
|
|
|
flow. Build pointcuts composed of a logical expression of other |
|
161
|
|
|
|
|
|
|
pointcuts, using conjunction, disjunction, and negation. |
|
162
|
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=item * |
|
164
|
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
In advice code, you can: modify parameter list for matched sub, modify |
|
166
|
|
|
|
|
|
|
return value, decide if to proceed to matched sub, access C ref for |
|
167
|
|
|
|
|
|
|
matched sub, and access the context of any call flow pointcuts that were |
|
168
|
|
|
|
|
|
|
matched, if they exist. |
|
169
|
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=item * |
|
171
|
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
Add/remove advice and entire aspects during run-time. Scope of advice and |
|
173
|
|
|
|
|
|
|
aspect objects, is the scope of their effect. |
|
174
|
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=item * |
|
176
|
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
A reusable aspect library. The L, |
|
178
|
|
|
|
|
|
|
aspect, for example. A base class makes it easy to create your own |
|
179
|
|
|
|
|
|
|
reusable aspects. The L aspect is an |
|
180
|
|
|
|
|
|
|
example of how to interface with APOish modules from CPAN. |
|
181
|
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=back |
|
183
|
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=head1 WHY |
|
185
|
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
Perl is a highly dynamic language, where everything this module does can |
|
187
|
|
|
|
|
|
|
be done without too much difficulty. All this module does, is make it |
|
188
|
|
|
|
|
|
|
even easier, and bring these features under one consistent interface. I |
|
189
|
|
|
|
|
|
|
have found it useful in my work in several places: |
|
190
|
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=over |
|
192
|
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=item * |
|
194
|
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
Saves me from typing an entire line of code for almost every |
|
196
|
|
|
|
|
|
|
C test method, because I use the |
|
197
|
|
|
|
|
|
|
L aspect. |
|
198
|
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=item * |
|
200
|
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
I use the L aspect, so that my |
|
202
|
|
|
|
|
|
|
methods can aquire implicit context, and so I don't need to pass too many |
|
203
|
|
|
|
|
|
|
parameters all over the place. Sure I could do it with C and |
|
204
|
|
|
|
|
|
|
C, but this is much easier. |
|
205
|
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=item * |
|
207
|
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
Using custom advice to modify class behavior: register objects when |
|
209
|
|
|
|
|
|
|
constructors are called, save object state on changes to it, etc. All |
|
210
|
|
|
|
|
|
|
this, while cleanly separating these concerns from the effected class. |
|
211
|
|
|
|
|
|
|
They exist as an independant aspect, so the class remains unpoluted. |
|
212
|
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=back |
|
214
|
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
The C module is different from C (which it uses |
|
216
|
|
|
|
|
|
|
for the actual wrapping) in two respects: |
|
217
|
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=over |
|
219
|
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=item * |
|
221
|
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
Select join points using flexible pointcut language instead of the sub |
|
223
|
|
|
|
|
|
|
name. For example: select all calls to C objects that are in the |
|
224
|
|
|
|
|
|
|
call flow of C. |
|
225
|
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=item * |
|
227
|
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
More options when writing the advice code. You can, for example, run the |
|
229
|
|
|
|
|
|
|
original sub, or append parameters to it. |
|
230
|
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=back |
|
232
|
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=head1 USING |
|
234
|
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
This package is a facade on top of the Perl AOP framework. It allows you |
|
236
|
|
|
|
|
|
|
to create pointcuts, advice, and aspects. You will be mostly working with |
|
237
|
|
|
|
|
|
|
this package (C), and the L
|
|
238
|
|
|
|
|
|
|
context|Aspect::AdviceContext> package. |
|
239
|
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
When you use this package: |
|
241
|
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
use Aspect; |
|
243
|
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
You will import five subs: C, C, C, |
|
245
|
|
|
|
|
|
|
C, and C. These are all factories that allow you to |
|
246
|
|
|
|
|
|
|
create pointcuts, advice, and aspects. |
|
247
|
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=head2 POINTCUTS |
|
249
|
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
Poincuts select join points, so that an advice can run code when they |
|
251
|
|
|
|
|
|
|
happen. The simplest pointcut is C. For example: |
|
252
|
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
$p = call 'Person::get_address'; |
|
254
|
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
Selects the calling of C, as defined in the symbol |
|
256
|
|
|
|
|
|
|
table during weave-time. The string is a pointcut spec, and can be |
|
257
|
|
|
|
|
|
|
expressed in three ways: |
|
258
|
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
=over |
|
260
|
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=item string |
|
262
|
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
Select only the sub whose name is equal to the spec string. |
|
264
|
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=item regexp |
|
266
|
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
Select only the subs whose name matches the regexp. The following will |
|
268
|
|
|
|
|
|
|
match all the subs defined on the C class, but not on |
|
269
|
|
|
|
|
|
|
the C class. |
|
270
|
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
$p = call qr/^Person::\w+$/; |
|
272
|
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=item C ref |
|
274
|
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
Select only subs, where the supplied code, when run with the sub name as |
|
276
|
|
|
|
|
|
|
only parameter, returns true. The following will match all calls to |
|
277
|
|
|
|
|
|
|
subs whose name isa key in the hash C<%subs_to_match>: |
|
278
|
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
$p = call sub { exists $subs_to_match{shift()} } |
|
280
|
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=back |
|
282
|
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
Pointcuts can be combined to form logical expressions, because they |
|
284
|
|
|
|
|
|
|
overload C<&>, C<|>, and C, with factories that create composite |
|
285
|
|
|
|
|
|
|
pointcut objects. Be careful not to use the non-overloadable C<&&>, and |
|
286
|
|
|
|
|
|
|
C<||> operators, because you will get no error message. |
|
287
|
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
Select all calls to C, which are not calls to the constructor: |
|
289
|
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
$p = call qr/^Person::\w+$/ & !call 'Person::create'; |
|
291
|
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
The second pointcut you can use, is C. It selects only the subs |
|
293
|
|
|
|
|
|
|
that are in call flow of its spec. Here we select all calls to C, |
|
294
|
|
|
|
|
|
|
only if they are in the call flow of some method in C: |
|
295
|
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
$p = call qr/^Person::\w+$/ & cflow company => qr/^Company::\w+$/; |
|
297
|
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
The C pointcut takes two parameters: a context key, and a |
|
299
|
|
|
|
|
|
|
pointcut spec. The context key is used in advice code to access the |
|
300
|
|
|
|
|
|
|
context (params, sub name, etc.) of the sub found in the call flow. In |
|
301
|
|
|
|
|
|
|
the example above, the key can be used to access the name of the specific |
|
302
|
|
|
|
|
|
|
sub on C that was found in the call flow of the C |
|
303
|
|
|
|
|
|
|
method.The second parameter is a pointcut spec, that should match the sub |
|
304
|
|
|
|
|
|
|
required from the call flow. |
|
305
|
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
See the L docs for more info. |
|
307
|
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=head2 ADVICE |
|
309
|
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
An advice is just some definition of code that will run on a match of |
|
311
|
|
|
|
|
|
|
some pointcut. An advice can run before the pointcut matched sub is run, |
|
312
|
|
|
|
|
|
|
or after. You create advice using C, and C. These take |
|
313
|
|
|
|
|
|
|
a C ref, and a pointcut, and install the code on the subs that |
|
314
|
|
|
|
|
|
|
match the pointcut. For example: |
|
315
|
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
after { print "Person::get_address has returned!\n" } |
|
317
|
|
|
|
|
|
|
call 'Person::get_address'; |
|
318
|
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
The advice code is run with one parameter: the advice context. You use it |
|
320
|
|
|
|
|
|
|
to learn how the matched sub was run, modify parameters, return value, |
|
321
|
|
|
|
|
|
|
and if it is run at all. You also use the advice context to access any |
|
322
|
|
|
|
|
|
|
context objects that were created by any matching C pointcuts. |
|
323
|
|
|
|
|
|
|
This will print the name of the C that started the call flow |
|
324
|
|
|
|
|
|
|
which evetually reached C: |
|
325
|
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
before { print shift->company->name } |
|
327
|
|
|
|
|
|
|
call 'Person::get_address' & cflow company => qr/^Company::w+$/; |
|
328
|
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
See the L docs for some more examples of advice |
|
330
|
|
|
|
|
|
|
code. |
|
331
|
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
Advice code is applied to matching pointcuts (i.e. the advice is enabled) |
|
333
|
|
|
|
|
|
|
as long as the advice object is in scope. This allows you to neatly |
|
334
|
|
|
|
|
|
|
control enabling and disabling of advice: |
|
335
|
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
{ |
|
337
|
|
|
|
|
|
|
my $advice = before { print "called!\n" } $pointcut; |
|
338
|
|
|
|
|
|
|
# do something while the device is enabled |
|
339
|
|
|
|
|
|
|
} |
|
340
|
|
|
|
|
|
|
# the advice is now disabled |
|
341
|
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
If the advice is created in void context, it remains enabled until the |
|
343
|
|
|
|
|
|
|
interperter dies, or the symbol table reloaded. |
|
344
|
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
=head2 ASPECTS |
|
346
|
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
Aspects are just plain old Perl objects, that install advice, and do |
|
348
|
|
|
|
|
|
|
other AOPish things, like install methods on other classes, or mess |
|
349
|
|
|
|
|
|
|
around with the inheritance hierarchy of other classes. A good base class |
|
350
|
|
|
|
|
|
|
for them is L, but you can use any Perl object. |
|
351
|
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
If the aspect class exists in the package C, then it can |
|
353
|
|
|
|
|
|
|
be easily created: |
|
354
|
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
aspect Singleton => 'Company::create'; |
|
356
|
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
Will create an L object. This reusable aspect |
|
358
|
|
|
|
|
|
|
is included in the C distribution, and forces singleton behavior |
|
359
|
|
|
|
|
|
|
on some constructor, in this case, C. |
|
360
|
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
Such aspects, like advice, are enabled as long as they are in scope. |
|
362
|
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
=head1 INTERNALS |
|
364
|
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
Due to the dynamic nature of Perl, and thanks to C, there |
|
366
|
|
|
|
|
|
|
is no need for processing of source or byte code, as required in the Java |
|
367
|
|
|
|
|
|
|
and .NET worlds. |
|
368
|
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
The implementation is very simple: when you create advice, its pointcut |
|
370
|
|
|
|
|
|
|
is matched using C. Every sub defined in the symbol table |
|
371
|
|
|
|
|
|
|
is matched against the pointcut. Those that match, will get a special |
|
372
|
|
|
|
|
|
|
wrapper installed, using C. The wrapper only runs if |
|
373
|
|
|
|
|
|
|
during run-time, the C of the pointcut returns true. |
|
374
|
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
The wrapper code creates an advice context, and gives it to the advice |
|
376
|
|
|
|
|
|
|
code. |
|
377
|
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
The C pointcut is static, so C always returns true, |
|
379
|
|
|
|
|
|
|
and C returns true if the sub name matches the pointcut |
|
380
|
|
|
|
|
|
|
spec. |
|
381
|
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
The C pointcut is dynamic, so C always returns |
|
383
|
|
|
|
|
|
|
true, but C return true only if some frame in the call flow |
|
384
|
|
|
|
|
|
|
matches the pointcut spec. |
|
385
|
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
=head1 LIMITATIONS |
|
387
|
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=over |
|
389
|
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
=item Inheritance Support |
|
391
|
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
Support for inheritance is lacking. Consider the following two classes: |
|
393
|
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
package Automobile; |
|
395
|
|
|
|
|
|
|
... |
|
396
|
|
|
|
|
|
|
sub compute_mileage { ... } |
|
397
|
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
package Van; |
|
399
|
|
|
|
|
|
|
use base 'Automobile'; |
|
400
|
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
And the following two advice: |
|
402
|
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
before { print "Automobile!\n" } call 'Automobile::compute_mileage'; |
|
404
|
|
|
|
|
|
|
before { print "Van!\n" } call 'Van::compute_mileage'; |
|
405
|
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
Some join points one would expect to be matched by the call pointcuts |
|
407
|
|
|
|
|
|
|
above, do not: |
|
408
|
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
$automobile = Automobile->new; |
|
410
|
|
|
|
|
|
|
$van = Van->new; |
|
411
|
|
|
|
|
|
|
$automobile->compute_mileage; # Automobile! |
|
412
|
|
|
|
|
|
|
$van->compute_mileage; # Automobile!, should also print Van! |
|
413
|
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
C will never be printed. This happens because C installs |
|
415
|
|
|
|
|
|
|
advice code on symbol table entries. C does not |
|
416
|
|
|
|
|
|
|
have one, so nothing happens. Until this is solved, you have to do the |
|
417
|
|
|
|
|
|
|
thinking about inheritance yourself. |
|
418
|
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
=item Performance |
|
420
|
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
You may find it very easy to shoot yourself in the foot with this module. |
|
422
|
|
|
|
|
|
|
Consider this advice: |
|
423
|
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
# do not do this! |
|
425
|
|
|
|
|
|
|
before { print shift->sub_name } |
|
426
|
|
|
|
|
|
|
cflow company => 'MyApp::Company::make_report'; |
|
427
|
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
The advice code will be installed on every sub loaded. The advice code |
|
429
|
|
|
|
|
|
|
will only run when in the specified call flow, which is the correct |
|
430
|
|
|
|
|
|
|
behavior, but it will be I on every sub in the system. This |
|
431
|
|
|
|
|
|
|
can be slow. It happens because the C pointcut matches I |
|
432
|
|
|
|
|
|
|
subs during weave-time. It matches the correct sub during run-time. The |
|
433
|
|
|
|
|
|
|
solution is to narrow the pointcut: |
|
434
|
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
# much better |
|
436
|
|
|
|
|
|
|
before { print shift->sub_name } |
|
437
|
|
|
|
|
|
|
call qr/^MyApp::/ & cflow company => 'MyApp::Company::make_report'; |
|
438
|
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
=back |
|
440
|
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
See the C file in the distribution for possible solutions. |
|
442
|
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
=head1 BUGS |
|
444
|
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
None known so far. If you find any bugs or oddities, please do inform the |
|
446
|
|
|
|
|
|
|
maintainer. |
|
447
|
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
=head1 AUTHOR |
|
449
|
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
Marcel GrEnauer , Ran Eilam . |
|
451
|
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=head1 COPYRIGHT |
|
453
|
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
Copyright 2001-2002 Marcel GrEnauer. All rights reserved. |
|
455
|
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
|
457
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
|
458
|
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
460
|
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
You can find AOP examples in the C directory of the |
|
462
|
|
|
|
|
|
|
distribution. |
|
463
|
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
=cut |