# Keep this < 1.00, so people can tell the fake
# mro.pm from the real one
-our $VERSION = '0.01_01';
+our $VERSION = '0.10';
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;
*mro::method_changed_in = \&__method_changed_in;
*mro::invalidate_all_method_caches
= \&__invalidate_all_method_caches;
- $mro::VERSION = $VERSION;
- $INC{'mro.pm'} = 'Faked by MRO::Compat';
+ 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 };
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.
-=head1 VERSION 0.01_01
-
-This is the first dev release of this new module, and on top of that,
-the Perl 5.9.5 it seeks to provide compatibility with isn't even
-out yet. Consider it not fully stabilized for the time being.
-These interfaces are not necessarily nailed down yet.
+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])
-Returns an arrayref which is the linearized MRO of the given class.
+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<c3> or C<dfs> if specified as C<$type>).
-The linearized MRO of a class is a single ordered list of all of the
+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.
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') {
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') {
eval "package $classname; use Class::C3";
die $@ if $@;
}
- if($type ne 'dfs') {
- die q{Invalid mro type "$type"};
+ 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};
}
-
- # In the dfs case, check whether we need to undo C3
- if(defined $Class::C3::MRO{$classname}) {
- Class::C3::_remove_method_dispatch_table($classname);
+ else {
+ die qq{Invalid mro type "$type"};
}
- delete $Class::C3::MRO{$classname};
return;
}
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
my $search = shift;
my $pfx;
my $isa;
- if($search) {
+ if(defined $search) {
$isa = \@{"$search\::ISA"};
$pfx = "$search\::";
}
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)});
}
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;
- @{__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)
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) {
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;
}
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
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
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 Brandon L. Black E<lt>blblack@gmail.comE<gt>
+Copyright 2007-2008 Brandon L. Black E<lt>blblack@gmail.comE<gt>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.