Algorithm-C3

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

    The standard Perl 5 MRO would be (D, B, A, C). The result being that A
    appears before C, even though C is the subclass of A. The C3 MRO
    algorithm however, produces the following MRO (D, B, C, A), which does
    not have this same issue.

    This example is fairly trivial, for more complex examples and a deeper
    explanation, see the links in the "SEE ALSO" section.

FUNCTION
    merge ($root, $func_to_fetch_parent, $cache)
        This takes a $root node, which can be anything really it is up to
        you. Then it takes a $func_to_fetch_parent which can be either a
        CODE reference (see SYNOPSIS above for an example), or a string
        containing a method name to be called on all the items being
        linearized. An example of how this might look is below:

          {
              package A;

              sub supers {
                  no strict 'refs';
                  @{$_[0] . '::ISA'};

README  view on Meta::CPAN

              package C;
              our @ISA = ('A');
              package B;
              our @ISA = ('A');
              package D;
              our @ISA = ('B', 'C');
          }

          print join ", " => Algorithm::C3::merge('D', 'supers');

        The purpose of $func_to_fetch_parent is to provide a way for "merge"
        to extract the parents of $root. This is needed for C3 to be able to
        do it's work.

        The $cache parameter is an entirely optional performance measure,
        and should not change behavior.

        If supplied, it should be a hashref that merge can use as a private
        cache between runs to speed things up. Generally speaking, if you
        will be calling merge many times on related things, and the parent
        fetching function will return constant results given the same
        arguments during all of these calls, you can and should reuse the
        same shared cache hash for all of the calls. Example:

          sub do_some_merging {
              my %merge_cache;
              my @foo_mro = Algorithm::C3::Merge('Foo', \&get_supers, \%merge_cache);
              my @bar_mro = Algorithm::C3::Merge('Bar', \&get_supers, \%merge_cache);
              my @baz_mro = Algorithm::C3::Merge('Baz', \&get_supers, \%merge_cache);
              my @quux_mro = Algorithm::C3::Merge('Quux', \&get_supers, \%merge_cache);

lib/Algorithm/C3.pm  view on Meta::CPAN

package Algorithm::C3;

use strict;
use warnings;

use Carp 'confess';

our $VERSION = '0.11';

sub merge {
    my ($root, $parent_fetcher, $cache) = @_;

    $cache ||= {};

    my @STACK; # stack for simulating recursion

    my $pfetcher_is_coderef = ref($parent_fetcher) eq 'CODE';

    unless ($pfetcher_is_coderef or $root->can($parent_fetcher)) {
        confess "Could not find method $parent_fetcher in $root";
    }

    my $current_root = $root;
    my $current_parents = [ $root->$parent_fetcher ];
    my $recurse_mergeout = [];
    my $i = 0;
    my %seen = ( $root => 1 );

    my ($new_root, $mergeout, %tails);
    while(1) {
        if($i < @$current_parents) {
            $new_root = $current_parents->[$i++];

            if($seen{$new_root}) {
                my @isastack;
                my $reached;
                for(my $i = 0; $i < $#STACK; $i += 4) {
                    if($reached || ($reached = ($STACK[$i] eq $new_root))) {
                        push(@isastack, $STACK[$i]);
                    }
                }
                my $isastack = join(q{ -> }, @isastack, $current_root, $new_root);
                die "Infinite loop detected in parents of '$root': $isastack";
            }
            $seen{$new_root} = 1;

            unless ($pfetcher_is_coderef or $new_root->can($parent_fetcher)) {
                confess "Could not find method $parent_fetcher in $new_root";
            }

            push(@STACK, $current_root, $current_parents, $recurse_mergeout, $i);

            $current_root = $new_root;
            $current_parents = $cache->{pfetch}->{$current_root} ||= [ $current_root->$parent_fetcher ];
            $recurse_mergeout = [];
            $i = 0;
            next;
        }

        $seen{$current_root} = 0;

        $mergeout = $cache->{merge}->{$current_root} ||= do {

            # This do-block is the code formerly known as the function
            # that was a perl-port of the python code at
            # http://www.python.org/2.3/mro.html :)

            # Initial set (make sure everything is copied - it will be modded)
            my @seqs = map { [@$_] } @$recurse_mergeout;
            push(@seqs, [@$current_parents]) if @$current_parents;

            # Construct the tail-checking hash (actually, it's cheaper and still
            #   correct to re-use it throughout this function)
            foreach my $seq (@seqs) {
                $tails{$seq->[$_]}++ for (1..$#$seq);
            }

            my @res = ( $current_root );
            while (1) {
                my $cand;

lib/Algorithm/C3.pm  view on Meta::CPAN

                    . qq{\n\t]\n\t} . qq{merging failed on '$cand'\n}
                  if !$winner;
            }
            \@res;
        };

        return @$mergeout if !@STACK;

        $i = pop(@STACK);
        $recurse_mergeout = pop(@STACK);
        $current_parents = pop(@STACK);
        $current_root = pop(@STACK);

        push(@$recurse_mergeout, $mergeout);
    }
}

1;

__END__

lib/Algorithm/C3.pm  view on Meta::CPAN

The C3 MRO algorithm however, produces the following MRO (D, B, C, A),
which does not have this same issue.

This example is fairly trivial, for more complex examples and a deeper
explanation, see the links in the L<SEE ALSO> section.

=head1 FUNCTION

=over 4

=item B<merge ($root, $func_to_fetch_parent, $cache)>

This takes a C<$root> node, which can be anything really it
is up to you. Then it takes a C<$func_to_fetch_parent> which
can be either a CODE reference (see L<SYNOPSIS> above for an
example), or a string containing a method name to be called
on all the items being linearized. An example of how this
might look is below:

  {
      package A;

      sub supers {
          no strict 'refs';

lib/Algorithm/C3.pm  view on Meta::CPAN

      package C;
      our @ISA = ('A');
      package B;
      our @ISA = ('A');
      package D;
      our @ISA = ('B', 'C');
  }

  print join ", " => Algorithm::C3::merge('D', 'supers');

The purpose of C<$func_to_fetch_parent> is to provide a way
for C<merge> to extract the parents of C<$root>. This is
needed for C3 to be able to do it's work.

The C<$cache> parameter is an entirely optional performance
measure, and should not change behavior.

If supplied, it should be a hashref that merge can use as a
private cache between runs to speed things up.  Generally
speaking, if you will be calling merge many times on related
things, and the parent fetching function will return constant
results given the same arguments during all of these calls,
you can and should reuse the same shared cache hash for all
of the calls.  Example:

  sub do_some_merging {
      my %merge_cache;
      my @foo_mro = Algorithm::C3::Merge('Foo', \&get_supers, \%merge_cache);
      my @bar_mro = Algorithm::C3::Merge('Bar', \&get_supers, \%merge_cache);
      my @baz_mro = Algorithm::C3::Merge('Baz', \&get_supers, \%merge_cache);
      my @quux_mro = Algorithm::C3::Merge('Quux', \&get_supers, \%merge_cache);

t/011_infinite_loop.t  view on Meta::CPAN

            ok(0, "Loop terminated by SIGALRM");
        }
        elsif($err =~ /Infinite loop detected/) {
            ok(1, "Graceful exception thrown");
        }
        else {
            ok(0, "Unrecognized exception: $err");
        }
    }
    else {
        ok(0, "Infinite loop apparently succeeded???");
    }
}