File Coverage

blib/lib/Class/C3.pm
Criterion Covered Total %
statement 46 120 38.3
branch 10 56 17.8
condition 0 12 0.0
subroutine 15 22 68.1
pod 3 3 100.0
total 74 213 34.7


line stmt bran cond sub pod time code
1             package Class::C3;
2              
3 20     20   287611 use strict;
  20         49  
  20         523  
4 20     20   100 use warnings;
  20         41  
  20         3219  
5              
6             our $VERSION = '0.33';
7              
8             our $C3_IN_CORE;
9             our $C3_XS;
10              
11             BEGIN {
12 20 50 0 20   120 if($] > 5.009_004) {
    0          
13 20         60 $C3_IN_CORE = 1;
14 20         7714 require mro;
15             }
16             elsif($C3_XS or not defined $C3_XS) {
17 0         0 my $error = do {
18 0         0 local $@;
19 0         0 eval { require Class::C3::XS };
  0         0  
20 0         0 $@;
21             };
22              
23 0 0       0 if ($error) {
24 0 0       0 die $error if $error !~ /\blocate\b/;
25              
26 0 0       0 if ($C3_XS) {
27 0         0 require Carp;
28 0         0 Carp::croak( "XS explicitly requested but Class::C3::XS is not available" );
29             }
30              
31 0         0 require Algorithm::C3;
32 0         0 require Class::C3::next;
33             }
34             else {
35 0         0 $C3_XS = 1;
36             }
37             }
38             }
39              
40             # this is our global stash of both
41             # MRO's and method dispatch tables
42             # the structure basically looks like
43             # this:
44             #
45             # $MRO{$class} = {
46             # MRO => [ ],
47             # methods => {
48             # orig => ,
49             # code => \&
50             # },
51             # has_overload_fallback => (1 | 0)
52             # }
53             #
54             our %MRO;
55              
56             # use these for debugging ...
57 0     0   0 sub _dump_MRO_table { %MRO }
58             our $TURN_OFF_C3 = 0;
59              
60             # state tracking for initialize()/uninitialize()
61             our $_initialized = 0;
62              
63             sub import {
64 85     85   9086 my $class = caller();
65             # skip if the caller is main::
66             # since that is clearly not relevant
67 85 100       1574 return if $class eq 'main';
68              
69 83 50       207 return if $TURN_OFF_C3;
70 83 50       400 mro::set_mro($class, 'c3') if $C3_IN_CORE;
71              
72             # make a note to calculate $class
73             # during INIT phase
74 83 50       12358 $MRO{$class} = undef unless exists $MRO{$class};
75             }
76              
77             ## initializers
78              
79             # This prevents silly warnings when Class::C3 is
80             # used explicitly along with MRO::Compat under 5.9.5+
81              
82 20     20   14567 { no warnings 'redefine';
  20         48  
  20         5615  
83              
84             sub initialize {
85 21     21 1 4239 %next::METHOD_CACHE = ();
86             # why bother if we don't have anything ...
87 21 50       104 return unless keys %MRO;
88 21 50       78 if($C3_IN_CORE) {
89 21         360 mro::set_mro($_, 'c3') for keys %MRO;
90             }
91             else {
92 0 0       0 if($_initialized) {
93 0         0 uninitialize();
94 0         0 $MRO{$_} = undef foreach keys %MRO;
95             }
96 0         0 _calculate_method_dispatch_tables();
97 0         0 _apply_method_dispatch_tables();
98 0         0 $_initialized = 1;
99             }
100             }
101              
102             sub uninitialize {
103             # why bother if we don't have anything ...
104 4     4 1 3967 %next::METHOD_CACHE = ();
105 4 50       21 return unless keys %MRO;
106 4 50       24 if($C3_IN_CORE) {
107 4         43 mro::set_mro($_, 'dfs') for keys %MRO;
108             }
109             else {
110 0         0 _remove_method_dispatch_tables();
111 0         0 $_initialized = 0;
112             }
113             }
114              
115 1     1 1 298 sub reinitialize { goto &initialize }
116              
117             } # end of "no warnings 'redefine'"
118              
119             ## functions for applying C3 to classes
120              
121             sub _calculate_method_dispatch_tables {
122 0 0   0   0 return if $C3_IN_CORE;
123 0         0 my %merge_cache;
124 0         0 foreach my $class (keys %MRO) {
125 0         0 _calculate_method_dispatch_table($class, \%merge_cache);
126             }
127             }
128              
129             sub _calculate_method_dispatch_table {
130 0 0   0   0 return if $C3_IN_CORE;
131 0         0 my ($class, $merge_cache) = @_;
132 20     20   137 no strict 'refs';
  20         40  
  20         5523  
133 0         0 my @MRO = calculateMRO($class, $merge_cache);
134 0         0 $MRO{$class} = { MRO => \@MRO };
135 0         0 my $has_overload_fallback;
136             my %methods;
137             # NOTE:
138             # we do @MRO[1 .. $#MRO] here because it
139             # makes no sense to interrogate the class
140             # which you are calculating for.
141 0         0 foreach my $local (@MRO[1 .. $#MRO]) {
142             # if overload has tagged this module to
143             # have use "fallback", then we want to
144             # grab that value
145 0         0 $has_overload_fallback = ${"${local}::()"}
146 0 0 0     0 if !defined $has_overload_fallback && defined ${"${local}::()"};
  0         0  
147 0         0 foreach my $method (grep { defined &{"${local}::$_"} } keys %{"${local}::"}) {
  0         0  
  0         0  
  0         0  
148             # skip if already overridden in local class
149 0 0       0 next unless !defined *{"${class}::$method"}{CODE};
  0         0  
150             $methods{$method} = {
151             orig => "${local}::$method",
152 0         0 code => \&{"${local}::$method"}
153 0 0       0 } unless exists $methods{$method};
154             }
155             }
156             # now stash them in our %MRO table
157 0         0 $MRO{$class}->{methods} = \%methods;
158 0         0 $MRO{$class}->{has_overload_fallback} = $has_overload_fallback;
159             }
160              
161             sub _apply_method_dispatch_tables {
162 0 0   0   0 return if $C3_IN_CORE;
163 0         0 foreach my $class (keys %MRO) {
164 0         0 _apply_method_dispatch_table($class);
165             }
166             }
167              
168             sub _apply_method_dispatch_table {
169 0 0   0   0 return if $C3_IN_CORE;
170 0         0 my $class = shift;
171 20     20   128 no strict 'refs';
  20         50  
  20         4377  
172 0         0 ${"${class}::()"} = $MRO{$class}->{has_overload_fallback}
173 0         0 if !defined &{"${class}::()"}
174 0 0 0     0 && defined $MRO{$class}->{has_overload_fallback};
175 0         0 foreach my $method (keys %{$MRO{$class}->{methods}}) {
  0         0  
176 0 0       0 if ( $method =~ /^\(/ ) {
177 0         0 my $orig = $MRO{$class}->{methods}->{$method}->{orig};
178 0 0       0 ${"${class}::$method"} = $$orig if defined $$orig;
  0         0  
179             }
180 0         0 *{"${class}::$method"} = $MRO{$class}->{methods}->{$method}->{code};
  0         0  
181             }
182             }
183              
184             sub _remove_method_dispatch_tables {
185 0 0   0   0 return if $C3_IN_CORE;
186 0         0 foreach my $class (keys %MRO) {
187 0         0 _remove_method_dispatch_table($class);
188             }
189             }
190              
191             sub _remove_method_dispatch_table {
192 0 0   0   0 return if $C3_IN_CORE;
193 0         0 my $class = shift;
194 20     20   135 no strict 'refs';
  20         47  
  20         2947  
195 0 0       0 delete ${"${class}::"}{"()"} if $MRO{$class}->{has_overload_fallback};
  0         0  
196 0         0 foreach my $method (keys %{$MRO{$class}->{methods}}) {
  0         0  
197 0         0 delete ${"${class}::"}{$method}
198 0         0 if defined *{"${class}::${method}"}{CODE} &&
199 0 0 0     0 (*{"${class}::${method}"}{CODE} eq $MRO{$class}->{methods}->{$method}->{code});
  0         0  
200             }
201             }
202              
203             sub calculateMRO {
204             my ($class, $merge_cache) = @_;
205              
206             return Algorithm::C3::merge($class, sub {
207 20     20   116 no strict 'refs';
  20         39  
  20         1730  
208             @{$_[0] . '::ISA'};
209             }, $merge_cache);
210             }
211              
212             # Method overrides to support 5.9.5+ or Class::C3::XS
213              
214 16     16   72 sub _core_calculateMRO { @{mro::get_linear_isa($_[0], 'c3')} }
  16         296  
215              
216             if($C3_IN_CORE) {
217 20     20   114 no warnings 'redefine';
  20         43  
  20         1038  
218             *Class::C3::calculateMRO = \&_core_calculateMRO;
219             }
220             elsif($C3_XS) {
221 20     20   245 no warnings 'redefine';
  20         57  
  20         1256  
222             *Class::C3::calculateMRO = \&Class::C3::XS::calculateMRO;
223             *Class::C3::_calculate_method_dispatch_table
224             = \&Class::C3::XS::_calculate_method_dispatch_table;
225             }
226              
227             1;
228              
229             __END__