| Class-Method-Modifiers documentation | Contained in the Class-Method-Modifiers distribution. |
Class::Method::Modifiers - provides Moose-like method modifiers
package Child;
use parent 'Parent';
use Class::Method::Modifiers;
sub new_method { }
before 'old_method' => sub {
carp "old_method is deprecated, use new_method";
};
around 'other_method' => sub {
my $orig = shift;
my $ret = $orig->(@_);
return $ret =~ /\d/ ? $ret : lc $ret;
};
after 'private', 'protected' => sub {
debug "finished calling a dangerous method";
};
Method modifiers are a convenient feature from the CLOS (Common Lisp Object System) world.
In its most basic form, a method modifier is just a method that calls
$self->SUPER::foo(@_). I for one have trouble remembering that exact
invocation, so my classes seldom re-dispatch to their base classes. Very bad!
Class::Method::Modifiers provides three modifiers: before, around, and
after. before and after are run just before and after the method they
modify, but can not really affect that original method. around is run in
place of the original method, with a hook to easily call that original method.
See the MODIFIERS section for more details on how the particular modifiers
work.
One clear benefit of using Class::Method::Modifiers is that you can define
multiple modifiers in a single namespace. These separate modifiers don't need
to know about each other. This makes top-down design easy. Have a base class
that provides the skeleton methods of each operation, and have plugins modify
those methods to flesh out the specifics.
Parent classes need not know about Class::Method::Modifiers. This means you
should be able to modify methods in any subclass. See
Term::VT102::ZeroBased for an example of subclassing with CMM.
In short, Class::Method::Modifiers solves the problem of making sure you
call $self->SUPER::foo(@_), and provides a cleaner interface for it.
As of version 1.00, Class::Method::Modifiers is faster in some cases than
Moose. See benchmark/method_modifiers.pl in the Moose distribution.
before is called before the method it is modifying. Its return value is
totally ignored. It receives the same @_ as the the method it is modifying
would have received. You can modify the @_ the original method will receive
by changing $_[0] and friends (or by changing anything inside a reference).
This is a feature!
after is called after the method it is modifying. Its return value is
totally ignored. It receives the same @_ as the the method it is modifying
received, mostly. The original method can modify @_ (such as by changing
$_[0] or references) and after will see the modified version. If you
don't like this behavior, specify both a before and after, and copy the
@_ during before for after to use.
around is called instead of the method it is modifying. The method you're
overriding is passed in as the first argument (called $orig by convention).
Watch out for contextual return values of $orig.
You can use around to:
$orig a different @_ around 'method' => sub {
my $orig = shift;
my $self = shift;
$orig->($self, reverse @_);
};
$orig around 'method' => sub {
my $orig = shift;
ucfirst $orig->(@_);
};
$orig -- conditionally around 'method' => sub {
my $orig = shift;
return $orig->(@_) if time() % 2;
return "no dice, captain";
};
All three normal modifiers; before, after, and around; are exported
into your namespace by default. You may use Class::Method::Modifiers () to
avoid thrashing your namespace. I may steal more features from Moose, namely
super, override, inner, augment, and whatever the Moose folks
come up with next.
Note that the syntax and semantics for these modifiers is directly borrowed from Moose (the implementations, however, are not).
Class::Trigger shares a few similarities with Class::Method::Modifiers,
and they even have some overlap in purpose -- both can be used to implement
highly pluggable applications. The difference is that Class::Trigger
provides a mechanism for easily letting parent classes to invoke hooks defined
by other code. Class::Method::Modifiers provides a way of
overriding/augmenting methods safely, and the parent class need not know about
it.
It is erroneous to modify a method that doesn't exist in your class's inheritance hierarchy. If this occurs, an exception will be thrown when the modifier is defined.
It doesn't yet play well with caller. There are some todo tests for this.
Don't get your hopes up though!
This module was bumped to 1.00 following a complete reimplementation, to indicate breaking backwards compatibility. The "guard" modifier was removed, and the internals are completely different.
The new version is a few times faster with half the code. It's now even faster than Moose.
Any code that just used modifiers should not change in behavior, except to become more correct. And, of course, faster. :)
Class::Method::Modifiers::Fast Moose, Class::Trigger, Class::MOP::Method::Wrapped, MRO::Compat, CLOS
Shawn M Moore, sartak@gmail.com
Thanks to Stevan Little for Moose, I would never have known about method modifiers otherwise.
Thanks to Matt Trout and Stevan Little for their advice.
Copyright 2007-2009 Shawn M Moore.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
| Class-Method-Modifiers documentation | Contained in the Class-Method-Modifiers distribution. |
package Class::Method::Modifiers; use strict; use warnings; our $VERSION = '1.07'; use base 'Exporter'; our @EXPORT = qw(before after around); our @EXPORT_OK = (@EXPORT, 'install_modifier'); our %EXPORT_TAGS = ( moose => [qw(before after around)], all => \@EXPORT_OK, ); our %MODIFIER_CACHE; # for backward compatibility sub _install_modifier; # -w *_install_modifier = \&install_modifier; sub install_modifier { my $into = shift; my $type = shift; my $code = pop; my @names = @_; @names = @{ $names[0] } if ref($names[0]) eq 'ARRAY'; for my $name (@names) { my $hit = $into->can($name) or do { require Carp; Carp::confess("The method '$name' is not found in the inheritance hierarchy for class $into"); }; my $qualified = $into.'::'.$name; my $cache = $MODIFIER_CACHE{$into}{$name} ||= { before => [], after => [], around => [], }; # this must be the first modifier we're installing if (!exists($MODIFIER_CACHE{$into}{$name}{"orig"})) { no strict 'refs'; # grab the original method (or undef if the method is inherited) $cache->{"orig"} = *{$qualified}{CODE}; # the "innermost" method, the one that "around" will ultimately wrap $cache->{"wrapped"} = $cache->{"orig"} || $hit; #sub { # # we can't cache this, because new methods or modifiers may be # # added between now and when this method is called # for my $package (@{ mro::get_linear_isa($into) }) { # next if $package eq $into; # my $code = *{$package.'::'.$name}{CODE}; # goto $code if $code; # } # require Carp; # Carp::confess("$qualified\::$name disappeared?"); #}; } # keep these lists in the order the modifiers are called if ($type eq 'after') { push @{ $cache->{$type} }, $code; } else { unshift @{ $cache->{$type} }, $code; } # wrap the method with another layer of around. much simpler than # the Moose equivalent. :) if ($type eq 'around') { my $method = $cache->{wrapped}; $cache->{wrapped} = sub { $code->($method, @_); }; } # install our new method which dispatches the modifiers, but only # if a new type was added if (@{ $cache->{$type} } == 1) { # avoid these hash lookups every method invocation my $before = $cache->{"before"}; my $after = $cache->{"after"}; # this is a coderef that changes every new "around". so we need # to take a reference to it. better a deref than a hash lookup my $wrapped = \$cache->{"wrapped"}; my $generated = 'sub {'; # before is easy, it doesn't affect the return value(s) $generated .= '$_->(@_) for @$before;' if @$before; if (@$after) { $generated .= ' my @ret; if (wantarray) { @ret = $$wrapped->(@_); } elsif (defined wantarray) { $ret[0] = $$wrapped->(@_); } else { $$wrapped->(@_); } $_->(@_) for @$after; return wantarray ? @ret : $ret[0]; '; } else { $generated .= '$$wrapped->(@_);'; } $generated .= '}'; no strict 'refs'; no warnings 'redefine'; *$qualified = eval $generated; }; } } sub before { _install_modifier(scalar(caller), 'before', @_); } sub after { _install_modifier(scalar(caller), 'after', @_); } sub around { _install_modifier(scalar(caller), 'around', @_); } 1; __END__