[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.07';
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, $code, %params ) = @_;
    
    ('CODE' eq (reftype($code) || ''))
        || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
    
    ($params{package_name} && $params{name})
        || confess "You must supply the package_name and name parameters";
    
    bless { 
        '&!body'         => $code,
        '$!package_name' => $params{package_name},
        '$!name'         => $params{name}, 
    } => blessed($class) || $class;
}

## accessors

sub body { (shift)->{'&!body'} }

# TODO - add associated_class

# informational

sub package_name { 
    my $self = shift;
    $self->{'$!package_name'} ||= (Class::MOP::get_code_info($self->body))[0];
}

sub name { 
    my $self = shift;
    $self->{'$!name'} ||= (Class::MOP::get_code_info($self->body))[1];
}

sub fully_qualified_name {
    my $code = shift;
    $code->package_name . '::' . $code->name;
}

# NOTE:
# the Class::MOP bootstrap
# will create this for us
# - SL
# sub clone { ... }

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, %params)>

This is the basic constructor, it returns a B<Class::MOP::Method> 
instance which wraps the given C<$code> reference. You can also 
set the C<package_name> and C<name> attributes using the C<%params>.
If these are not set, then thier accessors will attempt to figure 
it out using the C<Class::MOP::get_code_info> function.

=item B<clone (%params)>

This will make a copy of the object, allowing you to override 
any values by stuffing them in C<%params>.

=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
4c105333	10	our $VERSION = '0.07';
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 {
4c105333	23	my ( $class, $code, %params ) = @_;
4c105333	24
ee5e71d4	25	('CODE' eq (reftype($code) \|\| ''))
4d47b77f	26	\|\| confess "You must supply a CODE reference to bless, not (" . ($code \|\| 'undef') . ")";
4c105333	27
b38f3848	28	($params{package_name} && $params{name})
	29	\|\| confess "You must supply the package_name and name parameters";
	30
7855ddba	31	bless {
4c105333	32	'&!body' => $code,
	33	'$!package_name' => $params{package_name},
	34	'$!name' => $params{name},
7855ddba	35	} => blessed($class) \|\| $class;
de19f115	36	}
de19f115	37
ce2ae40f	38	## accessors
ce2ae40f	39
c23184fc	40	sub body { (shift)->{'&!body'} }
7855ddba	41
b1897d4d	42	# TODO - add associated_class
b1897d4d	43
de19f115	44	# informational
	45
	46	sub package_name {
4c105333	47	my $self = shift;
4c105333	48	$self->{'$!package_name'} \|\|= (Class::MOP::get_code_info($self->body))[0];
de19f115	49	}
	50
	51	sub name {
4c105333	52	my $self = shift;
4c105333	53	$self->{'$!name'} \|\|= (Class::MOP::get_code_info($self->body))[1];
2eb717d5	54	}
de19f115	55
96ceced8	56	sub fully_qualified_name {
4c105333	57	my $code = shift;
4c105333	58	$code->package_name . '::' . $code->name;
96ceced8	59	}
96ceced8	60
4c105333	61	# NOTE:
	62	# the Class::MOP bootstrap
	63	# will create this for us
	64	# - SL
	65	# sub clone { ... }
	66
8b978dd5	67	1;
	68
	69	__END__
	70
	71	=pod
	72
	73	=head1 NAME
	74
	75	Class::MOP::Method - Method Meta Object
	76
8b978dd5	77	=head1 DESCRIPTION
8b978dd5	78
552e3d24	79	The Method Protocol is very small, since methods in Perl 5 are just
86482605	80	subroutines within the particular package. We provide a very basic
86482605	81	introspection interface.
fe122940	82
2eb717d5	83	=head1 METHODS
2eb717d5	84
de19f115	85	=head2 Introspection
2eb717d5	86
de19f115	87	=over 4
fe122940	88
2eb717d5	89	=item B<meta>
2eb717d5	90
fe122940	91	This will return a B<Class::MOP::Class> instance which is related
	92	to this class.
	93
2eb717d5	94	=back
2eb717d5	95
de19f115	96	=head2 Construction
	97
	98	=over 4
	99
4c105333	100	=item B<wrap ($code, %params)>
127d39a7	101
127d39a7	102	This is the basic constructor, it returns a B<Class::MOP::Method>
4c105333	103	instance which wraps the given C<$code> reference. You can also
	104	set the C<package_name> and C<name> attributes using the C<%params>.
	105	If these are not set, then thier accessors will attempt to figure
	106	it out using the C<Class::MOP::get_code_info> function.
	107
	108	=item B<clone (%params)>
	109
	110	This will make a copy of the object, allowing you to override
	111	any values by stuffing them in C<%params>.
de19f115	112
de19f115	113	=back
	114
	115	=head2 Informational
	116
	117	=over 4
	118
7855ddba	119	=item B<body>
7855ddba	120
127d39a7	121	This returns the actual CODE reference of the particular instance.
127d39a7	122
de19f115	123	=item B<name>
de19f115	124
127d39a7	125	This returns the name of the CODE reference.
127d39a7	126
de19f115	127	=item B<package_name>
de19f115	128
127d39a7	129	This returns the package name that the CODE reference is attached to.
127d39a7	130
96ceced8	131	=item B<fully_qualified_name>
96ceced8	132
127d39a7	133	This returns the fully qualified name of the CODE reference.
127d39a7	134
96ceced8	135	=back
96ceced8	136
1a09d9cc	137	=head1 AUTHORS
8b978dd5	138
a2e85e6c	139	Stevan Little E<lt>stevan@iinteractive.comE<gt>
8b978dd5	140
	141	=head1 COPYRIGHT AND LICENSE
	142
69e3ab0a	143	Copyright 2006-2008 by Infinity Interactive, Inc.
8b978dd5	144
	145	L<http://www.iinteractive.com>
	146
	147	This library is free software; you can redistribute it and/or modify
	148	it under the same terms as Perl itself.
	149
16e960bd	150	=cut
16e960bd	151