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 |