9 # Alias our private functions over to
10 # the mro:: namespace and load
11 # Class::C3 if Perl < 5.9.5
14 *mro::import = \&__import;
15 *mro::get_linear_isa = \&__get_linear_isa;
16 *mro::set_mro = \&__set_mro;
17 *mro::get_mro = \&__get_mro;
18 *mro::get_isarev = \&__get_isarev;
19 *mro::is_universal = \&__is_universal;
20 *mro::method_changed_in = \&__method_changed_in;
21 *mro::invalidate_all_method_caches
22 = \&__invalidate_all_method_caches;
25 # Provide no-op Class::C3::.*initialize() funcs for 5.9.5+
27 no warnings 'redefine';
28 *Class::C3::initialize = sub { 1 };
29 *Class::C3::reinitialize = sub { 1 };
30 *Class::C3::uninitialize = sub { 1 };
36 MRO::Compat - Partial mro::* interface compatibility for Perls < 5.9.5
40 package FooClass; use base qw/X Y Z/;
41 package X; use base qw/ZZZ/;
42 package Y; use base qw/ZZZ/;
43 package Z; use base qw/ZZZ/;
47 my $linear = mro::get_linear_isa('FooClass');
48 print join(q{, }, @$linear);
50 # Prints: "FooClass, X, ZZZ, Y, Z"
54 The "mro" namespace provides several utilities for dealing
55 with method resolution order and method caching in general
56 in Perl 5.9.5 and higher.
58 This module provides a subset of those interfaces for
59 earlier versions of Perl (back to 5.6.0 anyways).
61 It is a harmless no-op to use it on 5.9.5+. If you're
62 writing a piece of software that would like to use the
63 parts of 5.9.5+'s mro:: interfaces that are supported
64 here, and you want compatibility with older Perls, this
65 is the module for you.
67 This module never exports any functions. All calls must
68 be fully qualified with the C<mro::> prefix.
72 =head2 mro::get_linear_isa($classname[, $type])
74 Returns an arrayref which is the linearized MRO of the given class.
75 Uses whichever MRO is currently in effect for that class by default,
76 or the given MRO (either C<c3> or C<dfs> if specified as C<$type>).
78 The linearized MRO of a class is a single ordered list of all of the
79 classes that would be visited in the process of resolving a method
80 on the given class, starting with itself. It does not include any
83 Note that C<UNIVERSAL> (and any members of C<UNIVERSAL>'s MRO) are not
84 part of the MRO of a class, even though all classes implicitly inherit
85 methods from C<UNIVERSAL> and its parents.
89 sub __get_linear_isa_dfs {
92 my $classname = shift;
94 my @lin = ($classname);
96 foreach my $parent (@{"$classname\::ISA"}) {
97 my $plin = __get_linear_isa_dfs($parent);
99 next if exists $stored{$_};
107 sub __get_linear_isa {
108 my ($classname, $type) = @_;
109 die "mro::get_mro requires a classname" if !$classname;
111 $type ||= __get_mro($classname);
113 return __get_linear_isa_dfs($classname);
115 elsif($type eq 'c3') {
116 return [Class::C3::calculateMRO($classname)];
118 die "type argument must be 'dfs' or 'c3'";
123 This allows the C<use mro 'dfs'> and
124 C<use mro 'c3'> syntaxes, providing you
125 L<use MRO::Compat> first. Please see the
126 L</USING C3> section for additional details.
132 goto &Class::C3::import if $_[1] eq 'c3';
133 __set_mro(scalar(caller), $_[1]);
137 =head2 mro::set_mro($classname, $type)
139 Sets the mro of C<$classname> to one of the types
140 C<dfs> or C<c3>. Please see the L</USING C3>
141 section for additional details.
146 my ($classname, $type) = @_;
147 if(!$classname || !$type) {
148 die q{Usage: mro::set_mro($classname, $type)};
151 eval "package $classname; use Class::C3";
155 die q{Invalid mro type "$type"};
158 # In the dfs case, check whether we need to
160 if(defined $Class::C3::MRO{$classname}) {
161 Class::C3::_remove_method_dispatch_table($classname);
163 delete $Class::C3::MRO{$classname};
168 =head2 mro::get_mro($classname)
170 Returns the MRO of the given class (either C<c3> or C<dfs>).
172 It considers any Class::C3-using class to have C3 MRO
173 even before L<Class::C3::initialize()> is called.
178 my $classname = shift;
179 die "mro::get_mro requires a classname" if !$classname;
180 return 'c3' if exists $Class::C3::MRO{$classname};
184 =head2 mro::get_isarev($classname)
186 Not supported, will die if used on pre-5.9.5 Perls.
190 # In theory this could be made to work, but it would
191 # be an insanely slow algorithm if any reasonably large
192 # number of modules were loaded.
194 die "mro::get_isarev() is only supported on Perl 5.9.5+";
197 =head2 mro::is_universal($classname)
199 Returns a boolean status indicating whether or not
200 the given classname is either C<UNIVERSAL> itself,
201 or one of C<UNIVERSAL>'s parents by C<@ISA> inheritance.
203 Any class for which this function returns true is
204 "universal" in the sense that all classes potentially
205 inherit methods from it.
210 my $classname = shift;
211 die "mro::is_universal requires a classname" if !$classname;
213 my $lin = __get_linear_isa($classname);
215 return 1 if $classname eq $_;
221 =head2 mro::invalidate_all_method_caches
223 Increments C<PL_sub_generation>, which invalidates method
224 caching in all packages.
228 sub __invalidate_all_method_caches {
229 # Super secret mystery code :)
230 @fedcba98::ISA = @fedcba98::ISA;
234 =head2 mro::method_changed_in($classname)
236 Invalidates the method cache of any classes dependent on the
237 given class. In L<MRO::Compat> on pre-5.9.5 Perls, this is
238 an alias for C<mro::invalidate_all_method_caches> above, as
239 pre-5.9.5 Perls have no other way to do this. It will still
240 enforce the requirement that you pass it a classname, for
245 sub __method_changed_in {
246 my $classname = shift;
247 die "mro::method_changed_in requires a classname" if !$classname;
249 __invalidate_all_method_caches();
254 While this module makes the 5.9.5+ syntaxes
255 C<use mro 'c3'> and C<mro::set_mro("Foo", 'c3')> available
256 on older Perls, it does so merely by passing off the work
259 It does not remove the need for you to call
260 L<Class::C3>'s C<initialize()>, C<reinitialize()>, and/or
261 C<uninitialize()> at the appropriate times
262 as documented in the L<Class::C3> docs.
264 Because L<MRO::Compat> has L<Class::C3> as a pre-requisite,
265 and requires it at C<use> time, you can blindly call
266 those functions in code that uses L<MRO::Compat>.
267 Under 5.9.5+ with L<MRO::Compat>, your calls to those
268 functions will become a no-op and everything will work fine.
278 Brandon L. Black, E<lt>blblack@gmail.comE<gt>
280 =head1 COPYRIGHT AND LICENSE
282 Copyright 2007 Brandon L. Black E<lt>blblack@gmail.comE<gt>
284 This library is free software; you can redistribute it and/or modify
285 it under the same terms as Perl itself.