use strict;
use warnings;
-our $VERSION = '0.01';
-
use Scalar::Util 'blessed';
+our $VERSION = '0.02';
+
+# this is our global stash of both
+# MRO's and method dispatch tables
+# the structure basically looks like
+# this:
+#
+# $MRO{$class} = {
+# MRO => [ <class precendence list> ],
+# methods => {
+# orig => <original location of method>,
+# code => \&<ref to original method>
+# }
+# }
+#
my %MRO;
+# use this for debugging ...
+sub _dump_MRO_table { %MRO }
+
+our $TURN_OFF_C3 = 0;
+
sub import {
my $class = caller();
+ # skip if the caller is main::
+ # since that is clearly not relevant
return if $class eq 'main';
+ return if $TURN_OFF_C3;
+ # make a note to calculate $class
+ # during INIT phase
$MRO{$class} = undef;
}
-INIT {
- no strict 'refs';
+## initializers
+
+# NOTE:
+# this will not run under the following
+# conditions:
+# - mod_perl
+# - require Class::C3;
+# - eval "use Class::C3"
+# in all those cases, you need to call
+# the initialize() function manually
+INIT { initialize() }
+
+sub initialize {
+ # why bother if we don't have anything ...
+ return unless keys %MRO;
+ _calculate_method_dispatch_tables();
+ _apply_method_dispatch_tables();
+}
+
+## functions for applying C3 to classes
+
+sub _calculate_method_dispatch_tables {
foreach my $class (keys %MRO) {
- my @MRO = calculateMRO($class);
- $MRO{$class} = { MRO => \@MRO };
- my %methods;
- foreach my $local (@MRO[1 .. $#MRO]) {
- foreach my $method (grep { defined &{"${local}::$_"} } keys %{"${local}::"}) {
- next unless !defined *{"${class}::$method"}{CODE};
- if (!exists $methods{$method}) {
- $methods{$method} = {
- orig => "${local}::$method",
- code => \&{"${local}::$method"}
- };
- }
- }
- }
- $MRO{$class}->{methods} = \%methods;
+ _calculate_method_dispatch_table($class);
}
- #use Data::Dumper; warn Dumper \%MRO;
- foreach my $class (keys %MRO) {
- #warn "installing methods (" . (join ", " => keys %{$MRO{$class}->{methods}}) . ") for $class";
- foreach my $method (keys %{$MRO{$class}->{methods}}) {
- #warn "Installing ${class}::$method using " . $MRO{$class}->{methods}->{$method}->{orig};
- *{"${class}::$method"} = $MRO{$class}->{methods}->{$method}->{code};
+}
+
+sub _calculate_method_dispatch_table {
+ my $class = shift;
+ no strict 'refs';
+ my @MRO = calculateMRO($class);
+ $MRO{$class} = { MRO => \@MRO };
+ my %methods;
+ # NOTE:
+ # we do @MRO[1 .. $#MRO] here because it
+ # makes no sense to interogate the class
+ # which you are calculating for.
+ foreach my $local (@MRO[1 .. $#MRO]) {
+ foreach my $method (grep { defined &{"${local}::$_"} } keys %{"${local}::"}) {
+ # skip if already overriden in local class
+ next unless !defined *{"${class}::$method"}{CODE};
+ $methods{$method} = {
+ orig => "${local}::$method",
+ code => \&{"${local}::$method"}
+ } unless exists $methods{$method};
}
- }
+ }
+ # now stash them in our %MRO table
+ $MRO{$class}->{methods} = \%methods;
+}
+
+sub _apply_method_dispatch_tables {
+ foreach my $class (keys %MRO) {
+ _apply_method_dispatch_table($class);
+ }
}
+sub _apply_method_dispatch_table {
+ my $class = shift;
+ no strict 'refs';
+ foreach my $method (keys %{$MRO{$class}->{methods}}) {
+ *{"${class}::$method"} = $MRO{$class}->{methods}->{$method}->{code};
+ }
+}
+
+## functions for calculating C3 MRO
+
+# this function is a perl-port of the
+# python code on this page:
+# http://www.python.org/2.3/mro.html
sub _merge {
my (@seqs) = @_;
my @res;
use Class::C3;
# Classic Diamond MI pattern
- # [ A ]
- # / \
- # [ B ] [ C ]
- # \ /
- # [ D ]
+ # <A>
+ # / \
+ # <B> <C>
+ # \ /
+ # <D>
package main;
C3 works by always preserving local precendence ordering. This essentially means that no class will
appear before any of it's subclasses. Take the classic diamond inheritence pattern for instance:
- [ A ]
- / \
- [ B ] [ C ]
- \ /
- [ D ]
+ <A>
+ / \
+ <B> <C>
+ \ /
+ <D>
The standard Perl 5 MRO would be (D, B, A, C). The result being that B<A> appears before B<C>, even
though B<C> is the subclass of B<A>. The C3 MRO algorithm however, produces the following MRO
do well if you start changing your C<@ISA> or messing with class symbol tables, so you should consider
your classes to be effectively closed. See the L<CAVEATS> section for more details.
+=head1 OPTIONAL LOWERCASE PRAGMA
+
+This release also includes an optional module B<c3> in the F<opt/> folder. I did not include this in
+the regular install since lowercase module names are considered I<"bad"> by some people. However I
+think that code looks much nicer like this:
+
+ package MyClass;
+ use c3;
+
+The the more clunky:
+
+ package MyClass;
+ use Class::C3;
+
+But hey, it's your choice, thats why it is optional.
+
=head1 FUNCTIONS
=over 4
Given a C<$class> this will return an array of class names in the proper C3 method resolution order.
+=item B<initialize>
+
+This can be used to initalize the C3 method dispatch tables. You need to call this if you are running
+under mod_perl, or in any other environment which does not run the INIT phase of the perl compiler.
+
+NOTE:
+This can B<not> be used to re-load the dispatch tables for all classes. This is because it does not first
+return the classes to their virginal state, which would need to happen in order for the dispatch tables
+to be properly reloaded.
+
=back
=head1 CAVEATS
tables of said classes. So any symbol table manipulation which takes place after our INIT phase is run will
not be reflected in the calculated MRO.
-=item Not for use with mod_perl
-
-Since this module utilizes the INIT phase, it cannot be easily used with mod_perl. If this module works out
-and proves useful in the I<real world>, I will most likely be supporting mod_perl in some way.
-
=back
=head1 TODO
=head1 AUTHOR
-stevan little, E<lt>stevan@iinteractive.comE<gt>
+Stevan Little, E<lt>stevan@iinteractive.comE<gt>
=head1 COPYRIGHT AND LICENSE
projects / gitmo/Class-C3.git / blobdiff