=cut
+sub __get_linear_isa_dfs {
+ no strict 'refs';
+
+ my $classname = shift;
+
+ my @lin = ($classname);
+ my %stored;
+ foreach my $parent (@{"$classname\::ISA"}) {
+ my $plin = __get_linear_isa_dfs($parent);
+ foreach (@$plin) {
+ next if exists $stored{$_};
+ push(@lin, $_);
+ $stored{$_} = 1;
+ }
+ }
+ return \@lin;
+}
+
sub __get_linear_isa {
+ my ($classname, $type) = @_;
+ die "mro::get_mro requires a classname" if !$classname;
+
+ $type ||= __get_mro($classname);
+ if($type eq 'dfs') {
+ return __get_linear_isa_dfs($classname);
+ }
+ elsif($type eq 'c3') {
+ return [Class::C3::calculateMRO($classname)];
+ }
+ die "type argument must be 'dfs' or 'c3'";
}
=head2 mro::import
=cut
sub __get_mro {
- my $classname = shift
+ my $classname = shift;
die "mro::get_mro requires a classname" if !$classname;
- if($C3_INSTALLED && exists $Class::C3::MRO{$classname}
- && $Class::C3::_initialized) {
+ if($C3_INSTALLED && exists $Class::C3::MRO{$classname}) {
return 'c3';
}
return 'dfs';
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok('MRO::Compat');
+}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+
+all_pod_files_ok();
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
--- /dev/null
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+BEGIN {
+ use_ok('MRO::Compat');
+}
+
+{
+ package AAA; our @ISA = qw//;
+ package BBB; our @ISA = qw/AAA/;
+ package CCC; our @ISA = qw/AAA/;
+ package DDD; our @ISA = qw/AAA/;
+ package EEE; our @ISA = qw/BBB CCC DDD/;
+ package FFF; our @ISA = qw/EEE DDD/;
+ package GGG; our @ISA = qw/FFF/;
+}
+
+is_deeply(
+ mro::get_linear_isa('GGG'),
+ [ 'GGG', 'FFF', 'EEE', 'BBB', 'AAA', 'CCC', 'DDD' ]
+);