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'; |
15 | ||
ce2ae40f | 16 | # NOTE: |
17 | # if poked in the right way, | |
18 | # they should act like CODE refs. | |
c23184fc | 19 | use overload '&{}' => sub { $_[0]->body }, fallback => 1; |
7855ddba | 20 | |
de19f115 | 21 | # introspection |
2eb717d5 | 22 | |
727919c5 | 23 | sub meta { |
24 | require Class::MOP::Class; | |
aa448b16 | 25 | Class::MOP::Class->initialize(blessed($_[0]) || $_[0]); |
727919c5 | 26 | } |
2eb717d5 | 27 | |
de19f115 | 28 | # construction |
29 | ||
a4258ffd | 30 | sub wrap { |
2eb717d5 | 31 | my $class = shift; |
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 { |
c23184fc | 36 | '&!body' => $code |
7855ddba | 37 | } => blessed($class) || $class; |
de19f115 | 38 | } |
39 | ||
ce2ae40f | 40 | ## accessors |
41 | ||
c23184fc | 42 | sub body { (shift)->{'&!body'} } |
7855ddba | 43 | |
b1897d4d | 44 | # TODO - add associated_class |
45 | ||
de19f115 | 46 | # informational |
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 { |
c23184fc | 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 { |
c23184fc | 64 | my $code = (shift)->body; |
de19f115 | 65 | svref_2object($code)->GV->NAME; |
2eb717d5 | 66 | } |
de19f115 | 67 | |
96ceced8 | 68 | sub fully_qualified_name { |
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 |
86 | ||
8b978dd5 | 87 | =head1 DESCRIPTION |
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 |
91 | introspection interface. | |
fe122940 | 92 | |
2eb717d5 | 93 | =head1 METHODS |
94 | ||
de19f115 | 95 | =head2 Introspection |
2eb717d5 | 96 | |
de19f115 | 97 | =over 4 |
fe122940 | 98 | |
2eb717d5 | 99 | =item B<meta> |
100 | ||
fe122940 | 101 | This will return a B<Class::MOP::Class> instance which is related |
102 | to this class. | |
103 | ||
2eb717d5 | 104 | =back |
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> |
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> |
133 | ||
8b978dd5 | 134 | =head1 COPYRIGHT AND LICENSE |
135 | ||
2367814a | 136 | Copyright 2006, 2007 by Infinity Interactive, Inc. |
8b978dd5 | 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 |
144 |