fix really stupid bug wrt defined package names that are false
[gitmo/MRO-Compat.git] / lib / MRO / Compat.pm
index 2607e81..8c7e224 100644 (file)
@@ -3,14 +3,18 @@ use strict;
 use warnings;
 require 5.006_000;
 
-our $VERSION = '0.01';
+# Keep this < 1.00, so people can tell the fake
+#  mro.pm from the real one
+our $VERSION = '0.05';
 
 BEGIN {
     # Alias our private functions over to
     # the mro:: namespace and load
     # Class::C3 if Perl < 5.9.5
     if($] < 5.009_005) {
-        require Class::C3;
+        $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;
@@ -20,10 +24,18 @@ BEGIN {
         *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;
+        }
     }
 
-    # Provide no-op Class::C3::.*initialize() funcs for 5.9.5+
+    # 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 };
@@ -58,15 +70,29 @@ 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+.  If
-you're writing a piece of software that would like to use
+It is a harmless no-op to use this module on 5.9.5+.  That
+is to say, code which properly uses L<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
+L<Class::C3::XS> installed (which is an optional prereq
+of L<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 C<mro::> prefix.
 
+The interface documentation here serves only as a quick
+reference of what the function basically does, and what
+differences between L<MRO::Compat> and 5.9.5+ one should
+look out for.  The main docs in 5.9.5's L<mro> are the real
+interface docs, and contain a lot of other useful information.
+
 =head1 Functions
 
 =head2 mro::get_linear_isa($classname[, $type])
@@ -106,7 +132,7 @@ sub __get_linear_isa_dfs {
 
 sub __get_linear_isa {
     my ($classname, $type) = @_;
-    die "mro::get_mro requires a classname" if !$classname;
+    die "mro::get_mro requires a classname" if !defined $classname;
 
     $type ||= __get_mro($classname);
     if($type eq 'dfs') {
@@ -144,7 +170,7 @@ section for additional details.
 
 sub __set_mro {
     my ($classname, $type) = @_;
-    if(!$classname || !$type) {
+    if(!defined $classname || !$type) {
         die q{Usage: mro::set_mro($classname, $type)};
     }
     if($type eq 'c3') {
@@ -155,8 +181,7 @@ sub __set_mro {
         die q{Invalid mro type "$type"};
     }
 
-    # In the dfs case, check whether we need to
-    #  undo C3
+    # In the dfs case, check whether we need to undo C3
     if(defined $Class::C3::MRO{$classname}) {
         Class::C3::_remove_method_dispatch_table($classname);
     }
@@ -176,15 +201,15 @@ even before L<Class::C3::initialize()> is called.
 
 sub __get_mro {
     my $classname = shift;
-    die "mro::get_mro requires a classname" if !$classname;
+    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 array of classes who are subclasses of the
-given classname.  In other words, classes who we exists,
+Returns an arrayref of classes who are subclasses of the
+given classname.  In other words, classes who we exist,
 however indirectly, in the @ISA inheritancy hierarchy of.
 
 This is much slower on pre-5.9.5 Perls with MRO::Compat
@@ -202,7 +227,7 @@ sub __get_all_pkgs_with_isas {
     my $search = shift;
     my $pfx;
     my $isa;
-    if($search) {
+    if(defined $search) {
         $isa = \@{"$search\::ISA"};
         $pfx = "$search\::";
     }
@@ -215,8 +240,7 @@ sub __get_all_pkgs_with_isas {
     push(@retval, $search) if scalar(@$isa);
 
     foreach my $cand (keys %{"$search\::"}) {
-        if($cand =~ /::$/) {
-            $cand =~ s/::$//;
+        if($cand =~ s/::$//) {
             next if $cand eq $search; # skip self-reference (main?)
             push(@retval, @{__get_all_pkgs_with_isas($pfx . $cand)});
         }
@@ -253,9 +277,9 @@ sub __get_isarev_recurse {
 
 sub __get_isarev {
     my $classname = shift;
-    die "mro::get_isarev requires a classname" if !$classname;
+    die "mro::get_isarev requires a classname" if !defined $classname;
 
-    sort @{__get_isarev_recurse($classname, __get_all_pkgs_with_isas(), 0)};
+    __get_isarev_recurse($classname, __get_all_pkgs_with_isas(), 0);
 }
 
 =head2 mro::is_universal($classname)
@@ -272,7 +296,7 @@ inherit methods from it.
 
 sub __is_universal {
     my $classname = shift;
-    die "mro::is_universal requires a classname" if !$classname;
+    die "mro::is_universal requires a classname" if !defined $classname;
 
     my $lin = __get_linear_isa('UNIVERSAL');
     foreach (@$lin) {
@@ -287,11 +311,15 @@ sub __is_universal {
 Increments C<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.
+
 =cut
 
 sub __invalidate_all_method_caches {
     # Super secret mystery code :)
-    @fedcba98::ISA = @fedcba98::ISA;
+    @f845a9c1ac41be33::ISA = @f845a9c1ac41be33::ISA;
     return;
 }
 
@@ -304,15 +332,44 @@ 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 !$classname;
+    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<MRO::Compat> 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
@@ -321,15 +378,11 @@ on older Perls, it does so merely by passing off the work
 to L<Class::C3>.
 
 It does not remove the need for you to call
-L<Class::C3>'s C<initialize()>, C<reinitialize()>, and/or
-C<uninitialize()> at the appropriate times
-as documented in the L<Class::C3> docs.
-
-Because L<MRO::Compat> has L<Class::C3> as a pre-requisite,
-and requires it at C<use> time, you can blindly call
-those functions in code that uses L<MRO::Compat>.
-Under 5.9.5+ with L<MRO::Compat>, your calls to those
-functions will become a no-op and everything will work fine.
+C<Class::C3::initialize()>, C<Class::C3::reinitialize()>, and/or
+C<Class::C3::uninitialize()> at the appropriate times
+as documented in the L<Class::C3> docs.  These three functions
+are always provided by L<MRO::Compat>, either via L<Class::C3>
+itself on older Perls, or directly as no-ops on 5.9.5+.
 
 =head1 SEE ALSO