7 our $VERSION = '0.15_01';
9 # Class::C3 defines Class::C3::* in pure perl
10 # if mro, it does nothing else
11 # elsif Class::C3::XS, do nothing else
13 # Class::C3::XS defines the same routines as next.pm,
14 # and also redefines (suppress warning) calculateMRO
15 # (ditto for anything else in Class::C3::* we want to
21 eval "require mro"; # XXX in the future, this should be a version check
23 die $@ if $@ !~ /locate/;
24 eval "require Class::C3::XS";
26 die $@ if $@ !~ /locate/;
27 eval "require Algorithm::C3; require Class::C3::next";
36 # this is our global stash of both
37 # MRO's and method dispatch tables
38 # the structure basically looks like
42 # MRO => [ <class precendence list> ],
44 # orig => <original location of method>,
45 # code => \&<ref to original method>
47 # has_overload_fallback => (1 | 0)
52 # use these for debugging ...
53 sub _dump_MRO_table { %MRO }
56 # state tracking for initialize()/uninitialize()
57 our $_initialized = 0;
61 # skip if the caller is main::
62 # since that is clearly not relevant
63 return if $class eq 'main';
65 return if $TURN_OFF_C3;
66 mro::set_mro($class, 'c3') if $C3_IN_CORE;
68 # make a note to calculate $class
70 $MRO{$class} = undef unless exists $MRO{$class};
76 %next::METHOD_CACHE = ();
77 # why bother if we don't have anything ...
78 return unless keys %MRO;
80 mro::set_mro($_, 'c3') for keys %MRO;
85 $MRO{$_} = undef foreach keys %MRO;
87 _calculate_method_dispatch_tables();
88 _apply_method_dispatch_tables();
94 # why bother if we don't have anything ...
95 %next::METHOD_CACHE = ();
96 return unless keys %MRO;
98 mro::set_mro($_, 'dfs') for keys %MRO;
101 _remove_method_dispatch_tables();
106 sub reinitialize { goto &initialize }
108 ## functions for applying C3 to classes
110 sub _calculate_method_dispatch_tables {
111 return if $C3_IN_CORE;
113 foreach my $class (keys %MRO) {
114 _calculate_method_dispatch_table($class, \%merge_cache);
118 sub _calculate_method_dispatch_table {
119 return if $C3_IN_CORE;
120 my ($class, $merge_cache) = @_;
122 my @MRO = calculateMRO($class, $merge_cache);
123 $MRO{$class} = { MRO => \@MRO };
124 my $has_overload_fallback = 0;
127 # we do @MRO[1 .. $#MRO] here because it
128 # makes no sense to interogate the class
129 # which you are calculating for.
130 foreach my $local (@MRO[1 .. $#MRO]) {
131 # if overload has tagged this module to
132 # have use "fallback", then we want to
134 $has_overload_fallback = ${"${local}::()"}
135 if defined ${"${local}::()"};
136 foreach my $method (grep { defined &{"${local}::$_"} } keys %{"${local}::"}) {
137 # skip if already overriden in local class
138 next unless !defined *{"${class}::$method"}{CODE};
139 $methods{$method} = {
140 orig => "${local}::$method",
141 code => \&{"${local}::$method"}
142 } unless exists $methods{$method};
145 # now stash them in our %MRO table
146 $MRO{$class}->{methods} = \%methods;
147 $MRO{$class}->{has_overload_fallback} = $has_overload_fallback;
150 sub _apply_method_dispatch_tables {
151 return if $C3_IN_CORE;
152 foreach my $class (keys %MRO) {
153 _apply_method_dispatch_table($class);
157 sub _apply_method_dispatch_table {
158 return if $C3_IN_CORE;
161 ${"${class}::()"} = $MRO{$class}->{has_overload_fallback}
162 if $MRO{$class}->{has_overload_fallback};
163 foreach my $method (keys %{$MRO{$class}->{methods}}) {
164 *{"${class}::$method"} = $MRO{$class}->{methods}->{$method}->{code};
168 sub _remove_method_dispatch_tables {
169 return if $C3_IN_CORE;
170 foreach my $class (keys %MRO) {
171 _remove_method_dispatch_table($class);
175 sub _remove_method_dispatch_table {
176 return if $C3_IN_CORE;
179 delete ${"${class}::"}{"()"} if $MRO{$class}->{has_overload_fallback};
180 foreach my $method (keys %{$MRO{$class}->{methods}}) {
181 delete ${"${class}::"}{$method}
182 if defined *{"${class}::${method}"}{CODE} &&
183 (*{"${class}::${method}"}{CODE} eq $MRO{$class}->{methods}->{$method}->{code});
188 my ($class, $merge_cache) = @_;
190 return @{mro::get_linear_isa($class)} if $C3_IN_CORE;
192 return Algorithm::C3::merge($class, sub {
206 Class::C3 - A pragma to use the C3 method resolution order algortihm
212 sub hello { 'A::hello' }
222 sub hello { 'C::hello' }
228 # Classic Diamond MI pattern
237 # initializez the C3 module
238 # (formerly called in INIT)
239 Class::C3::initialize();
241 print join ', ' => Class::C3::calculateMRO('Diamond_D') # prints D, B, C, A
243 print D->hello() # prints 'C::hello' instead of the standard p5 'A::hello'
245 D->can('hello')->(); # can() also works correctly
246 UNIVERSAL::can('D', 'hello'); # as does UNIVERSAL::can()
250 This is pragma to change Perl 5's standard method resolution order from depth-first left-to-right
251 (a.k.a - pre-order) to the more sophisticated C3 method resolution order.
255 C3 is the name of an algorithm which aims to provide a sane method resolution order under multiple
256 inheritence. It was first introduced in the langauge Dylan (see links in the L<SEE ALSO> section),
257 and then later adopted as the prefered MRO (Method Resolution Order) for the new-style classes in
258 Python 2.3. Most recently it has been adopted as the 'canonical' MRO for Perl 6 classes, and the
259 default MRO for Parrot objects as well.
261 =head2 How does C3 work.
263 C3 works by always preserving local precendence ordering. This essentially means that no class will
264 appear before any of it's subclasses. Take the classic diamond inheritence pattern for instance:
272 The standard Perl 5 MRO would be (D, B, A, C). The result being that B<A> appears before B<C>, even
273 though B<C> is the subclass of B<A>. The C3 MRO algorithm however, produces the following MRO
274 (D, B, C, A), which does not have this same issue.
276 This example is fairly trival, for more complex examples and a deeper explaination, see the links in
277 the L<SEE ALSO> section.
279 =head2 How does this module work?
281 This module uses a technique similar to Perl 5's method caching. When C<Class::C3::initialize> is
282 called, this module calculates the MRO of all the classes which called C<use Class::C3>. It then
283 gathers information from the symbol tables of each of those classes, and builds a set of method
284 aliases for the correct dispatch ordering. Once all these C3-based method tables are created, it
285 then adds the method aliases into the local classes symbol table.
287 The end result is actually classes with pre-cached method dispatch. However, this caching does not
288 do well if you start changing your C<@ISA> or messing with class symbol tables, so you should consider
289 your classes to be effectively closed. See the L<CAVEATS> section for more details.
291 =head1 OPTIONAL LOWERCASE PRAGMA
293 This release also includes an optional module B<c3> in the F<opt/> folder. I did not include this in
294 the regular install since lowercase module names are considered I<"bad"> by some people. However I
295 think that code looks much nicer like this:
305 But hey, it's your choice, thats why it is optional.
311 =item B<calculateMRO ($class)>
313 Given a C<$class> this will return an array of class names in the proper C3 method resolution order.
317 This B<must be called> to initalize the C3 method dispatch tables, this module B<will not work> if
318 you do not do this. It is advised to do this as soon as possible B<after> loading any classes which
319 use C3. Here is a quick code example:
323 # ... Foo methods here
328 # ... Bar methods here
332 Class::C3::initialize(); # now it is safe to use Foo and Bar
334 This function used to be called automatically for you in the INIT phase of the perl compiler, but
335 that lead to warnings if this module was required at runtime. After discussion with my user base
336 (the L<DBIx::Class> folks), we decided that calling this in INIT was more of an annoyance than a
337 convience. I apologize to anyone this causes problems for (although i would very suprised if I had
338 any other users other than the L<DBIx::Class> folks). The simplest solution of course is to define
339 your own INIT method which calls this function.
343 If C<initialize> detects that C<initialize> has already been executed, it will L</uninitialize> and
344 clear the MRO cache first.
346 =item B<uninitialize>
348 Calling this function results in the removal of all cached methods, and the restoration of the old Perl 5
349 style dispatch order (depth-first, left-to-right).
351 =item B<reinitialize>
353 This is an alias for L</initialize> above.
357 =head1 METHOD REDISPATCHING
359 It is always useful to be able to re-dispatch your method call to the "next most applicable method". This
360 module provides a pseudo package along the lines of C<SUPER::> or C<NEXT::> which will re-dispatch the
361 method along the C3 linearization. This is best show with an examples.
363 # a classic diamond MI pattern ...
377 sub foo { 'B::foo => ' . (shift)->next::method() }
382 sub foo { 'C::foo => ' . (shift)->next::method() }
387 sub foo { 'D::foo => ' . (shift)->next::method() }
389 print D->foo; # prints out "D::foo => B::foo => C::foo => A::foo"
391 A few things to note. First, we do not require you to add on the method name to the C<next::method>
392 call (this is unlike C<NEXT::> and C<SUPER::> which do require that). This helps to enforce the rule
393 that you cannot dispatch to a method of a different name (this is how C<NEXT::> behaves as well).
395 The next thing to keep in mind is that you will need to pass all arguments to C<next::method> it can
396 not automatically use the current C<@_>.
398 If C<next::method> cannot find a next method to re-dispatch the call to, it will throw an exception.
399 You can use C<next::can> to see if C<next::method> will succeed before you call it like so:
401 $self->next::method(@_) if $self->next::can;
403 Additionally, you can use C<maybe::next::method> as a shortcut to only call the next method if it exists.
404 The previous example could be simply written as:
406 $self->maybe::next::method(@_);
408 There are some caveats about using C<next::method>, see below for those.
412 This module used to be labeled as I<experimental>, however it has now been pretty heavily tested by
413 the good folks over at L<DBIx::Class> and I am confident this module is perfectly usable for
414 whatever your needs might be.
416 But there are still caveats, so here goes ...
420 =item Use of C<SUPER::>.
422 The idea of C<SUPER::> under multiple inheritence is ambigious, and generally not recomended anyway.
423 However, it's use in conjuntion with this module is very much not recommended, and in fact very
424 discouraged. The recommended approach is to instead use the supplied C<next::method> feature, see
425 more details on it's usage above.
427 =item Changing C<@ISA>.
429 It is the author's opinion that changing C<@ISA> at runtime is pure insanity anyway. However, people
430 do it, so I must caveat. Any changes to the C<@ISA> will not be reflected in the MRO calculated by this
431 module, and therefor probably won't even show up. If you do this, you will need to call C<reinitialize>
432 in order to recalulate B<all> method dispatch tables. See the C<reinitialize> documentation and an example
433 in F<t/20_reinitialize.t> for more information.
435 =item Adding/deleting methods from class symbol tables.
437 This module calculates the MRO for each requested class by interogatting the symbol tables of said classes.
438 So any symbol table manipulation which takes place after our INIT phase is run will not be reflected in
439 the calculated MRO. Just as with changing the C<@ISA>, you will need to call C<reinitialize> for any
440 changes you make to take effect.
442 =item Calling C<next::method> from methods defined outside the class
444 There is an edge case when using C<next::method> from within a subroutine which was created in a different
445 module than the one it is called from. It sounds complicated, but it really isn't. Here is an example which
446 will not work correctly:
448 *Foo::foo = sub { (shift)->next::method(@_) };
450 The problem exists because the anonymous subroutine being assigned to the glob C<*Foo::foo> will show up
451 in the call stack as being called C<__ANON__> and not C<foo> as you might expect. Since C<next::method>
452 uses C<caller> to find the name of the method it was called in, it will fail in this case.
454 But fear not, there is a simple solution. The module C<Sub::Name> will reach into the perl internals and
455 assign a name to an anonymous subroutine for you. Simply do this:
457 use Sub::Name 'subname';
458 *Foo::foo = subname 'Foo::foo' => sub { (shift)->next::method(@_) };
460 and things will Just Work. Of course this is not always possible to do, but to be honest, I just can't
461 manage to find a workaround for it, so until someone gives me a working patch this will be a known
462 limitation of this module.
468 I use B<Devel::Cover> to test the code coverage of my tests, below is the B<Devel::Cover> report on this
471 ---------------------------- ------ ------ ------ ------ ------ ------ ------
472 File stmt bran cond sub pod time total
473 ---------------------------- ------ ------ ------ ------ ------ ------ ------
474 Class/C3.pm 98.3 84.4 80.0 96.2 100.0 98.4 94.4
475 ---------------------------- ------ ------ ------ ------ ------ ------ ------
476 Total 98.3 84.4 80.0 96.2 100.0 98.4 94.4
477 ---------------------------- ------ ------ ------ ------ ------ ------ ------
481 =head2 The original Dylan paper
485 =item L<http://www.webcom.com/haahr/dylan/linearization-oopsla96.html>
489 =head2 The prototype Perl 6 Object Model uses C3
493 =item L<http://svn.openfoundry.org/pugs/perl5/Perl6-MetaModel/>
497 =head2 Parrot now uses C3
501 =item L<http://aspn.activestate.com/ASPN/Mail/Message/perl6-internals/2746631>
503 =item L<http://use.perl.org/~autrijus/journal/25768>
507 =head2 Python 2.3 MRO related links
511 =item L<http://www.python.org/2.3/mro.html>
513 =item L<http://www.python.org/2.2.2/descrintro.html#mro>
517 =head2 C3 for TinyCLOS
521 =item L<http://www.call-with-current-continuation.org/eggs/c3.html>
525 =head1 ACKNOWLEGEMENTS
529 =item Thanks to Matt S. Trout for using this module in his module L<DBIx::Class>
530 and finding many bugs and providing fixes.
532 =item Thanks to Justin Guenther for making C<next::method> more robust by handling
533 calls inside C<eval> and anon-subs.
535 =item Thanks to Robert Norris for adding support for C<next::can> and
536 C<maybe::next::method>.
542 Stevan Little, E<lt>stevan@iinteractive.comE<gt>
544 Brandon L. Black, E<lt>blblack@gmail.comE<gt>
546 =head1 COPYRIGHT AND LICENSE
548 Copyright 2005, 2006 by Infinity Interactive, Inc.
550 L<http://www.iinteractive.com>
552 This library is free software; you can redistribute it and/or modify
553 it under the same terms as Perl itself.