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


package Class::MOP::Method;

use strict;
use warnings;

use Carp         'confess';
use Scalar::Util 'blessed';

our $VERSION   = '0.65';
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;

our $UPGRADE_ERROR_TEXT = q{
---------------------------------------------------------
NOTE: this error is likely not an error, but a regression
caused by the latest upgrade to Moose/Class::MOP. Consider
upgrading any MooseX::* modules to their latest versions
before spending too much time chasing this one down.
---------------------------------------------------------
};

# construction

sub wrap {
    my ( $class, $code, %params ) = @_;

    ('CODE' eq ref($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 $UPGRADE_ERROR_TEXT";

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