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'; |
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 |
21 | ||
a4258ffd | 22 | sub wrap { |
2eb717d5 | 23 | my $class = shift; |
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 | } |
31 | ||
ce2ae40f | 32 | ## accessors |
33 | ||
c23184fc | 34 | sub body { (shift)->{'&!body'} } |
7855ddba | 35 | |
b1897d4d | 36 | # TODO - add associated_class |
37 | ||
de19f115 | 38 | # informational |
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 | } |
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 { |
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 |
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 |
79 | introspection interface. | |
fe122940 | 80 | |
2eb717d5 | 81 | =head1 METHODS |
82 | ||
de19f115 | 83 | =head2 Introspection |
2eb717d5 | 84 | |
de19f115 | 85 | =over 4 |
fe122940 | 86 | |
2eb717d5 | 87 | =item B<meta> |
88 | ||
fe122940 | 89 | This will return a B<Class::MOP::Class> instance which is related |
90 | to this class. | |
91 | ||
2eb717d5 | 92 | =back |
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> |
110 | ||
127d39a7 | 111 | This returns the actual CODE reference of the particular instance. |
112 | ||
de19f115 | 113 | =item B<name> |
114 | ||
127d39a7 | 115 | This returns the name of the CODE reference. |
116 | ||
de19f115 | 117 | =item B<package_name> |
118 | ||
127d39a7 | 119 | This returns the package name that the CODE reference is attached to. |
120 | ||
96ceced8 | 121 | =item B<fully_qualified_name> |
122 | ||
127d39a7 | 123 | This returns the fully qualified name of the CODE reference. |
124 | ||
96ceced8 | 125 | =back |
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 |
141 |