[gitmo/Class-MOP.git] / lib / Class / MOP / Method.pm


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<meta>

This will return a B<Class::MOP::Class> instance which is related 
to this class.

=back

=head2 Construction

=over 4

=item B<wrap ($code)>

This is the basic constructor, it returns a B<Class::MOP::Method> 
instance which wraps the given C<$code> reference.

=back

=head2 Informational

=over 4

=item B<body>

This returns the actual CODE reference of the particular instance.

=item B<name>

This returns the name of the CODE reference.

=item B<package_name>

This returns the package name that the CODE reference is attached to.

=item B<fully_qualified_name>

This returns the fully qualified name of the CODE reference.

=back

=head1 AUTHORS

Stevan Little E<lt>stevan@iinteractive.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006-2008 by Infinity Interactive, Inc.

L<http://www.iinteractive.com>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut
Commit	Line	Data
8b978dd5	1
	2	package Class::MOP::Method;
	3
	4	use strict;
	5	use warnings;
	6
2eb717d5	7	use Carp 'confess';
aa448b16	8	use Scalar::Util 'reftype', 'blessed';
2eb717d5	9
d7b2249e	10	our $VERSION = '0.06';
f0480c45	11	our $AUTHORITY = 'cpan:STEVAN';
de19f115	12
b1897d4d	13	use base 'Class::MOP::Object';
b1897d4d	14
ce2ae40f	15	# NOTE:
	16	# if poked in the right way,
	17	# they should act like CODE refs.
c23184fc	18	use overload '&{}' => sub { $_[0]->body }, fallback => 1;
7855ddba	19
de19f115	20	# construction
de19f115	21
a4258ffd	22	sub wrap {
2eb717d5	23	my $class = shift;
2eb717d5	24	my $code = shift;
ee5e71d4	25	('CODE' eq (reftype($code) \|\| ''))
4d47b77f	26	\|\| confess "You must supply a CODE reference to bless, not (" . ($code \|\| 'undef') . ")";
7855ddba	27	bless {
c23184fc	28	'&!body' => $code
7855ddba	29	} => blessed($class) \|\| $class;
de19f115	30	}
de19f115	31
ce2ae40f	32	## accessors
ce2ae40f	33
c23184fc	34	sub body { (shift)->{'&!body'} }
7855ddba	35
b1897d4d	36	# TODO - add associated_class
b1897d4d	37
de19f115	38	# informational
de19f115	39
ce2ae40f	40	# NOTE:
	41	# this may not be the same name
	42	# as the class you got it from
	43	# This gets the package stash name
	44	# associated with the actual CODE-ref
de19f115	45	sub package_name {
c23184fc	46	my $code = (shift)->body;
e0e4674a	47	(Class::MOP::get_code_info($code))[0];
de19f115	48	}
de19f115	49
ce2ae40f	50	# NOTE:
	51	# this may not be the same name
	52	# as the method name it is stored
	53	# with. This gets the name associated
	54	# with the actual CODE-ref
de19f115	55	sub name {
c23184fc	56	my $code = (shift)->body;
e0e4674a	57	(Class::MOP::get_code_info($code))[1];
2eb717d5	58	}
de19f115	59
96ceced8	60	sub fully_qualified_name {
96ceced8	61	my $code = shift;
96ceced8	62	$code->package_name . '::' . $code->name;
	63	}
	64
8b978dd5	65	1;
	66
	67	__END__
	68
	69	=pod
	70
	71	=head1 NAME
	72
	73	Class::MOP::Method - Method Meta Object
	74
8b978dd5	75	=head1 DESCRIPTION
8b978dd5	76
552e3d24	77	The Method Protocol is very small, since methods in Perl 5 are just
86482605	78	subroutines within the particular package. We provide a very basic
86482605	79	introspection interface.
fe122940	80
2eb717d5	81	=head1 METHODS
2eb717d5	82
de19f115	83	=head2 Introspection
2eb717d5	84
de19f115	85	=over 4
fe122940	86
2eb717d5	87	=item B<meta>
2eb717d5	88
fe122940	89	This will return a B<Class::MOP::Class> instance which is related
	90	to this class.
	91
2eb717d5	92	=back
2eb717d5	93
de19f115	94	=head2 Construction
	95
	96	=over 4
	97
127d39a7	98	=item B<wrap ($code)>
	99
	100	This is the basic constructor, it returns a B<Class::MOP::Method>
	101	instance which wraps the given C<$code> reference.
de19f115	102
de19f115	103	=back
	104
	105	=head2 Informational
	106
	107	=over 4
	108
7855ddba	109	=item B<body>
7855ddba	110
127d39a7	111	This returns the actual CODE reference of the particular instance.
127d39a7	112
de19f115	113	=item B<name>
de19f115	114
127d39a7	115	This returns the name of the CODE reference.
127d39a7	116
de19f115	117	=item B<package_name>
de19f115	118
127d39a7	119	This returns the package name that the CODE reference is attached to.
127d39a7	120
96ceced8	121	=item B<fully_qualified_name>
96ceced8	122
127d39a7	123	This returns the fully qualified name of the CODE reference.
127d39a7	124
96ceced8	125	=back
96ceced8	126
1a09d9cc	127	=head1 AUTHORS
8b978dd5	128
a2e85e6c	129	Stevan Little E<lt>stevan@iinteractive.comE<gt>
8b978dd5	130
	131	=head1 COPYRIGHT AND LICENSE
	132
69e3ab0a	133	Copyright 2006-2008 by Infinity Interactive, Inc.
8b978dd5	134
	135	L<http://www.iinteractive.com>
	136
	137	This library is free software; you can redistribute it and/or modify
	138	it under the same terms as Perl itself.
	139
16e960bd	140	=cut
16e960bd	141