Profile of MRO/Compat.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:22:34 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/MRO/Compat.pm
Statements | Executed 73 statements in 1.17ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
42 | 1 | 1 | 110µs | 110µs | MRO::Compat::::__ANON__[:41]MRO::Compat::__ANON__[:41]
1 | 1 | 1 | 23µs | 23µs | MRO::Compat::::BEGIN@10MRO::Compat::BEGIN@10
1 | 1 | 1 | 11µs | 14µs | MRO::Compat::::BEGIN@2MRO::Compat::BEGIN@2
1 | 1 | 1 | 6µs | 13µs | MRO::Compat::::BEGIN@39MRO::Compat::BEGIN@39
1 | 1 | 1 | 6µs | 15µs | MRO::Compat::::BEGIN@3MRO::Compat::BEGIN@3
1 | 1 | 1 | 6µs | 13µs | MRO::Compat::::BEGIN@226MRO::Compat::BEGIN@226
1 | 1 | 1 | 5µs | 13µs | MRO::Compat::::BEGIN@225MRO::Compat::BEGIN@225
1 | 1 | 1 | 5µs | 13µs | MRO::Compat::::BEGIN@256MRO::Compat::BEGIN@256
1 | 1 | 1 | 5µs | 13µs | MRO::Compat::::BEGIN@116MRO::Compat::BEGIN@116
0 | 0 | 0 | 0s | 0s | MRO::Compat::::__ANON__[:40]MRO::Compat::__ANON__[:40]
0 | 0 | 0 | 0s | 0s | MRO::Compat::::__ANON__[:42]MRO::Compat::__ANON__[:42]
0 | 0 | 0 | 0s | 0s | MRO::Compat::::__get_all_pkgs_with_isasMRO::Compat::__get_all_pkgs_with_isas
0 | 0 | 0 | 0s | 0s | MRO::Compat::::__get_isarevMRO::Compat::__get_isarev
0 | 0 | 0 | 0s | 0s | MRO::Compat::::__get_isarev_recurseMRO::Compat::__get_isarev_recurse
0 | 0 | 0 | 0s | 0s | MRO::Compat::::__get_linear_isaMRO::Compat::__get_linear_isa
0 | 0 | 0 | 0s | 0s | MRO::Compat::::__get_linear_isa_dfsMRO::Compat::__get_linear_isa_dfs
0 | 0 | 0 | 0s | 0s | MRO::Compat::::__get_mroMRO::Compat::__get_mro
0 | 0 | 0 | 0s | 0s | MRO::Compat::::__get_pkg_gen_c3xsMRO::Compat::__get_pkg_gen_c3xs
0 | 0 | 0 | 0s | 0s | MRO::Compat::::__get_pkg_gen_ppMRO::Compat::__get_pkg_gen_pp
0 | 0 | 0 | 0s | 0s | MRO::Compat::::__importMRO::Compat::__import
0 | 0 | 0 | 0s | 0s | MRO::Compat::::__invalidate_all_method_cachesMRO::Compat::__invalidate_all_method_caches
0 | 0 | 0 | 0s | 0s | MRO::Compat::::__is_universalMRO::Compat::__is_universal
0 | 0 | 0 | 0s | 0s | MRO::Compat::::__method_changed_inMRO::Compat::__method_changed_in
0 | 0 | 0 | 0s | 0s | MRO::Compat::::__set_mroMRO::Compat::__set_mro

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package MRO::Compat;
2 | 3 | 16µs | 2 | 16µs | # spent 14µs (11+3) within MRO::Compat::BEGIN@2 which was called: # once (11µs+3µs) by main::BEGIN@8 at line 2 use strict; # spent 14µs making 1 call to MRO::Compat::BEGIN@2 # spent 3µs making 1 call to strict::import
3 | 3 | 136µs | 2 | 23µs | # spent 15µs (6+9) within MRO::Compat::BEGIN@3 which was called: # once (6µs+9µs) by main::BEGIN@8 at line 3 use warnings; # spent 15µs making 1 call to MRO::Compat::BEGIN@3 # spent 9µs making 1 call to warnings::import
4 | 1 | 35µs |  |  | require 5.006_000;
5 |  |  |  |  |
6 |  |  |  |  | # Keep this < 1.00, so people can tell the fake
7 |  |  |  |  | # mro.pm from the real one
8 | 1 | 400ns |  |  | our $VERSION = '0.11';
9 |  |  |  |  |
10 |  |  |  |  | # spent 23µs within MRO::Compat::BEGIN@10 which was called: # once (23µs+0s) by main::BEGIN@8 at line 44 BEGIN {
11 |  |  |  |  | # Alias our private functions over to
12 |  |  |  |  | # the mro:: namespace and load
13 |  |  |  |  | # Class::C3 if Perl < 5.9.5
14 | 5 | 23µs |  |  | if($] < 5.009_005) {
15 |  |  |  |  | $mro::VERSION # to fool Module::Install when generating META.yml
16 |  |  |  |  | = $VERSION;
17 |  |  |  |  | $INC{'mro.pm'} = __FILE__;
18 |  |  |  |  | *mro::import = \&__import;
19 |  |  |  |  | *mro::get_linear_isa = \&__get_linear_isa;
20 |  |  |  |  | *mro::set_mro = \&__set_mro;
21 |  |  |  |  | *mro::get_mro = \&__get_mro;
22 |  |  |  |  | *mro::get_isarev = \&__get_isarev;
23 |  |  |  |  | *mro::is_universal = \&__is_universal;
24 |  |  |  |  | *mro::method_changed_in = \&__method_changed_in;
25 |  |  |  |  | *mro::invalidate_all_method_caches
26 |  |  |  |  | = \&__invalidate_all_method_caches;
27 |  |  |  |  | require Class::C3;
28 |  |  |  |  | if($Class::C3::XS::VERSION && $Class::C3::XS::VERSION > 0.03) {
29 |  |  |  |  | *mro::get_pkg_gen = \&__get_pkg_gen_c3xs;
30 |  |  |  |  | }
31 |  |  |  |  | else {
32 |  |  |  |  | *mro::get_pkg_gen = \&__get_pkg_gen_pp;
33 |  |  |  |  | }
34 |  |  |  |  | }
35 |  |  |  |  |
36 |  |  |  |  | # Load mro.pm and provide no-op Class::C3::.*initialize() funcs for 5.9.5+
37 |  |  |  |  | else {
38 |  |  |  |  | require mro;
39 | 3 | 66µs | 2 | 21µs | # spent 13µs (6+7) within MRO::Compat::BEGIN@39 which was called: # once (6µs+7µs) by main::BEGIN@8 at line 39 no warnings 'redefine'; # spent 13µs making 1 call to MRO::Compat::BEGIN@39 # spent 7µs making 1 call to warnings::unimport
40 |  |  |  |  | *Class::C3::initialize = sub { 1 };
41 | 42 | 106µs |  |  | # spent 110µs within MRO::Compat::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/MRO/Compat.pm:41] which was called 42 times, avg 3µs/call: # 42 times (110µs+0s) by Class::C3::Componentised::_load_components at line 96 of Class/C3/Componentised.pm, avg 3µs/call *Class::C3::reinitialize = sub { 1 };
42 |  |  |  |  | *Class::C3::uninitialize = sub { 1 };
43 |  |  |  |  | }
44 | 1 | 43µs | 1 | 23µs | } # spent 23µs making 1 call to MRO::Compat::BEGIN@10
45 |  |  |  |  |
46 |  |  |  |  | =head1 NAME
47 |  |  |  |  |
48 |  |  |  |  | MRO::Compat - mro::* interface compatibility for Perls < 5.9.5
49 |  |  |  |  |
50 |  |  |  |  | =head1 SYNOPSIS
51 |  |  |  |  |
52 |  |  |  |  | package FooClass; use base qw/X Y Z/;
53 |  |  |  |  | package X; use base qw/ZZZ/;
54 |  |  |  |  | package Y; use base qw/ZZZ/;
55 |  |  |  |  | package Z; use base qw/ZZZ/;
56 |  |  |  |  |
57 |  |  |  |  | package main;
58 |  |  |  |  | use MRO::Compat;
59 |  |  |  |  | my $linear = mro::get_linear_isa('FooClass');
60 |  |  |  |  | print join(q{, }, @$linear);
61 |  |  |  |  |
62 |  |  |  |  | # Prints: "FooClass, X, ZZZ, Y, Z"
63 |  |  |  |  |
64 |  |  |  |  | =head1 DESCRIPTION
65 |  |  |  |  |
66 |  |  |  |  | The "mro" namespace provides several utilities for dealing
67 |  |  |  |  | with method resolution order and method caching in general
68 |  |  |  |  | in Perl 5.9.5 and higher.
69 |  |  |  |  |
70 |  |  |  |  | This module provides those interfaces for
71 |  |  |  |  | earlier versions of Perl (back to 5.6.0 anyways).
72 |  |  |  |  |
73 |  |  |  |  | It is a harmless no-op to use this module on 5.9.5+. That
74 |  |  |  |  | is to say, code which properly uses L<MRO::Compat> will work
75 |  |  |  |  | unmodified on both older Perls and 5.9.5+.
76 |  |  |  |  |
77 |  |  |  |  | If you're writing a piece of software that would like to use
78 |  |  |  |  | the parts of 5.9.5+'s mro:: interfaces that are supported
79 |  |  |  |  | here, and you want compatibility with older Perls, this
80 |  |  |  |  | is the module for you.
81 |  |  |  |  |
82 |  |  |  |  | Some parts of this code will work better and/or faster with
83 |  |  |  |  | L<Class::C3::XS> installed (which is an optional prereq
84 |  |  |  |  | of L<Class::C3>, which is in turn a prereq of this
85 |  |  |  |  | package), but it's not a requirement.
86 |  |  |  |  |
87 |  |  |  |  | This module never exports any functions. All calls must
88 |  |  |  |  | be fully qualified with the C<mro::> prefix.
89 |  |  |  |  |
90 |  |  |  |  | The interface documentation here serves only as a quick
91 |  |  |  |  | reference of what the function basically does, and what
92 |  |  |  |  | differences between L<MRO::Compat> and 5.9.5+ one should
93 |  |  |  |  | look out for. The main docs in 5.9.5's L<mro> are the real
94 |  |  |  |  | interface docs, and contain a lot of other useful information.
95 |  |  |  |  |
96 |  |  |  |  | =head1 Functions
97 |  |  |  |  |
98 |  |  |  |  | =head2 mro::get_linear_isa($classname[, $type])
99 |  |  |  |  |
100 |  |  |  |  | Returns an arrayref which is the linearized "ISA" of the given class.
101 |  |  |  |  | Uses whichever MRO is currently in effect for that class by default,
102 |  |  |  |  | or the given MRO (either C<c3> or C<dfs> if specified as C<$type>).
103 |  |  |  |  |
104 |  |  |  |  | The linearized ISA of a class is a single ordered list of all of the
105 |  |  |  |  | classes that would be visited in the process of resolving a method
106 |  |  |  |  | on the given class, starting with itself. It does not include any
107 |  |  |  |  | duplicate entries.
108 |  |  |  |  |
109 |  |  |  |  | Note that C<UNIVERSAL> (and any members of C<UNIVERSAL>'s MRO) are not
110 |  |  |  |  | part of the MRO of a class, even though all classes implicitly inherit
111 |  |  |  |  | methods from C<UNIVERSAL> and its parents.
112 |  |  |  |  |
113 |  |  |  |  | =cut
114 |  |  |  |  |
115 |  |  |  |  | sub __get_linear_isa_dfs {
116 | 3 | 295µs | 2 | 21µs | # spent 13µs (5+8) within MRO::Compat::BEGIN@116 which was called: # once (5µs+8µs) by main::BEGIN@8 at line 116 no strict 'refs'; # spent 13µs making 1 call to MRO::Compat::BEGIN@116 # spent 8µs making 1 call to strict::unimport
117 |  |  |  |  |
118 |  |  |  |  | my $classname = shift;
119 |  |  |  |  |
120 |  |  |  |  | my @lin = ($classname);
121 |  |  |  |  | my %stored;
122 |  |  |  |  | foreach my $parent (@{"$classname\::ISA"}) {
123 |  |  |  |  | my $plin = __get_linear_isa_dfs($parent);
124 |  |  |  |  | foreach (@$plin) {
125 |  |  |  |  | next if exists $stored{$_};
126 |  |  |  |  | push(@lin, $_);
127 |  |  |  |  | $stored{$_} = 1;
128 |  |  |  |  | }
129 |  |  |  |  | }
130 |  |  |  |  | return \@lin;
131 |  |  |  |  | }
132 |  |  |  |  |
133 |  |  |  |  | sub __get_linear_isa {
134 |  |  |  |  | my ($classname, $type) = @_;
135 |  |  |  |  | die "mro::get_mro requires a classname" if !defined $classname;
136 |  |  |  |  |
137 |  |  |  |  | $type ||= __get_mro($classname);
138 |  |  |  |  | if($type eq 'dfs') {
139 |  |  |  |  | return __get_linear_isa_dfs($classname);
140 |  |  |  |  | }
141 |  |  |  |  | elsif($type eq 'c3') {
142 |  |  |  |  | return [Class::C3::calculateMRO($classname)];
143 |  |  |  |  | }
144 |  |  |  |  | die "type argument must be 'dfs' or 'c3'";
145 |  |  |  |  | }
146 |  |  |  |  |
147 |  |  |  |  | =head2 mro::import
148 |  |  |  |  |
149 |  |  |  |  | This allows the C<use mro 'dfs'> and
150 |  |  |  |  | C<use mro 'c3'> syntaxes, providing you
151 |  |  |  |  | L<use MRO::Compat> first. Please see the
152 |  |  |  |  | L</USING C3> section for additional details.
153 |  |  |  |  |
154 |  |  |  |  | =cut
155 |  |  |  |  |
156 |  |  |  |  | sub __import {
157 |  |  |  |  | if($_[1]) {
158 |  |  |  |  | goto &Class::C3::import if $_[1] eq 'c3';
159 |  |  |  |  | __set_mro(scalar(caller), $_[1]);
160 |  |  |  |  | }
161 |  |  |  |  | }
162 |  |  |  |  |
163 |  |  |  |  | =head2 mro::set_mro($classname, $type)
164 |  |  |  |  |
165 |  |  |  |  | Sets the mro of C<$classname> to one of the types
166 |  |  |  |  | C<dfs> or C<c3>. Please see the L</USING C3>
167 |  |  |  |  | section for additional details.
168 |  |  |  |  |
169 |  |  |  |  | =cut
170 |  |  |  |  |
171 |  |  |  |  | sub __set_mro {
172 |  |  |  |  | my ($classname, $type) = @_;
173 |  |  |  |  |
174 |  |  |  |  | if(!defined $classname || !$type) {
175 |  |  |  |  | die q{Usage: mro::set_mro($classname, $type)};
176 |  |  |  |  | }
177 |  |  |  |  |
178 |  |  |  |  | if($type eq 'c3') {
179 |  |  |  |  | eval "package $classname; use Class::C3";
180 |  |  |  |  | die $@ if $@;
181 |  |  |  |  | }
182 |  |  |  |  | elsif($type eq 'dfs') {
183 |  |  |  |  | # In the dfs case, check whether we need to undo C3
184 |  |  |  |  | if(defined $Class::C3::MRO{$classname}) {
185 |  |  |  |  | Class::C3::_remove_method_dispatch_table($classname);
186 |  |  |  |  | }
187 |  |  |  |  | delete $Class::C3::MRO{$classname};
188 |  |  |  |  | }
189 |  |  |  |  | else {
190 |  |  |  |  | die qq{Invalid mro type "$type"};
191 |  |  |  |  | }
192 |  |  |  |  |
193 |  |  |  |  | return;
194 |  |  |  |  | }
195 |  |  |  |  |
196 |  |  |  |  | =head2 mro::get_mro($classname)
197 |  |  |  |  |
198 |  |  |  |  | Returns the MRO of the given class (either C<c3> or C<dfs>).
199 |  |  |  |  |
200 |  |  |  |  | It considers any Class::C3-using class to have C3 MRO
201 |  |  |  |  | even before L<Class::C3::initialize()> is called.
202 |  |  |  |  |
203 |  |  |  |  | =cut
204 |  |  |  |  |
205 |  |  |  |  | sub __get_mro {
206 |  |  |  |  | my $classname = shift;
207 |  |  |  |  | die "mro::get_mro requires a classname" if !defined $classname;
208 |  |  |  |  | return 'c3' if exists $Class::C3::MRO{$classname};
209 |  |  |  |  | return 'dfs';
210 |  |  |  |  | }
211 |  |  |  |  |
212 |  |  |  |  | =head2 mro::get_isarev($classname)
213 |  |  |  |  |
214 |  |  |  |  | Returns an arrayref of classes who are subclasses of the
215 |  |  |  |  | given classname. In other words, classes in whose @ISA
216 |  |  |  |  | hierarchy we appear, no matter how indirectly.
217 |  |  |  |  |
218 |  |  |  |  | This is much slower on pre-5.9.5 Perls with MRO::Compat
219 |  |  |  |  | than it is on 5.9.5+, as it has to search the entire
220 |  |  |  |  | package namespace.
221 |  |  |  |  |
222 |  |  |  |  | =cut
223 |  |  |  |  |
224 |  |  |  |  | sub __get_all_pkgs_with_isas {
225 | 3 | 17µs | 2 | 21µs | # spent 13µs (5+8) within MRO::Compat::BEGIN@225 which was called: # once (5µs+8µs) by main::BEGIN@8 at line 225 no strict 'refs'; # spent 13µs making 1 call to MRO::Compat::BEGIN@225 # spent 8µs making 1 call to strict::unimport
226 | 3 | 136µs | 2 | 20µs | # spent 13µs (6+7) within MRO::Compat::BEGIN@226 which was called: # once (6µs+7µs) by main::BEGIN@8 at line 226 no warnings 'recursion'; # spent 13µs making 1 call to MRO::Compat::BEGIN@226 # spent 7µs making 1 call to warnings::unimport
227 |  |  |  |  |
228 |  |  |  |  | my @retval;
229 |  |  |  |  |
230 |  |  |  |  | my $search = shift;
231 |  |  |  |  | my $pfx;
232 |  |  |  |  | my $isa;
233 |  |  |  |  | if(defined $search) {
234 |  |  |  |  | $isa = \@{"$search\::ISA"};
235 |  |  |  |  | $pfx = "$search\::";
236 |  |  |  |  | }
237 |  |  |  |  | else {
238 |  |  |  |  | $search = 'main';
239 |  |  |  |  | $isa = \@main::ISA;
240 |  |  |  |  | $pfx = '';
241 |  |  |  |  | }
242 |  |  |  |  |
243 |  |  |  |  | push(@retval, $search) if scalar(@$isa);
244 |  |  |  |  |
245 |  |  |  |  | foreach my $cand (keys %{"$search\::"}) {
246 |  |  |  |  | if($cand =~ s/::$//) {
247 |  |  |  |  | next if $cand eq $search; # skip self-reference (main?)
248 |  |  |  |  | push(@retval, @{__get_all_pkgs_with_isas($pfx . $cand)});
249 |  |  |  |  | }
250 |  |  |  |  | }
251 |  |  |  |  |
252 |  |  |  |  | return \@retval;
253 |  |  |  |  | }
254 |  |  |  |  |
255 |  |  |  |  | sub __get_isarev_recurse {
256 | 3 | 292µs | 2 | 20µs | # spent 13µs (5+7) within MRO::Compat::BEGIN@256 which was called: # once (5µs+7µs) by main::BEGIN@8 at line 256 no strict 'refs'; # spent 13µs making 1 call to MRO::Compat::BEGIN@256 # spent 7µs making 1 call to strict::unimport
257 |  |  |  |  |
258 |  |  |  |  | my ($class, $all_isas, $level) = @_;
259 |  |  |  |  |
260 |  |  |  |  | die "Recursive inheritance detected" if $level > 100;
261 |  |  |  |  |
262 |  |  |  |  | my %retval;
263 |  |  |  |  |
264 |  |  |  |  | foreach my $cand (@$all_isas) {
265 |  |  |  |  | my $found_me;
266 |  |  |  |  | foreach (@{"$cand\::ISA"}) {
267 |  |  |  |  | if($_ eq $class) {
268 |  |  |  |  | $found_me = 1;
269 |  |  |  |  | last;
270 |  |  |  |  | }
271 |  |  |  |  | }
272 |  |  |  |  | if($found_me) {
273 |  |  |  |  | $retval{$cand} = 1;
274 |  |  |  |  | map { $retval{$_} = 1 }
275 |  |  |  |  | @{__get_isarev_recurse($cand, $all_isas, $level+1)};
276 |  |  |  |  | }
277 |  |  |  |  | }
278 |  |  |  |  | return [keys %retval];
279 |  |  |  |  | }
280 |  |  |  |  |
281 |  |  |  |  | sub __get_isarev {
282 |  |  |  |  | my $classname = shift;
283 |  |  |  |  | die "mro::get_isarev requires a classname" if !defined $classname;
284 |  |  |  |  |
285 |  |  |  |  | __get_isarev_recurse($classname, __get_all_pkgs_with_isas(), 0);
286 |  |  |  |  | }
287 |  |  |  |  |
288 |  |  |  |  | =head2 mro::is_universal($classname)
289 |  |  |  |  |
290 |  |  |  |  | Returns a boolean status indicating whether or not
291 |  |  |  |  | the given classname is either C<UNIVERSAL> itself,
292 |  |  |  |  | or one of C<UNIVERSAL>'s parents by C<@ISA> inheritance.
293 |  |  |  |  |
294 |  |  |  |  | Any class for which this function returns true is
295 |  |  |  |  | "universal" in the sense that all classes potentially
296 |  |  |  |  | inherit methods from it.
297 |  |  |  |  |
298 |  |  |  |  | =cut
299 |  |  |  |  |
300 |  |  |  |  | sub __is_universal {
301 |  |  |  |  | my $classname = shift;
302 |  |  |  |  | die "mro::is_universal requires a classname" if !defined $classname;
303 |  |  |  |  |
304 |  |  |  |  | my $lin = __get_linear_isa('UNIVERSAL');
305 |  |  |  |  | foreach (@$lin) {
306 |  |  |  |  | return 1 if $classname eq $_;
307 |  |  |  |  | }
308 |  |  |  |  |
309 |  |  |  |  | return 0;
310 |  |  |  |  | }
311 |  |  |  |  |
312 |  |  |  |  | =head2 mro::invalidate_all_method_caches
313 |  |  |  |  |
314 |  |  |  |  | Increments C<PL_sub_generation>, which invalidates method
315 |  |  |  |  | caching in all packages.
316 |  |  |  |  |
317 |  |  |  |  | Please note that this is rarely necessary, unless you are
318 |  |  |  |  | dealing with a situation which is known to confuse Perl's
319 |  |  |  |  | method caching.
320 |  |  |  |  |
321 |  |  |  |  | =cut
322 |  |  |  |  |
323 |  |  |  |  | sub __invalidate_all_method_caches {
324 |  |  |  |  | # Super secret mystery code :)
325 |  |  |  |  | @f845a9c1ac41be33::ISA = @f845a9c1ac41be33::ISA;
326 |  |  |  |  | return;
327 |  |  |  |  | }
328 |  |  |  |  |
329 |  |  |  |  | =head2 mro::method_changed_in($classname)
330 |  |  |  |  |
331 |  |  |  |  | Invalidates the method cache of any classes dependent on the
332 |  |  |  |  | given class. In L<MRO::Compat> on pre-5.9.5 Perls, this is
333 |  |  |  |  | an alias for C<mro::invalidate_all_method_caches> above, as
334 |  |  |  |  | pre-5.9.5 Perls have no other way to do this. It will still
335 |  |  |  |  | enforce the requirement that you pass it a classname, for
336 |  |  |  |  | compatibility.
337 |  |  |  |  |
338 |  |  |  |  | Please note that this is rarely necessary, unless you are
339 |  |  |  |  | dealing with a situation which is known to confuse Perl's
340 |  |  |  |  | method caching.
341 |  |  |  |  |
342 |  |  |  |  | =cut
343 |  |  |  |  |
344 |  |  |  |  | sub __method_changed_in {
345 |  |  |  |  | my $classname = shift;
346 |  |  |  |  | die "mro::method_changed_in requires a classname" if !defined $classname;
347 |  |  |  |  |
348 |  |  |  |  | __invalidate_all_method_caches();
349 |  |  |  |  | }
350 |  |  |  |  |
351 |  |  |  |  | =head2 mro::get_pkg_gen($classname)
352 |  |  |  |  |
353 |  |  |  |  | Returns an integer which is incremented every time a local
354 |  |  |  |  | method of or the C<@ISA> of the given package changes on
355 |  |  |  |  | Perl 5.9.5+. On earlier Perls with this L<MRO::Compat> module,
356 |  |  |  |  | it will probably increment a lot more often than necessary.
357 |  |  |  |  |
358 |  |  |  |  | =cut
359 |  |  |  |  |
360 |  |  |  |  | {
361 | 2 | 800ns |  |  | my $__pkg_gen = 2;
362 |  |  |  |  | sub __get_pkg_gen_pp {
363 |  |  |  |  | my $classname = shift;
364 |  |  |  |  | die "mro::get_pkg_gen requires a classname" if !defined $classname;
365 |  |  |  |  | return $__pkg_gen++;
366 |  |  |  |  | }
367 |  |  |  |  | }
368 |  |  |  |  |
369 |  |  |  |  | sub __get_pkg_gen_c3xs {
370 |  |  |  |  | my $classname = shift;
371 |  |  |  |  | die "mro::get_pkg_gen requires a classname" if !defined $classname;
372 |  |  |  |  |
373 |  |  |  |  | return Class::C3::XS::_plsubgen();
374 |  |  |  |  | }
375 |  |  |  |  |
376 |  |  |  |  | =head1 USING C3
377 |  |  |  |  |
378 |  |  |  |  | While this module makes the 5.9.5+ syntaxes
379 |  |  |  |  | C<use mro 'c3'> and C<mro::set_mro("Foo", 'c3')> available
380 |  |  |  |  | on older Perls, it does so merely by passing off the work
381 |  |  |  |  | to L<Class::C3>.
382 |  |  |  |  |
383 |  |  |  |  | It does not remove the need for you to call
384 |  |  |  |  | C<Class::C3::initialize()>, C<Class::C3::reinitialize()>, and/or
385 |  |  |  |  | C<Class::C3::uninitialize()> at the appropriate times
386 |  |  |  |  | as documented in the L<Class::C3> docs. These three functions
387 |  |  |  |  | are always provided by L<MRO::Compat>, either via L<Class::C3>
388 |  |  |  |  | itself on older Perls, or directly as no-ops on 5.9.5+.
389 |  |  |  |  |
390 |  |  |  |  | =head1 SEE ALSO
391 |  |  |  |  |
392 |  |  |  |  | L<Class::C3>
393 |  |  |  |  |
394 |  |  |  |  | L<mro>
395 |  |  |  |  |
396 |  |  |  |  | =head1 AUTHOR
397 |  |  |  |  |
398 |  |  |  |  | Brandon L. Black, E<lt>blblack@gmail.comE<gt>
399 |  |  |  |  |
400 |  |  |  |  | =head1 COPYRIGHT AND LICENSE
401 |  |  |  |  |
402 |  |  |  |  | Copyright 2007-2008 Brandon L. Black E<lt>blblack@gmail.comE<gt>
403 |  |  |  |  |
404 |  |  |  |  | This library is free software; you can redistribute it and/or modify
405 |  |  |  |  | it under the same terms as Perl itself.
406 |  |  |  |  |
407 |  |  |  |  | =cut
408 |  |  |  |  |
409 | 1 | 3µs |  |  | 1;