[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';
use B            'svref_2object';

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

# introspection

sub meta { 
    require Class::MOP::Class;
    Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
}

# 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};
	svref_2object($code)->GV->STASH->NAME;
}

# 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};
	svref_2object($code)->GV->NAME;
}

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

1;

__END__

=pod

=head1 NAME 

Class::MOP::Method - Method Meta Object

=head1 SYNOPSIS

  # ... more to come later maybe

=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)>

=back

=head2 Informational

=over 4

=item B<body>

=item B<name>

=item B<package_name>

=item B<fully_qualified_name>

=back

=head1 AUTHORS

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

Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>

=head1 COPYRIGHT AND LICENSE

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