Remove unnecessary calls of has_method()
[gitmo/Class-MOP.git] / lib / Class / MOP / Method.pm
CommitLineData
8b978dd5 1
2package Class::MOP::Method;
3
4use strict;
5use warnings;
6
2eb717d5 7use Carp 'confess';
3ea3a033 8use Scalar::Util 'weaken', 'reftype';
2eb717d5 9
074ec38f 10our $VERSION = '0.89';
d519662a 11$VERSION = eval $VERSION;
f0480c45 12our $AUTHORITY = 'cpan:STEVAN';
de19f115 13
b1897d4d 14use base 'Class::MOP::Object';
15
ce2ae40f 16# NOTE:
32202ce2 17# if poked in the right way,
ce2ae40f 18# they should act like CODE refs.
c23184fc 19use overload '&{}' => sub { $_[0]->body }, fallback => 1;
7855ddba 20
de19f115 21# construction
22
32202ce2 23sub wrap {
5caf45ce 24 my ( $class, @args ) = @_;
25
26 unshift @args, 'body' if @args % 2 == 1;
27
28 my %params = @args;
29 my $code = $params{body};
32202ce2 30
3ea3a033 31 (ref $code && 'CODE' eq reftype($code))
4d47b77f 32 || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
32202ce2 33
b38f3848 34 ($params{package_name} && $params{name})
e7cfb28b 35 || confess "You must supply the package_name and name parameters";
32202ce2 36
c2829bbc 37 my $self = $class->_new(\%params);
5e607260 38
39 weaken($self->{associated_metaclass}) if $self->{associated_metaclass};
40
41 return $self;
de19f115 42}
43
71b98d4f 44sub _new {
0bfc85b8 45 my $class = shift;
812d58f9 46
ec9e38e5 47 return Class::MOP::Class->initialize($class)->new_object(@_)
812d58f9 48 if $class ne __PACKAGE__;
ec9e38e5 49
0bfc85b8 50 my $params = @_ == 1 ? $_[0] : {@_};
71b98d4f 51
ec9e38e5 52 return bless {
0bfc85b8 53 'body' => $params->{body},
54 'associated_metaclass' => $params->{associated_metaclass},
55 'package_name' => $params->{package_name},
56 'name' => $params->{name},
ec9e38e5 57 'original_method' => $params->{original_method},
71b98d4f 58 } => $class;
59}
60
ce2ae40f 61## accessors
62
5e607260 63sub associated_metaclass { shift->{'associated_metaclass'} }
b1897d4d 64
5e607260 65sub attach_to_class {
66 my ( $self, $class ) = @_;
67 $self->{associated_metaclass} = $class;
68 weaken($self->{associated_metaclass});
69}
70
71sub detach_from_class {
72 my $self = shift;
73 delete $self->{associated_metaclass};
74}
de19f115 75
96ceced8 76sub fully_qualified_name {
91b73829 77 my $self = shift;
78 $self->package_name . '::' . $self->name;
96ceced8 79}
80
2226a8b0 81sub original_method { (shift)->{'original_method'} }
82
83sub _set_original_method { $_[0]->{'original_method'} = $_[1] }
84
85# It's possible that this could cause a loop if there is a circular
86# reference in here. That shouldn't ever happen in normal
87# circumstances, since original method only gets set when clone is
88# called. We _could_ check for such a loop, but it'd involve some sort
89# of package-lexical variable, and wouldn't be terribly subclassable.
90sub original_package_name {
91 my $self = shift;
92
93 $self->original_method
94 ? $self->original_method->original_package_name
95 : $self->package_name;
96}
97
98sub original_name {
99 my $self = shift;
100
101 $self->original_method
102 ? $self->original_method->original_name
103 : $self->name;
104}
105
106sub original_fully_qualified_name {
107 my $self = shift;
108
109 $self->original_method
110 ? $self->original_method->original_fully_qualified_name
111 : $self->fully_qualified_name;
112}
113
25a5f083 114sub execute {
115 my $self = shift;
116 $self->body->(@_);
117}
118
4c105333 119# NOTE:
120# the Class::MOP bootstrap
121# will create this for us
122# - SL
123# sub clone { ... }
124
8b978dd5 1251;
126
127__END__
128
129=pod
130
32202ce2 131=head1 NAME
8b978dd5 132
133Class::MOP::Method - Method Meta Object
134
8b978dd5 135=head1 DESCRIPTION
136
32202ce2 137The Method Protocol is very small, since methods in Perl 5 are just
8a0b1202 138subroutines in a specific package. We provide a very basic
86482605 139introspection interface.
fe122940 140
2eb717d5 141=head1 METHODS
142
de19f115 143=over 4
fe122940 144
8a0b1202 145=item B<< Class::MOP::Method->wrap($code, %options) >>
2eb717d5 146
8a0b1202 147This is the constructor. It accepts a subroutine reference and a hash
148of options.
fe122940 149
8a0b1202 150The options are:
2eb717d5 151
8a0b1202 152=over 8
de19f115 153
8a0b1202 154=item * name
155
156The method name (without a package name). This is required.
de19f115 157
8a0b1202 158=item * package_name
127d39a7 159
8a0b1202 160The package name for the method. This is required.
4c105333 161
8a0b1202 162=item * associated_metaclass
4c105333 163
8a0b1202 164An optional L<Class::MOP::Class> object. This is the metaclass for the
165method's class.
de19f115 166
de19f115 167=back
168
8a0b1202 169=item B<< $metamethod->clone(%params) >>
de19f115 170
8a0b1202 171This makes a shallow clone of the method object. In particular,
172subroutine reference itself is shared between all clones of a given
173method.
174
175When a method is cloned, the original method object will be available
176by calling C<original_method> on the clone.
de19f115 177
8a0b1202 178=item B<< $metamethod->body >>
7855ddba 179
8a0b1202 180This returns a reference to the method's subroutine.
127d39a7 181
8a0b1202 182=item B<< $metamethod->name >>
de19f115 183
8a0b1202 184This returns the method's name
127d39a7 185
8a0b1202 186=item B<< $metamethod->package_name >>
5e607260 187
8a0b1202 188This returns the method's package name.
5e607260 189
8a0b1202 190=item B<< $metamethod->fully_qualified_name >>
de19f115 191
8a0b1202 192This returns the method's fully qualified name (package name and
193method name).
127d39a7 194
8a0b1202 195=item B<< $metamethod->associated_metaclass >>
96ceced8 196
8a0b1202 197This returns the L<Class::MOP::Class> object for the method, if one
198exists.
127d39a7 199
8a0b1202 200=item B<< $metamethod->original_method >>
2226a8b0 201
202If this method object was created as a clone of some other method
203object, this returns the object that was cloned.
204
8a0b1202 205=item B<< $metamethod->original_name >>
2226a8b0 206
8a0b1202 207This returns the method's original name, wherever it was first
208defined.
2226a8b0 209
2f011227 210If this method is a clone of a clone (of a clone, etc.), this method
211returns the name from the I<first> method in the chain of clones.
212
8a0b1202 213=item B<< $metamethod->original_package_name >>
2226a8b0 214
8a0b1202 215This returns the method's original package name, wherever it was first
216defined.
2226a8b0 217
2f011227 218If this method is a clone of a clone (of a clone, etc.), this method
219returns the package name from the I<first> method in the chain of
220clones.
221
8a0b1202 222=item B<< $metamethod->original_fully_qualified_name >>
2226a8b0 223
8a0b1202 224This returns the method's original fully qualified name, wherever it
225was first defined.
2226a8b0 226
2f011227 227If this method is a clone of a clone (of a clone, etc.), this method
228returns the fully qualified name from the I<first> method in the chain
229of clones.
230
8a0b1202 231=item B<< $metamethod->attach_to_class($metaclass) >>
96ceced8 232
8a0b1202 233Given a L<Class::MOP::Class> object, this method sets the associated
234metaclass for the method. This will overwrite any existing associated
235metaclass.
5e607260 236
8a0b1202 237=item B<< $metamethod->detach_from_class >>
5e607260 238
8a0b1202 239Removes any associated metaclass object for the method.
5e607260 240
8a0b1202 241=item B<< $metamethod->execute(...) >>
5e607260 242
8a0b1202 243This executes the method. Any arguments provided will be passed on to
244the method itself.
25a5f083 245
8a0b1202 246=item B<< Class::MOP::Method->meta >>
25a5f083 247
8a0b1202 248This will return a L<Class::MOP::Class> instance for this class.
25a5f083 249
8a0b1202 250It should also be noted that L<Class::MOP> will actually bootstrap
251this module by installing a number of attribute meta-objects into its
252metaclass.
25a5f083 253
254=back
255
1a09d9cc 256=head1 AUTHORS
8b978dd5 257
a2e85e6c 258Stevan Little E<lt>stevan@iinteractive.comE<gt>
8b978dd5 259
260=head1 COPYRIGHT AND LICENSE
261
070bb6c9 262Copyright 2006-2009 by Infinity Interactive, Inc.
8b978dd5 263
264L<http://www.iinteractive.com>
265
266This library is free software; you can redistribute it and/or modify
32202ce2 267it under the same terms as Perl itself.
8b978dd5 268
16e960bd 269=cut
270