2 package # hide from PAUSE
11 our $VERSION = '0.01';
13 use base 'Class::MOP::Class';
15 my $_find_method_in_superclass = sub {
16 my ($class, $method) = @_;
17 foreach my $super ($class->class_precedence_list) {
18 return $super->meta->get_method($method)
19 if $super->meta->has_method($method);
25 my $meta = $class->SUPER::initialize(@_);
26 $meta->add_method('AUTOLOAD' => sub {
27 my $meta = $_[0]->meta;
31 my $label = ${$meta->name . '::AUTOLOAD'};
32 $method_name = (split /\:\:/ => $label)[-1];
34 my $method = $_find_method_in_superclass->($meta, $method_name);
35 (defined $method) || confess "Method ($method_name) not found";
38 $meta->add_method('can' => sub {
39 $_find_method_in_superclass->($_[0]->meta, $_[1]);
49 @{$self->name . '::SUPERS'} = @supers;
51 @{$self->name . '::SUPERS'};
54 sub class_precedence_list {
58 } Algorithm::C3::merge($self, sub {
60 map { $_->meta } $class->superclasses;
72 C3MethodDispatchOrder - An example attribute metaclass for changing to C3 method dispatch order
76 # a classic diamond inheritence graph
85 use metaclass 'C3MethodDispatchOrder';
87 sub hello { return "Hello from A" }
90 use metaclass 'C3MethodDispatchOrder';
91 B->meta->superclasses('A');
94 use metaclass 'C3MethodDispatchOrder';
95 C->meta->superclasses('A');
97 sub hello { return "Hello from C" }
100 use metaclass 'C3MethodDispatchOrder';
101 D->meta->superclasses('B', 'C');
103 print join ", " => D->meta->class_precedence_list; # prints C3 order D, B, C, A
105 # later in other code ...
107 print D->hello; # print 'Hello from C' instead of the normal 'Hello from A'
113 Stevan Little E<lt>stevan@iinteractive.comE<gt>
115 =head1 COPYRIGHT AND LICENSE
117 Copyright 2006 by Infinity Interactive, Inc.
119 L<http://www.iinteractive.com>
121 This library is free software; you can redistribute it and/or modify
122 it under the same terms as Perl itself.