| Class-C3-Adopt-NEXT documentation | Contained in the Class-C3-Adopt-NEXT distribution. |
Class::C3::Adopt::NEXT - make NEXT suck less
package MyApp::Plugin::FooBar;
#use NEXT;
use Class::C3::Adopt::NEXT;
# or 'use Class::C3::Adopt::NEXT -no_warn;' to suppress warnings
# Or use warnings::register
# no warnings 'Class::C3::Adopt::NEXT';
# Or suppress warnings in a set of modules from one place
# no Class::C3::Adopt::NEXT qw/ Module1 Module2 Module3 /;
# Or suppress using a regex
# no Class::C3::Adopt::NEXT qr/^Module\d$/;
sub a_method {
my ($self) = @_;
# Do some stuff
# Re-dispatch method
# Note that this will generate a warning the _first_ time the package
# uses NEXT unless you un comment the 'no warnings' line above.
$self->NEXT::method();
}
NEXT was a good solution a few years ago, but isn't any more. It's slow, and the order in which it re-dispatches methods appears random at times. It also encourages bad programming practices, as you end up with code to re-dispatch methods when all you really wanted to do was run some code before or after a method fired.
However, if you have a large application, then weaning yourself off NEXT
isn't easy.
This module is intended as a drop-in replacement for NEXT, supporting the same
interface, but using Class::C3 to do the hard work. You can then write new
code without NEXT, and migrate individual source files to use Class::C3
or method modifiers as appropriate, at whatever pace you're comfortable with.
This module will warn once for each package using NEXT. It uses
warnings::register, and so can be disabled like by adding no warnings
'Class::C3::Adopt::NEXT'; to each package which generates a warning, or adding
use Class::C3::Adopt::NEXT -no_warn;, or disable multiple modules at once by
saying:
no Class::C3::Adopt::NEXT qw/ Module1 Module2 Module3 /;
somewhere before the warnings are first triggered. You can also setup entire name spaces of modules which will not warn using a regex, e.g.
no Class::C3::Adopt::NEXT qr/^Module\d$/;
You add use MRO::Compat to the top of a package as you start converting it,
and gradually replace your calls to NEXT::method() with
maybe::next::method(), and calls to NEXT::ACTUAL::method() with
next::method().
Example:
sub yourmethod {
my $self = shift;
# $self->NEXT::yourmethod(@_); becomes
$self->maybe::next::method();
}
sub othermethod {
my $self = shift;
# $self->NEXT::ACTUAL::yourmethodname(); becomes
$self->next::method();
}
On systems with Class::C3::XS present, this will automatically be used to
speed up method re-dispatch. If you are running perl version 5.9.5 or greater
then the C3 method resolution algorithm is included in perl. Correct use of
MRO::Compat as shown above allows your code to be seamlessly forward and
backwards compatible, taking advantage of native versions if available, but
falling back to using pure perl Class::C3.
Use Moose and make all of your plugins Moose::Roles, then use method modifiers to wrap methods.
Example:
package MyApp::Role::FooBar;
use Moose::Role;
before 'a_method' => sub {
my ($self) = @_;
# Do some stuff
};
around 'a_method' => sub {
my $orig = shift;
my $self = shift;
# Do some stuff before
my $ret = $self->$orig(@_); # Run wrapped method (or not!)
# Do some stuff after
return $ret;
};
package MyApp;
use Moose;
with 'MyApp::Role::FooBar';
There are some inheritance hierarchies that it is possible to create which
cannot be resolved to a simple C3 hierarchy. In that case, this module will
fall back to using NEXT. In this case a warning will be emitted.
Because calculating the MRO of every class every time ->NEXT::foo is
used from within it is too expensive, runtime manipulations of @ISA are
prohibited.
This module replaces NEXT::AUTOLOAD with it's own version. If warnings are
enabled then a warning will be emitted on the first use of NEXT by each
package.
MRO::Compat and Class::C3 for method re-dispatch and Moose for method modifiers and roles.
NEXT for documentation on the functionality you'll be removing.
Florian Ragwitz <rafl@debian.org> Tomas Doran <bobtfish@bobtfish.net>
This software is copyright (c) 2010 by Florian Ragwitz.
This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.
| Class-C3-Adopt-NEXT documentation | Contained in the Class-C3-Adopt-NEXT distribution. |
use strict; use warnings; package Class::C3::Adopt::NEXT; BEGIN { $Class::C3::Adopt::NEXT::AUTHORITY = 'cpan:FLORA'; } BEGIN { $Class::C3::Adopt::NEXT::VERSION = '0.13'; } # ABSTRACT: make NEXT suck less use NEXT; use MRO::Compat; use List::MoreUtils qw/none/; use warnings::register; { my %c3_mro_ok; my %warned_for; my @no_warn_regexes; { my $orig = NEXT->can('AUTOLOAD'); no warnings 'redefine'; *NEXT::AUTOLOAD = sub { my $class = ref $_[0] || $_[0]; my $caller = caller(); # 'NEXT::AUTOLOAD' is cargo-culted from C::P::C3, I have no idea if/why it's needed my $wanted = our $AUTOLOAD || 'NEXT::AUTOLOAD'; my ($wanted_class) = $wanted =~ m{(.*)::}; unless (exists $c3_mro_ok{$class}) { eval { mro::get_linear_isa($class, 'c3') }; if (my $error = $@) { warn "Class::C3::calculateMRO('${class}') Error: '${error}';" . ' Falling back to plain NEXT.pm behaviour for this class'; $c3_mro_ok{$class} = 0; } else { $c3_mro_ok{$class} = 1; } } if (length $c3_mro_ok{$class} && $c3_mro_ok{$class}) { unless ($warned_for{$caller}) { $warned_for{$caller} = 1; if (!@no_warn_regexes || none { $caller =~ $_ } @no_warn_regexes) { warnings::warnif("${caller} uses NEXT, which is deprecated. Please see " . "the Class::C3::Adopt::NEXT documentation for details. NEXT used "); } } } unless ($c3_mro_ok{$class}) { $NEXT::AUTOLOAD = $wanted; goto &$orig; } goto &next::method if $wanted_class =~ /^NEXT:.*:ACTUAL/; goto &maybe::next::method; }; *NEXT::ACTUAL::AUTOLOAD = \&NEXT::AUTOLOAD; } sub import { my ($class, @args) = @_; my $target = caller(); for my $arg (@args) { $warned_for{$target} = 1 if $arg eq '-no_warn'; } } sub unimport { my $class = shift; my @strings = grep { !ref $_ || ref($_) ne 'Regexp' } @_; my @regexes = grep { ref($_) && ref($_) eq 'Regexp' } @_; @c3_mro_ok{@strings} = ('') x @strings; push @no_warn_regexes, @regexes; } } 1; __END__