From: Brandon L Black Date: Fri, 11 May 2007 03:42:07 +0000 (+0000) Subject: renamed the insides, updated a bit X-Git-Tag: 0.02~9 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=399a1dc707d49515a13c25c3bfb3bfbbcc42c09a;hp=cfd77a25117f199f698ba7bb018d17532d8b3e86;p=gitmo%2FMRO-Compat.git renamed the insides, updated a bit --- diff --git a/lib/MRO/Compat.pm b/lib/MRO/Compat.pm index 8e26b64..ca32464 100644 --- a/lib/MRO/Compat.pm +++ b/lib/MRO/Compat.pm @@ -1,26 +1,36 @@ -package mro; +package MRO::Compat; use strict; use warnings; -# mro.pm versions >= 1.00 reserved for the Perl core our $VERSION = '0.01'; +# Is Class::C3 installed locally? our $C3_INSTALLED; + BEGIN { - eval { require Class::C3 }; - if(!$@) { - $C3_INSTALLED = 1; + # Don't do anything if 5.9.5+ + if($] < 5.009_005) { + # Find out if we have Class::C3 at all + eval { require Class::C3 }; + $C3_INSTALLED = 1 if !$@; + + # Alias our private functions over to + # the mro:: namespace + *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; } } -sub import { - die q{The "use mro 'foo'" syntax is only supported on Perl 5.9.5+} - if $_[1]; -} - =head1 NAME -mro - Method Resolution Order +MRO::Compat - Partial mro::* interface compatibility for Perls < 5.9.5 =head1 SYNOPSIS @@ -30,30 +40,28 @@ mro - Method Resolution Order package Z; use base qw/ZZZ/; package main; - use mro; + use MRO::Compat; my $linear = mro::get_linear_isa('FooClass'); - print join(q{, }, @$linear) . "\n"; + print join(q{, }, @$linear); # Prints: "FooClass, X, ZZZ, Y, Z" =head1 DESCRIPTION The "mro" namespace provides several utilities for dealing -with method resolution order and method caching in general. +with method resolution order and method caching in general +in Perl 5.9.5 and higher. -It never exports any functions. All calls must be fully -qualified with the C prefix. +This module provides a subset of those interfaces for +earlier versions of Perl. It is a harmless no-op to use +it on 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. -=head1 IMPORTANT INFORMATION - -This module is only for use on Perls earlier than 5.9.5. -Perl version 5.9.5 and higher includes its own superior -implementation, with a version number greater than 1.00. - -This CPAN implementation supports a small subset of the -features of the 5.9.5+ version, to make it easier for -some classes of modules to depend on these features and -be compatible with older Perls. +This module never exports any functions. All calls must +be fully qualified with the C prefix. =head1 Functions @@ -68,26 +76,66 @@ 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. -Explicitly asking for the C MRO of a class will die if -L is not installed. If L is installed, it will -detect C3 classes and return the correct C3 MRO unless explicitly -asked to return the C MRO. +On pre-5.9.5 Perls with MRO::Compat, explicitly asking for the C +MRO of a class will die if L is not installed. If +L is installed, it will detect C3 classes and return the +correct C3 MRO unless explicitly asked to return the C MRO. 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 { +} + +=head2 mro::import + +Not supported, and hence 5.9.5's "use mro 'foo'" is also not supported. +These will die if used on pre-5.9.5 Perls. + +=cut + +sub __import { + die q{The "use mro 'foo'" is only supported on Perl 5.9.5+}; +} + =head2 mro::set_mro($classname, $type) -Not supported in this version, will die if used. +Not supported, will die if used on pre-5.9.5 Perls. + +=cut + +sub __set_mro { + die q{mro::set_mro() is only supported on Perl 5.9.5+}; +} =head2 mro::get_mro($classname) Returns the MRO of the given class (either C or C). +=cut + +sub __get_mro { + my $classname = shift + die "mro::get_mro requires a classname" if !$classname; + if($C3_INSTALLED && exists $Class::C3::MRO{$classname} + && $Class::C3::_initialized) { + return 'c3'; + } + return 'dfs'; +} + =head2 mro::get_isarev($classname) -Not supported in this version, will die if used. +Not supported, will die if used on pre-5.9.5 Perls. + +=cut + +sub __get_isarev { + die "mro::get_isarev() is only supported on Perl 5.9.5+"; +} =head2 mro::is_universal($classname) @@ -99,24 +147,57 @@ Any class for which this function returns true is "universal" in the sense that all classes potentially inherit methods from it. -=head2 mro::invalidate_all_method_caches() +=cut + +sub __is_universal { + my $classname = shift; + die "mro::is_universal requires a classname" if !$classname; + + my $lin = __get_linear_isa($classname); + foreach (@$lin) { + return 1 if $classname eq $_; + } + + return 0; +} + +=head2 mro::invalidate_all_method_caches Increments C, which invalidates method caching in all packages. +=cut + +sub __invalidate_all_method_caches { + # Super secret mystery code :) + @fedcba98::ISA = @fedcba98::ISA; + return; +} + =head2 mro::method_changed_in($classname) Invalidates the method cache of any classes dependent on the -given class. In this version, 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 with 5.9.5. +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. + +=cut + +sub __method_changed_in { + my $classname = shift; + die "mro::method_changed_in requires a classname" if !$classname; + + __invalidate_all_method_caches(); +} =head1 SEE ALSO L +L + =head1 AUTHOR Brandon L. Black, Eblblack@gmail.comE