use Scalar::Util 'blessed';
use Algorithm::C3;
-our $VERSION = '0.11';
+our $VERSION = '0.13';
# this is our global stash of both
# MRO's and method dispatch tables
## functions for applying C3 to classes
sub _calculate_method_dispatch_tables {
+ my %merge_cache;
foreach my $class (keys %MRO) {
- _calculate_method_dispatch_table($class);
+ _calculate_method_dispatch_table($class, \%merge_cache);
}
}
sub _calculate_method_dispatch_table {
- my $class = shift;
+ my ($class, $merge_cache) = @_;
no strict 'refs';
- my @MRO = calculateMRO($class);
+ my @MRO = calculateMRO($class, $merge_cache);
$MRO{$class} = { MRO => \@MRO };
my $has_overload_fallback = 0;
my %methods;
## functions for calculating C3 MRO
sub calculateMRO {
- my ($class) = @_;
+ my ($class, $merge_cache) = @_;
return Algorithm::C3::merge($class, sub {
no strict 'refs';
@{$_[0] . '::ISA'};
- });
+ }, $merge_cache);
}
package # hide me from PAUSE
our %METHOD_CACHE;
sub method {
- my $level = 1;
+ my $indirect = caller() =~ /^(?:next|maybe::next)$/;
+ my $level = $indirect ? 2 : 1;
+
my ($method_caller, $label, @label);
while ($method_caller = (caller($level++))[3]) {
@label = (split '::', $method_caller);
my $self = $_[0];
my $class = blessed($self) || $self;
- goto &{ $METHOD_CACHE{"$class|$caller|$label"} ||= do {
+ my $method = $METHOD_CACHE{"$class|$caller|$label"} ||= do {
+
+ my @MRO = Class::C3::calculateMRO($class);
+
+ my $current;
+ while ($current = shift @MRO) {
+ last if $caller eq $current;
+ }
+
+ no strict 'refs';
+ my $found;
+ foreach my $class (@MRO) {
+ next if (defined $Class::C3::MRO{$class} &&
+ defined $Class::C3::MRO{$class}{methods}{$label});
+ last if (defined ($found = *{$class . '::' . $label}{CODE}));
+ }
+
+ $found;
+ };
- my @MRO = Class::C3::calculateMRO($class);
+ return $method if $indirect;
- my $current;
- while ($current = shift @MRO) {
- last if $caller eq $current;
- }
+ die "No next::method '$label' found for $self" if !$method;
- no strict 'refs';
- my $found;
- foreach my $class (@MRO) {
- next if (defined $Class::C3::MRO{$class} &&
- defined $Class::C3::MRO{$class}{methods}{$label});
- last if (defined ($found = *{$class . '::' . $label}{CODE}));
- }
+ goto &{$method};
+}
- die "No next::method '$label' found for $self" unless $found;
+sub can { method($_[0]) }
- $found;
- } };
-}
+package # hide me from PAUSE
+ maybe::next;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+sub method { (next::method($_[0]) || return)->(@_) }
1;
=item B<initialize>
This B<must be called> to initalize the C3 method dispatch tables, this module B<will not work> if
-you do not do this. It is advised to do this as soon as possible B<after> any classes which use C3.
+you do not do this. It is advised to do this as soon as possible B<after> loading any classes which
+use C3. Here is a quick code example:
+
+ package Foo;
+ use Class::C3;
+ # ... Foo methods here
+
+ package Bar;
+ use Class::C3;
+ use base 'Foo';
+ # ... Bar methods here
+
+ package main;
+
+ Class::C3::initialize(); # now it is safe to use Foo and Bar
This function used to be called automatically for you in the INIT phase of the perl compiler, but
that lead to warnings if this module was required at runtime. After discussion with my user base
The next thing to keep in mind is that you will need to pass all arguments to C<next::method> it can
not automatically use the current C<@_>.
+If C<next::method> cannot find a next method to re-dispatch the call to, it will throw an exception.
+You can use C<next::can> to see if C<next::method> will succeed before you call it like so:
+
+ $self->next::method(@_) if $self->next::can;
+
+Additionally, you can use C<maybe::next::method> as a shortcut to only call the next method if it exists.
+The previous example could be simply written as:
+
+ $self->maybe::next::method(@_);
+
There are some caveats about using C<next::method>, see below for those.
=head1 CAVEATS
---------------------------- ------ ------ ------ ------ ------ ------ ------
File stmt bran cond sub pod time total
---------------------------- ------ ------ ------ ------ ------ ------ ------
- Class/C3.pm 98.6 90.9 73.3 96.0 100.0 96.8 95.3
+ Class/C3.pm 98.3 84.4 80.0 96.2 100.0 98.4 94.4
---------------------------- ------ ------ ------ ------ ------ ------ ------
- Total 98.6 90.9 73.3 96.0 100.0 96.8 95.3
+ Total 98.3 84.4 80.0 96.2 100.0 98.4 94.4
---------------------------- ------ ------ ------ ------ ------ ------ ------
=head1 SEE ALSO
=item Thanks to Justin Guenther for making C<next::method> more robust by handling
calls inside C<eval> and anon-subs.
+=item Thanks to Robert Norris for adding support for C<next::can> and
+C<maybe::next::method>.
+
=back
=head1 AUTHOR
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
-=cut
\ No newline at end of file
+=cut
projects / gitmo/Class-C3.git / blobdiff