package Class::MOP::Method;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'reftype', 'blessed';
our $VERSION = '0.06';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Class::MOP::Object';
# NOTE:
# if poked in the right way,
# they should act like CODE refs.
use overload '&{}' => sub { $_[0]->body }, fallback => 1;
# construction
sub wrap {
my $class = shift;
my $code = shift;
('CODE' eq (reftype($code) || ''))
|| confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
bless {
'&!body' => $code
} => blessed($class) || $class;
}
## accessors
sub body { (shift)->{'&!body'} }
# TODO - add associated_class
# informational
# NOTE:
# this may not be the same name
# as the class you got it from
# This gets the package stash name
# associated with the actual CODE-ref
sub package_name {
my $code = (shift)->body;
(Class::MOP::get_code_info($code))[0];
}
# NOTE:
# this may not be the same name
# as the method name it is stored
# with. This gets the name associated
# with the actual CODE-ref
sub name {
my $code = (shift)->body;
(Class::MOP::get_code_info($code))[1];
}
sub fully_qualified_name {
my $code = shift;
$code->package_name . '::' . $code->name;
}
1;
__END__
=pod
=head1 NAME
Class::MOP::Method - Method Meta Object
=head1 DESCRIPTION
The Method Protocol is very small, since methods in Perl 5 are just
subroutines within the particular package. We provide a very basic
introspection interface.
=head1 METHODS
=head2 Introspection
=over 4
=item B
This will return a B instance which is related
to this class.
=back
=head2 Construction
=over 4
=item B
This is the basic constructor, it returns a B
instance which wraps the given C<$code> reference.
=back
=head2 Informational
=over 4
=item B
This returns the actual CODE reference of the particular instance.
=item B
This returns the name of the CODE reference.
=item B
This returns the package name that the CODE reference is attached to.
=item B
This returns the fully qualified name of the CODE reference.
=back
=head1 AUTHORS
Stevan Little Estevan@iinteractive.comE
=head1 COPYRIGHT AND LICENSE
Copyright 2006-2008 by Infinity Interactive, Inc.
L
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut