| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package asa; |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=pod |
|
4
|
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
|
6
|
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
asa - Lets your class/object say it works like something else |
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
######################################### |
|
12
|
|
|
|
|
|
|
# Your Code |
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
package My::WereDuck; |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
use base 'My::Lycanthrope'; |
|
17
|
|
|
|
|
|
|
use asa 'Duck'; |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub quack { |
|
20
|
|
|
|
|
|
|
return "Hi! errr... Quack!"; |
|
21
|
|
|
|
|
|
|
} |
|
22
|
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
################################################ |
|
24
|
|
|
|
|
|
|
# Their Code |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub strangle { |
|
27
|
|
|
|
|
|
|
my $duck = shift; |
|
28
|
|
|
|
|
|
|
unless ( $duck->isa('Duck') ) { |
|
29
|
|
|
|
|
|
|
die "We only strangle ducks"; |
|
30
|
|
|
|
|
|
|
} |
|
31
|
|
|
|
|
|
|
print "Farmer Joe wrings the duck's neck\n"; |
|
32
|
|
|
|
|
|
|
print "Said the duck, '" . $duck->quack . "'\n"; |
|
33
|
|
|
|
|
|
|
print "We ate well that night.\n"; |
|
34
|
|
|
|
|
|
|
} |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
37
|
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
Perl 5 doesn't natively support Java-style interfaces, and it doesn't |
|
39
|
|
|
|
|
|
|
support Perl 6 style roles either. |
|
40
|
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
You can get both of these things in half a dozen different ways via |
|
42
|
|
|
|
|
|
|
various CPAN modules, but they usually require that you buy into "their |
|
43
|
|
|
|
|
|
|
way" of implementing your code. |
|
44
|
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
Other have turned to "duck typing". |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
This is, for the most part, a fairly naive check that says "can you do |
|
48
|
|
|
|
|
|
|
this method", under the "if it looks like a duck, and quacks like a duck, |
|
49
|
|
|
|
|
|
|
then it must be a duck". |
|
50
|
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
It assumes that if you have a C<-Equack> method, then they will treat |
|
52
|
|
|
|
|
|
|
you as a duck, because doing things like adding C to your C<@ISA> |
|
53
|
|
|
|
|
|
|
array means you are also forced to take their implementation. |
|
54
|
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
There is, of course, a better way. |
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
For better or worse, Perl's C<-Eisa> functionality to determine if |
|
58
|
|
|
|
|
|
|
something is or is not a particular class/object is defined as a B, |
|
59
|
|
|
|
|
|
|
not a function, and so that means that as well as adding something to you |
|
60
|
|
|
|
|
|
|
C<@ISA> array, so that Perl's C method can work with it, |
|
61
|
|
|
|
|
|
|
you are also allowed to simply overload your own C method and answer |
|
62
|
|
|
|
|
|
|
directly whether or not you are something. |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
The simplest form of the idiom looks like this. |
|
65
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub isa { |
|
67
|
|
|
|
|
|
|
return 1 if $_[1] eq 'Duck'; |
|
68
|
|
|
|
|
|
|
shift->SUPER::isa(@_); |
|
69
|
|
|
|
|
|
|
} |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
This reads "Check my type as normal, but if anyone wants to know if I'm a |
|
72
|
|
|
|
|
|
|
duck, then tell them yes". |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
Now, there are a few people that have argued that this is "lying" about |
|
75
|
|
|
|
|
|
|
your class, but this argument is based on the idea that C<@ISA> is |
|
76
|
|
|
|
|
|
|
somehow more "real" than using the method directly. |
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
It also assumes that what you advertise you implement needs to be in sync |
|
79
|
|
|
|
|
|
|
with the method resolution for any given function. But in the best and |
|
80
|
|
|
|
|
|
|
cleanest implementation of code, the API is orthogonal (although most often |
|
81
|
|
|
|
|
|
|
related) to the implementation. |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
And although C<@ISA> is about implementation B API, overloading C |
|
84
|
|
|
|
|
|
|
to let you change your API is not at all bad when seen in this light. |
|
85
|
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=head2 What does asa.pm do? |
|
87
|
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
Much as L provides convenient syntactic sugar for loading your |
|
89
|
|
|
|
|
|
|
parent class and setting C<@ISA>, this pragma will provide convenient |
|
90
|
|
|
|
|
|
|
syntactic sugar for creating your own custom overloaded isa functions. |
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
Beyond just the idiom above, it implements various workarounds for some |
|
93
|
|
|
|
|
|
|
edge cases, so you don't have to, and allows clear seperation of concerns. |
|
94
|
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
You should just be able to use it, and if something ever goes wrong, then |
|
96
|
|
|
|
|
|
|
it's my fault, and I'll fix it. |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=head2 What doesn't asa.pm do? |
|
99
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
In Perl, highly robust introspection is B hard. Which is why most |
|
101
|
|
|
|
|
|
|
modules that provide some level of interface functionality require you to |
|
102
|
|
|
|
|
|
|
explicitly define them in multiple classes, and start to tread on your |
|
103
|
|
|
|
|
|
|
toes. |
|
104
|
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
This class does B do any strict enforcement of interfaces. 90% of the |
|
106
|
|
|
|
|
|
|
time, what you want to do, and the methods you need to implement, are going |
|
107
|
|
|
|
|
|
|
to be pretty obvious, so it's your fault if you don't provide them. |
|
108
|
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
But at least this way, you can implement them however you like, and C |
|
110
|
|
|
|
|
|
|
will just take care of the details of safely telling everyone else you are |
|
111
|
|
|
|
|
|
|
a duck :) |
|
112
|
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=head2 What if a Duck method clashes with a My::Package method? |
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Unlike Perl 6, which implements a concept called "multi-methods", Perl 5 |
|
116
|
|
|
|
|
|
|
does not have a native approach to solving the problem of "API collision". |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
Originally from the Java/C++ world, the problem of overcoming language |
|
119
|
|
|
|
|
|
|
API limitations can be done through the use of one of several "design |
|
120
|
|
|
|
|
|
|
patterns". |
|
121
|
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
For you, the victim of API collision, you might be interested in the |
|
123
|
|
|
|
|
|
|
"Adapter" pattern. |
|
124
|
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
For more information on implementing the Adapter pattern in Perl, see |
|
126
|
|
|
|
|
|
|
L, which provides a veritable toolkit for creating |
|
127
|
|
|
|
|
|
|
an implementation of the Adapter pattern which can solve your problem. |
|
128
|
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=cut |
|
130
|
|
|
|
|
|
|
|
|
131
|
2
|
|
|
2
|
|
48238
|
use 5.005; |
|
|
2
|
|
|
|
|
7
|
|
|
|
2
|
|
|
|
|
87
|
|
|
132
|
2
|
|
|
2
|
|
34
|
use strict; |
|
|
2
|
|
|
|
|
2
|
|
|
|
2
|
|
|
|
|
90
|
|
|
133
|
2
|
|
|
2
|
|
20
|
use Carp (); |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
40
|
|
|
134
|
|
|
|
|
|
|
|
|
135
|
2
|
|
|
2
|
|
33
|
use vars qw{$VERSION}; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
386
|
|
|
136
|
|
|
|
|
|
|
BEGIN { |
|
137
|
2
|
|
|
2
|
|
506
|
$VERSION = '1.03'; |
|
138
|
|
|
|
|
|
|
} |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub import { |
|
141
|
2
|
|
|
2
|
|
929
|
my $class = shift; |
|
142
|
2
|
|
|
|
|
6
|
my $have = caller(0); |
|
143
|
3
|
|
|
|
|
78
|
my $code = join '', |
|
144
|
|
|
|
|
|
|
"package $have;\n", |
|
145
|
|
|
|
|
|
|
"\n", |
|
146
|
|
|
|
|
|
|
"sub isa {\n", |
|
147
|
2
|
|
|
|
|
7
|
( map { "\treturn 1 if \$_[1] eq '$_';\n" } @_ ), |
|
148
|
|
|
|
|
|
|
"\tshift->SUPER::isa(\@_);\n", |
|
149
|
|
|
|
|
|
|
"}\n"; |
|
150
|
2
|
100
|
|
3
|
|
148
|
eval( $code ); |
|
|
3
|
100
|
|
4
|
|
6964
|
|
|
|
2
|
100
|
|
|
|
252
|
|
|
|
4
|
|
|
|
|
7212
|
|
|
|
3
|
|
|
|
|
14
|
|
|
|
2
|
|
|
|
|
20
|
|
|
151
|
2
|
50
|
|
|
|
10
|
Carp::croak( "Failed to create isa method: $@" ) if $@; |
|
152
|
2
|
|
|
|
|
2148
|
return 1; |
|
153
|
|
|
|
|
|
|
} |
|
154
|
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
1; |
|
156
|
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=pod |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=head1 SUPPORT |
|
160
|
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
Bugs should be always be reported via the CPAN bug tracker at |
|
162
|
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
L |
|
164
|
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
For other issues, or commercial enhancement or support, contact the author. |
|
166
|
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=head1 AUTHORS |
|
168
|
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
Adam Kennedy Eadamk@cpan.orgE |
|
170
|
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
172
|
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
L |
|
174
|
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=head1 COPYRIGHT |
|
176
|
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
Copyright 2006 - 2011 Adam Kennedy. |
|
178
|
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
This program is free software; you can redistribute |
|
180
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself. |
|
181
|
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
The full text of the license can be found in the |
|
183
|
|
|
|
|
|
|
LICENSE file included with this module. |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=cut |