MRO-Compat-0.13/000755 000765 000024 00000000000 13066564527 013612 5ustar00gknopstaff000000 000000 MRO-Compat-0.13/Changes000644 000765 000024 00000003555 13066564406 015111 0ustar00gknopstaff000000 000000 Revision history for Perl extension MRO::Compat. 0.13 - 2017-03-28 - don't run pod tests on user installs - stop using Module::Install to fix installation when @INC doesn't have the current directory (RT#119016) - repository migrated to the github moose organization 0.12 - 2012-12-04 - Bump Class::C3 dependency on 5.8 which in turn will automatically install Class::C3::XS if possible - Fix nonfunctional SYNOPSIS (RT#78325) 0.11 - 2009-05-27 - Fix misspelled docs for get_isarev. Closes RT#46401. - Bump optional prereq on Class::C3 to 0.20. 0.10 - 2009-03-25 - Remove the fake Build.PL. Module::Install doesn't support that anymore. (Florian Ragwitz) - Remove auto_install from Makefile.PL. Its use is strongly discouraged. (Closes RT#44542) (Simon Betrang) 0.09 - 2008-06-05 - No change from 0.08_01 0.08_01 - 2008-06-02 - Add fixup (and new tests) for RT#36256 0.07 - 2008-05-20 - Add explicit dependency on perl 5.6.0 or higher in Makefile.PL + META.yml 0.06_01 - 2008-05-19 - Fix for false classnames in mro::get_isarev, I guess I missed an instance during the 0.04 fixes. (reported by Daniel Austin) 0.05 - 2007-09-09 - Fix for RT#28661 (ill-formated %INC filenames aren't nice) 0.04 - 2007-07-18 - Removed doc warning now that 5.9.5 is out - Stopped the code from assuming valid classnames are true in boolean context - Misc small tweaks 0.03 - 2007-06-04 - Bumped C3 requirements - Loads mro.pm on 5.9.5+ 0.02 - 2007-05-12 - Added mro::get_pkg_gen (which optionally works even faster with Class::C3::XS 0.04) in anticipation of it being added to 5.9.5 - Changed mro::get_isarev to return arrayref in anticipation of that change in 5.9.5 - Bumped requirements, added more docs 0.01_01 - 2007-05-11 - Initial dev release MRO-Compat-0.13/lib/000755 000765 000024 00000000000 13066564526 014357 5ustar00gknopstaff000000 000000 MRO-Compat-0.13/maint/000755 000765 000024 00000000000 13066564526 014721 5ustar00gknopstaff000000 000000 MRO-Compat-0.13/Makefile.PL000644 000765 000024 00000005261 13066564246 015566 0ustar00gknopstaff000000 000000 use strict; use warnings FATAL => 'all'; use 5.006; my %META = ( name => 'MRO-Compat', license => 'perl_5', prereqs => { configure => { requires => { 'ExtUtils::MakeMaker' => 0, } }, test => { requires => { 'Test::More' => '0.47', }, }, runtime => { requires => { 'perl' => 5.006, }, }, develop => { requires => { 'Test::Pod' => 1.14, 'Test::Pod::Coverage' => 1.04, }, }, }, resources => { repository => { url => 'git://github.com/moose/MRO-Compat.git', web => 'https://github.com/moose/MRO-Compat', type => 'git', }, bugtracker => { web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=MRO-Compat', mailto => 'bug-MRO-Compat@rt.cpan.org', }, homepage => 'https://metacpan.org/release/MRO-Compat', license => [ 'http://dev.perl.org/licenses/' ], }, no_index => { directory => [ 't', 'xt' ] }, ); my %MM_ARGS = ( PREREQ_PM => { ($] < 5.009_005 ? ('Class::C3' => '0.24') : ()), }, ); ## BOILERPLATE ############################################################### require ExtUtils::MakeMaker; (do './maint/Makefile.PL.include' or die $@) unless -f 'META.yml'; # have to do this since old EUMM dev releases miss the eval $VERSION line my $eumm_version = eval $ExtUtils::MakeMaker::VERSION; my $mymeta = $eumm_version >= 6.57_02; my $mymeta_broken = $mymeta && $eumm_version < 6.57_07; ($MM_ARGS{NAME} = $META{name}) =~ s/-/::/g; ($MM_ARGS{VERSION_FROM} = "lib/$MM_ARGS{NAME}.pm") =~ s{::}{/}g; $META{license} = [ $META{license} ] if $META{license} && !ref $META{license}; $MM_ARGS{LICENSE} = $META{license}[0] if $META{license} && $eumm_version >= 6.30; $MM_ARGS{NO_MYMETA} = 1 if $mymeta_broken; $MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META } unless -f 'META.yml'; for (qw(configure build test runtime)) { my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES'; my $r = $MM_ARGS{$key} = { %{$META{prereqs}{$_}{requires} || {}}, %{delete $MM_ARGS{$key} || {}}, }; defined $r->{$_} or delete $r->{$_} for keys %$r; } $MM_ARGS{MIN_PERL_VERSION} = delete $MM_ARGS{PREREQ_PM}{perl} || 0; delete $MM_ARGS{MIN_PERL_VERSION} if $eumm_version < 6.47_01; $MM_ARGS{BUILD_REQUIRES} = {%{$MM_ARGS{BUILD_REQUIRES}}, %{delete $MM_ARGS{TEST_REQUIRES}}} if $eumm_version < 6.63_03; $MM_ARGS{PREREQ_PM} = {%{$MM_ARGS{PREREQ_PM}}, %{delete $MM_ARGS{BUILD_REQUIRES}}} if $eumm_version < 6.55_01; delete $MM_ARGS{CONFIGURE_REQUIRES} if $eumm_version < 6.51_03; ExtUtils::MakeMaker::WriteMakefile(%MM_ARGS); ## END BOILERPLATE ########################################################### MRO-Compat-0.13/MANIFEST000644 000765 000024 00000000615 13066564527 014745 0ustar00gknopstaff000000 000000 Changes lib/MRO/Compat.pm maint/Makefile.PL.include Makefile.PL MANIFEST This list of files t/10basic.t t/15pkg_gen.t t/20mros.t xt/pod.t xt/pod_coverage.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) README README file (added by Distar) MRO-Compat-0.13/META.json000644 000765 000024 00000003074 13066564526 015236 0ustar00gknopstaff000000 000000 { "abstract" : "mro::* interface compatibility for Perls < 5.9.5", "author" : [ "Brandon L. Black " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "MRO-Compat", "no_index" : { "directory" : [ "t", "xt" ] }, "prereqs" : { "build" : {}, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Test::Pod" : "1.14", "Test::Pod::Coverage" : "1.04" } }, "runtime" : { "requires" : { "perl" : "5.006" } }, "test" : { "requires" : { "Test::More" : "0.47" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-MRO-Compat@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=MRO-Compat" }, "homepage" : "https://metacpan.org/release/MRO-Compat", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://github.com/moose/MRO-Compat.git", "web" : "https://github.com/moose/MRO-Compat" } }, "version" : "0.13", "x_serialization_backend" : "JSON::PP version 2.27300" } MRO-Compat-0.13/META.yml000644 000765 000024 00000001440 13066564526 015061 0ustar00gknopstaff000000 000000 --- abstract: 'mro::* interface compatibility for Perls < 5.9.5' author: - 'Brandon L. Black ' build_requires: Test::More: '0.47' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: MRO-Compat no_index: directory: - t - xt requires: perl: '5.006' resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=MRO-Compat homepage: https://metacpan.org/release/MRO-Compat license: http://dev.perl.org/licenses/ repository: git://github.com/moose/MRO-Compat.git version: '0.13' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' MRO-Compat-0.13/README000644 000765 000024 00000012720 13066564527 014474 0ustar00gknopstaff000000 000000 NAME MRO::Compat - mro::* interface compatibility for Perls < 5.9.5 SYNOPSIS package PPP; use base qw/Exporter/; package X; use base qw/PPP/; package Y; use base qw/PPP/; package Z; use base qw/PPP/; package FooClass; use base qw/X Y Z/; package main; use MRO::Compat; my $linear = mro::get_linear_isa('FooClass'); print join(q{, }, @$linear); # Prints: FooClass, X, PPP, Exporter, Y, Z DESCRIPTION The "mro" namespace provides several utilities for dealing with method resolution order and method caching in general in Perl 5.9.5 and higher. This module provides those interfaces for earlier versions of Perl (back to 5.6.0 anyways). It is a harmless no-op to use this module on 5.9.5+. That is to say, code which properly uses MRO::Compat will work unmodified on both older Perls and 5.9.5+. If you're writing a piece of software that would like to use the parts of 5.9.5+'s mro:: interfaces that are supported here, and you want compatibility with older Perls, this is the module for you. Some parts of this code will work better and/or faster with Class::C3::XS installed (which is an optional prereq of Class::C3, which is in turn a prereq of this package), but it's not a requirement. This module never exports any functions. All calls must be fully qualified with the "mro::" prefix. The interface documentation here serves only as a quick reference of what the function basically does, and what differences between MRO::Compat and 5.9.5+ one should look out for. The main docs in 5.9.5's mro are the real interface docs, and contain a lot of other useful information. Functions mro::get_linear_isa($classname[, $type]) Returns an arrayref which is the linearized "ISA" of the given class. Uses whichever MRO is currently in effect for that class by default, or the given MRO (either "c3" or "dfs" if specified as $type). The linearized ISA of a class is a single ordered list of all of the classes that would be visited in the process of resolving a method on the given class, starting with itself. It does not include any duplicate entries. Note that "UNIVERSAL" (and any members of "UNIVERSAL"'s MRO) are not part of the MRO of a class, even though all classes implicitly inherit methods from "UNIVERSAL" and its parents. mro::import This allows the "use mro 'dfs'" and "use mro 'c3'" syntaxes, providing you "use MRO::Compat" first. Please see the "USING C3" section for additional details. mro::set_mro($classname, $type) Sets the mro of $classname to one of the types "dfs" or "c3". Please see the "USING C3" section for additional details. mro::get_mro($classname) Returns the MRO of the given class (either "c3" or "dfs"). It considers any Class::C3-using class to have C3 MRO even before Class::C3::initialize() is called. mro::get_isarev($classname) Returns an arrayref of classes who are subclasses of the given classname. In other words, classes in whose @ISA hierarchy we appear, no matter how indirectly. This is much slower on pre-5.9.5 Perls with MRO::Compat than it is on 5.9.5+, as it has to search the entire package namespace. mro::is_universal($classname) Returns a boolean status indicating whether or not the given classname is either "UNIVERSAL" itself, or one of "UNIVERSAL"'s parents by @ISA inheritance. Any class for which this function returns true is "universal" in the sense that all classes potentially inherit methods from it. mro::invalidate_all_method_caches Increments "PL_sub_generation", which invalidates method caching in all packages. Please note that this is rarely necessary, unless you are dealing with a situation which is known to confuse Perl's method caching. mro::method_changed_in($classname) Invalidates the method cache of any classes dependent on the given class. In MRO::Compat on pre-5.9.5 Perls, this is an alias for "mro::invalidate_all_method_caches" above, as pre-5.9.5 Perls have no other way to do this. It will still enforce the requirement that you pass it a classname, for compatibility. Please note that this is rarely necessary, unless you are dealing with a situation which is known to confuse Perl's method caching. mro::get_pkg_gen($classname) Returns an integer which is incremented every time a local method of or the @ISA of the given package changes on Perl 5.9.5+. On earlier Perls with this MRO::Compat module, it will probably increment a lot more often than necessary. USING C3 While this module makes the 5.9.5+ syntaxes "use mro 'c3'" and "mro::set_mro("Foo", 'c3')" available on older Perls, it does so merely by passing off the work to Class::C3. It does not remove the need for you to call "Class::C3::initialize()", "Class::C3::reinitialize()", and/or "Class::C3::uninitialize()" at the appropriate times as documented in the Class::C3 docs. These three functions are always provided by MRO::Compat, either via Class::C3 itself on older Perls, or directly as no-ops on 5.9.5+. SEE ALSO Class::C3 mro AUTHOR Brandon L. Black, COPYRIGHT AND LICENSE Copyright 2007-2008 Brandon L. Black This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. MRO-Compat-0.13/t/000755 000765 000024 00000000000 13066564526 014054 5ustar00gknopstaff000000 000000 MRO-Compat-0.13/xt/000755 000765 000024 00000000000 13066564526 014244 5ustar00gknopstaff000000 000000 MRO-Compat-0.13/xt/pod.t000644 000765 000024 00000000124 13066564246 015207 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Test::Pod 1.14; all_pod_files_ok(); MRO-Compat-0.13/xt/pod_coverage.t000644 000765 000024 00000000141 13066564246 017061 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Test::Pod::Coverage 1.04; all_pod_coverage_ok(); MRO-Compat-0.13/t/10basic.t000644 000765 000024 00000002241 13066564246 015461 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More tests => 10; use 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/; package UNIVERSAL; our @ISA = qw/DDD/; } is_deeply( mro::get_linear_isa('GGG'), [ 'GGG', 'FFF', 'EEE', 'BBB', 'AAA', 'CCC', 'DDD' ], "get_linear_isa for GGG", ); is_deeply( [sort @{mro::get_isarev('GGG')}], [], "get_isarev for GGG", ); is_deeply( [sort @{mro::get_isarev('DDD')}], [ 'EEE', 'FFF', 'GGG', 'UNIVERSAL' ], "get_isarev for DDD", ); is_deeply( [sort @{mro::get_isarev('AAA')}], [ 'BBB', 'CCC', 'DDD', 'EEE', 'FFF', 'GGG', 'UNIVERSAL' ], "get_isarev for AAA", ); ok(mro::is_universal('UNIVERSAL'), "UNIVERSAL is_universal"); ok(mro::is_universal('DDD'), "DDD is_universal"); ok(mro::is_universal('AAA'), "AAA is_universal"); ok(!mro::is_universal('MRO::Compat'), "MRO::Compat !is_universal"); ok(!mro::is_universal('BBB'), "BBB !is_universal"); ok(!mro::is_universal('FFF'), "FFF !is_universal"); MRO-Compat-0.13/t/15pkg_gen.t000644 000765 000024 00000000745 13066564246 016026 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More tests => 3; use MRO::Compat; { package Foo; our @ISA = qw//; } my $f_gen = mro::get_pkg_gen('Foo'); ok($f_gen > 0, 'Foo pkg_gen > 0'); { no warnings 'once'; *Foo::foo_func = sub { 123 }; } my $new_f_gen = mro::get_pkg_gen('Foo'); ok($new_f_gen > $f_gen, 'Foo pkg_gen incs for methods'); $f_gen = $new_f_gen; @Foo::ISA = qw/Bar/; $new_f_gen = mro::get_pkg_gen('Foo'); ok($new_f_gen > $f_gen, 'Foo pkg_gen incs for @ISA'); MRO-Compat-0.13/t/20mros.t000644 000765 000024 00000004343 13066564246 015366 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More tests => 13; use MRO::Compat; { package AAA; our @ISA = qw//; use mro 'dfs'; package BBB; our @ISA = qw/AAA/; use mro 'dfs'; package CCC; our @ISA = qw/AAA/; use mro 'dfs'; package DDD; our @ISA = qw/AAA/; use mro 'dfs'; package EEE; our @ISA = qw/BBB CCC DDD/; use mro 'dfs'; package FFF; our @ISA = qw/EEE DDD/; use mro 'dfs'; package GGG; our @ISA = qw/FFF/; use mro 'dfs'; package AAA3; our @ISA = qw//; sub testsub { return $_[0] . '_first_in_dfs' } package BBB3; our @ISA = qw/AAA3/; package CCC3; our @ISA = qw/AAA3/; sub testsub { return $_[0] . '_first_in_c3' } package DDD3; our @ISA = qw/AAA3/; package EEE3; our @ISA = qw/BBB3 CCC3 DDD3/; package FFF3; our @ISA = qw/EEE3 DDD3/; use mro 'c3'; package GGG3; our @ISA = qw/FFF3/; use mro 'c3'; } is(mro::get_mro('FFF3'), 'c3'); is_deeply( mro::get_linear_isa('GGG'), [ 'GGG', 'FFF', 'EEE', 'BBB', 'AAA', 'CCC', 'DDD' ], "get_linear_isa for GGG", ); is_deeply( mro::get_linear_isa('GGG3'), [ 'GGG3', 'FFF3', 'EEE3', 'BBB3', 'CCC3', 'DDD3', 'AAA3' ], "get_linear_isa for GGG3", ); SKIP: { skip "Does not work like this on 5.9.5+", 1 if $] > 5.009_004; is(FFF3->testsub(), 'FFF3_first_in_dfs', 'dfs resolution pre-init'); } Class::C3::initialize(); is(FFF3->testsub(), 'FFF3_first_in_c3', 'c3 resolution post-init'); mro::set_mro('FFF3', 'dfs'); is(mro::get_mro('FFF3'), 'dfs'); is_deeply( mro::get_linear_isa('FFF3'), [ 'FFF3', 'EEE3', 'BBB3', 'AAA3', 'CCC3', 'DDD3' ], "get_linear_isa for FFF3 (dfs)", ); is(FFF3->testsub(), 'FFF3_first_in_dfs', 'dfs resolution post- set_mro dfs'); is_deeply( mro::get_linear_isa('GGG3'), [ 'GGG3', 'FFF3', 'EEE3', 'BBB3', 'CCC3', 'DDD3', 'AAA3' ], "get_linear_isa for GGG3 (still c3)", ); mro::set_mro('FFF3', 'c3'); is(mro::get_mro('FFF3'), 'c3'); is_deeply( mro::get_linear_isa('FFF3'), [ 'FFF3', 'EEE3', 'BBB3', 'CCC3', 'DDD3', 'AAA3' ], "get_linear_isa for FFF3 (reset to c3 via set_mro)", ); eval "package FFF3; use mro 'dfs'"; is(mro::get_mro('FFF3'), 'dfs'); is_deeply( mro::get_linear_isa('FFF3'), [ 'FFF3', 'EEE3', 'BBB3', 'AAA3', 'CCC3', 'DDD3' ], "get_linear_isa for FFF3 (reset to dfs via 'use mro')", ); MRO-Compat-0.13/maint/Makefile.PL.include000644 000765 000024 00000000333 13066564246 020313 0ustar00gknopstaff000000 000000 BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git") } use lib 'Distar/lib'; use Distar 0.001; use ExtUtils::MakeMaker 6.57_10 (); author 'Brandon L. Black '; 1; MRO-Compat-0.13/lib/MRO/000755 000765 000024 00000000000 13066564526 015014 5ustar00gknopstaff000000 000000 MRO-Compat-0.13/lib/MRO/Compat.pm000644 000765 000024 00000025336 13066564027 016602 0ustar00gknopstaff000000 000000 package MRO::Compat; use strict; use warnings; require 5.006_000; # Keep this < 1.00, so people can tell the fake # mro.pm from the real one our $VERSION = '0.13'; BEGIN { # Alias our private functions over to # the mro:: namespace and load # Class::C3 if Perl < 5.9.5 if($] < 5.009_005) { $mro::VERSION # to fool Module::Install when generating META.yml = $VERSION; $INC{'mro.pm'} = __FILE__; *mro::import = \&__import; *mro::get_linear_isa = \&__get_linear_isa; *mro::set_mro = \&__set_mro; *mro::get_mro = \&__get_mro; *mro::get_isarev = \&__get_isarev; *mro::is_universal = \&__is_universal; *mro::method_changed_in = \&__method_changed_in; *mro::invalidate_all_method_caches = \&__invalidate_all_method_caches; require Class::C3; if($Class::C3::XS::VERSION && $Class::C3::XS::VERSION > 0.03) { *mro::get_pkg_gen = \&__get_pkg_gen_c3xs; } else { *mro::get_pkg_gen = \&__get_pkg_gen_pp; } } # Load mro.pm and provide no-op Class::C3::.*initialize() funcs for 5.9.5+ else { require mro; no warnings 'redefine'; *Class::C3::initialize = sub { 1 }; *Class::C3::reinitialize = sub { 1 }; *Class::C3::uninitialize = sub { 1 }; } } =head1 NAME MRO::Compat - mro::* interface compatibility for Perls < 5.9.5 =head1 SYNOPSIS package PPP; use base qw/Exporter/; package X; use base qw/PPP/; package Y; use base qw/PPP/; package Z; use base qw/PPP/; package FooClass; use base qw/X Y Z/; package main; use MRO::Compat; my $linear = mro::get_linear_isa('FooClass'); print join(q{, }, @$linear); # Prints: FooClass, X, PPP, Exporter, Y, Z =head1 DESCRIPTION The "mro" namespace provides several utilities for dealing with method resolution order and method caching in general in Perl 5.9.5 and higher. This module provides those interfaces for earlier versions of Perl (back to 5.6.0 anyways). It is a harmless no-op to use this module on 5.9.5+. That is to say, code which properly uses L will work unmodified on both older Perls and 5.9.5+. If you're writing a piece of software that would like to use the parts of 5.9.5+'s mro:: interfaces that are supported here, and you want compatibility with older Perls, this is the module for you. Some parts of this code will work better and/or faster with L installed (which is an optional prereq of L, which is in turn a prereq of this package), but it's not a requirement. This module never exports any functions. All calls must be fully qualified with the C prefix. The interface documentation here serves only as a quick reference of what the function basically does, and what differences between L and 5.9.5+ one should look out for. The main docs in 5.9.5's L are the real interface docs, and contain a lot of other useful information. =head1 Functions =head2 mro::get_linear_isa($classname[, $type]) Returns an arrayref which is the linearized "ISA" of the given class. Uses whichever MRO is currently in effect for that class by default, or the given MRO (either C or C if specified as C<$type>). The linearized ISA of a class is a single ordered list of all of the classes that would be visited in the process of resolving a method on the given class, starting with itself. It does not include any duplicate entries. Note that C (and any members of C's MRO) are not part of the MRO of a class, even though all classes implicitly inherit methods from C and its parents. =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 !defined $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 This allows the C and C syntaxes, providing you L first. Please see the L section for additional details. =cut sub __import { if($_[1]) { goto &Class::C3::import if $_[1] eq 'c3'; __set_mro(scalar(caller), $_[1]); } } =head2 mro::set_mro($classname, $type) Sets the mro of C<$classname> to one of the types C or C. Please see the L section for additional details. =cut sub __set_mro { my ($classname, $type) = @_; if(!defined $classname || !$type) { die q{Usage: mro::set_mro($classname, $type)}; } if($type eq 'c3') { eval "package $classname; use Class::C3"; die $@ if $@; } elsif($type eq 'dfs') { # In the dfs case, check whether we need to undo C3 if(defined $Class::C3::MRO{$classname}) { Class::C3::_remove_method_dispatch_table($classname); } delete $Class::C3::MRO{$classname}; } else { die qq{Invalid mro type "$type"}; } return; } =head2 mro::get_mro($classname) Returns the MRO of the given class (either C or C). It considers any Class::C3-using class to have C3 MRO even before L is called. =cut sub __get_mro { my $classname = shift; die "mro::get_mro requires a classname" if !defined $classname; return 'c3' if exists $Class::C3::MRO{$classname}; return 'dfs'; } =head2 mro::get_isarev($classname) Returns an arrayref of classes who are subclasses of the given classname. In other words, classes in whose @ISA hierarchy we appear, no matter how indirectly. This is much slower on pre-5.9.5 Perls with MRO::Compat than it is on 5.9.5+, as it has to search the entire package namespace. =cut sub __get_all_pkgs_with_isas { no strict 'refs'; no warnings 'recursion'; my @retval; my $search = shift; my $pfx; my $isa; if(defined $search) { $isa = \@{"$search\::ISA"}; $pfx = "$search\::"; } else { $search = 'main'; $isa = \@main::ISA; $pfx = ''; } push(@retval, $search) if scalar(@$isa); foreach my $cand (keys %{"$search\::"}) { if($cand =~ s/::$//) { next if $cand eq $search; # skip self-reference (main?) push(@retval, @{__get_all_pkgs_with_isas($pfx . $cand)}); } } return \@retval; } sub __get_isarev_recurse { no strict 'refs'; my ($class, $all_isas, $level) = @_; die "Recursive inheritance detected" if $level > 100; my %retval; foreach my $cand (@$all_isas) { my $found_me; foreach (@{"$cand\::ISA"}) { if($_ eq $class) { $found_me = 1; last; } } if($found_me) { $retval{$cand} = 1; map { $retval{$_} = 1 } @{__get_isarev_recurse($cand, $all_isas, $level+1)}; } } return [keys %retval]; } sub __get_isarev { my $classname = shift; die "mro::get_isarev requires a classname" if !defined $classname; __get_isarev_recurse($classname, __get_all_pkgs_with_isas(), 0); } =head2 mro::is_universal($classname) Returns a boolean status indicating whether or not the given classname is either C itself, or one of C's parents by C<@ISA> inheritance. Any class for which this function returns true is "universal" in the sense that all classes potentially inherit methods from it. =cut sub __is_universal { my $classname = shift; die "mro::is_universal requires a classname" if !defined $classname; my $lin = __get_linear_isa('UNIVERSAL'); foreach (@$lin) { return 1 if $classname eq $_; } return 0; } =head2 mro::invalidate_all_method_caches Increments C, which invalidates method caching in all packages. Please note that this is rarely necessary, unless you are dealing with a situation which is known to confuse Perl's method caching. =cut sub __invalidate_all_method_caches { # Super secret mystery code :) @f845a9c1ac41be33::ISA = @f845a9c1ac41be33::ISA; return; } =head2 mro::method_changed_in($classname) Invalidates the method cache of any classes dependent on the given class. In L on pre-5.9.5 Perls, this is an alias for C above, as pre-5.9.5 Perls have no other way to do this. It will still enforce the requirement that you pass it a classname, for compatibility. Please note that this is rarely necessary, unless you are dealing with a situation which is known to confuse Perl's method caching. =cut sub __method_changed_in { my $classname = shift; die "mro::method_changed_in requires a classname" if !defined $classname; __invalidate_all_method_caches(); } =head2 mro::get_pkg_gen($classname) Returns an integer which is incremented every time a local method of or the C<@ISA> of the given package changes on Perl 5.9.5+. On earlier Perls with this L module, it will probably increment a lot more often than necessary. =cut { my $__pkg_gen = 2; sub __get_pkg_gen_pp { my $classname = shift; die "mro::get_pkg_gen requires a classname" if !defined $classname; return $__pkg_gen++; } } sub __get_pkg_gen_c3xs { my $classname = shift; die "mro::get_pkg_gen requires a classname" if !defined $classname; return Class::C3::XS::_plsubgen(); } =head1 USING C3 While this module makes the 5.9.5+ syntaxes C and C available on older Perls, it does so merely by passing off the work to L. It does not remove the need for you to call C, C, and/or C at the appropriate times as documented in the L docs. These three functions are always provided by L, either via L itself on older Perls, or directly as no-ops on 5.9.5+. =head1 SEE ALSO L L =head1 AUTHOR Brandon L. Black, Eblblack@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright 2007-2008 Brandon L. Black Eblblack@gmail.comE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1;