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 |