2 package Class::MOP::Method;
8 use Scalar::Util 'reftype', 'blessed';
11 our $VERSION = '0.02';
16 require Class::MOP::Class;
17 Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
25 ('CODE' eq (reftype($code) || ''))
26 || confess "You must supply a CODE reference to bless";
27 bless $code => blessed($class) || $class;
35 || confess "Can only ask the package name of a blessed CODE";
36 svref_2object($code)->GV->STASH->NAME;
42 || confess "Can only ask the package name of a blessed CODE";
43 svref_2object($code)->GV->NAME;
46 package Class::MOP::Method::Wrapped;
52 use Scalar::Util 'reftype', 'blessed';
54 our $VERSION = '0.01';
56 our @ISA = ('Class::MOP::Method');
63 (blessed($code) && $code->isa('Class::MOP::Method'))
64 || confess "Can only wrap blessed CODE";
65 my $modifier_table = {
74 my $method = $class->new(sub {
75 $_->(@_) for @{$modifier_table->{before}};
77 if (defined wantarray) {
79 @rlist = $modifier_table->{around}->{cache}->(@_);
82 $rval = $modifier_table->{around}->{cache}->(@_);
86 $modifier_table->{around}->{cache}->(@_);
88 $_->(@_) for @{$modifier_table->{after}};
89 return unless defined wantarray;
90 return wantarray ? @rlist : $rval;
92 $MODIFIERS{$method} = $modifier_table;
96 sub add_before_modifier {
99 (exists $MODIFIERS{$code})
100 || confess "You must first wrap your method before adding a modifier";
102 || confess "Can only ask the package name of a blessed CODE";
103 ('CODE' eq (reftype($code) || ''))
104 || confess "You must supply a CODE reference for a modifier";
105 unshift @{$MODIFIERS{$code}->{before}} => $modifier;
108 sub add_after_modifier {
110 my $modifier = shift;
111 (exists $MODIFIERS{$code})
112 || confess "You must first wrap your method before adding a modifier";
114 || confess "Can only ask the package name of a blessed CODE";
115 ('CODE' eq (reftype($code) || ''))
116 || confess "You must supply a CODE reference for a modifier";
117 push @{$MODIFIERS{$code}->{after}} => $modifier;
121 my $compile_around_method = sub {{
123 return $f1 unless @_;
125 push @_, sub { $f2->( $f1, @_ ) };
129 sub add_around_modifier {
131 my $modifier = shift;
132 (exists $MODIFIERS{$code})
133 || confess "You must first wrap your method before adding a modifier";
135 || confess "Can only ask the package name of a blessed CODE";
136 ('CODE' eq (reftype($code) || ''))
137 || confess "You must supply a CODE reference for a modifier";
138 unshift @{$MODIFIERS{$code}->{around}->{methods}} => $modifier;
139 $MODIFIERS{$code}->{around}->{cache} = $compile_around_method->(
140 @{$MODIFIERS{$code}->{around}->{methods}},
141 $MODIFIERS{$code}->{orig}
154 Class::MOP::Method - Method Meta Object
158 # ... more to come later maybe
162 The Method Protocol is very small, since methods in Perl 5 are just
163 subroutines within the particular package. Basically all we do is to
164 bless the subroutine.
166 Currently this package is largely unused. Future plans are to provide
167 some very simple introspection methods for the methods themselves.
168 Suggestions for this are welcome.
178 This will return a B<Class::MOP::Class> instance which is related
189 This simply blesses the C<&code> reference passed to it.
193 This wraps an existing method so that it can handle method modifiers.
203 =item B<package_name>
211 =item B<add_before_modifier ($code)>
213 =item B<add_after_modifier ($code)>
215 =item B<add_around_modifier ($code)>
221 Stevan Little E<lt>stevan@iinteractive.comE<gt>
223 =head1 COPYRIGHT AND LICENSE
225 Copyright 2006 by Infinity Interactive, Inc.
227 L<http://www.iinteractive.com>
229 This library is free software; you can redistribute it and/or modify
230 it under the same terms as Perl itself.