Perhaps my keenest frustration with Perl 5 is its lack of a clean metaprogramming facility. Stevan Little’s Class::MOP has filled in much of the gap. Here’s what I learned after playing with it for an afternoon.

Class::MOP Review

While writing and talking about Perl Hacks (also known as the Perlinomicon), several people asked me about which hacks just will not work in Perl 6. My estimate is around half, for various reasons.

For one, Perl 6 will make a lot of these hacks unnecessary. Improving object orientation, making subs and methods different, and adding real signatures cleans up a lot of issues in Perl 5.

For another, a lot of these hacks work with the underlying machinery of perl in too much detail. Perhaps my biggest gripe with Perl 5 is that it’s possible to do clever things too often only by knowing about its internals. There’s really no clean, extensible, coherent, and orthogonal metaprogramming facility. (I realize some people think that clean, coherent, and orthogonal are bizarre words to use when talking about Perl, at least in the positive sense, but there is a relationship between consistency and power and usability which smart language designers can exploit.)

It’s not that hard things are impossible, merely that sometimes their implementations are difficult.

Metaprogramming

Consider, for example, the mechanism of super method dispatch in Perl:

        sub some_method
        {
                my $self   = shift;
                log( 'some_method called' );
                $self->SUPER::some_method( @_ );
        }

The SUPER::some_method() call is relatively ugly, even from an aesthetic perspective. perl has a pretty good idea of what method you called, so it should be able to dispatch to the parent method easily.

There’s a bigger problem though. SUPER::some_method() dispatches based on the compile-time package of the method. That is, whatever package contained the method when Perl compiled the method will be the one that determines where the dispatcher looks next. This absolutely prohibits the use of SUPER::some_method() calls in roles or other forms of object and class composition, as the compile-time package does not matter nearly as much as the run-time object. This seems, to me, to be an accident of the implementation now baked into the untasty and yet not-so-good-for-you pie of backwards compatibility.

Simon Cozens wrote the SUPER module to work around this. I maintain it now. With that module, the code can be:

        sub some_method
        {
                my $self   = shift;
                log( 'some_method called' );
                $self->SUPER( @_ );
        }

… or even:

        sub some_method
        {
                log( 'some_method called' );
                super();
        }

Thus it is possible to rewrite how Perl handles method dispatch. However, the internals of the module may frighten you. They bother me a little bit, not only because they work around a mud pie, but because they’re complex. There’s no easy or clean way from pure Perl to ask meta questions about an object or class, such as “Who are your ancestors?” and “Which ancestor contains this method?” and “What is your method dispatch order?”

A Meta-Object Protocol

Stevan Little’s Class::MOP attempts to rectify this by providing a meta-object protocol for Perl 5. (There’s a formal definition, but think of it as a standard set of semantics for how classes and objects behave hidden behind a defined interface and you know as much as you need to know to start.)

With a capable MOP, you can not only perform all of the necessary class and object operations cleanly (define a class, create an object, add a method, perform reflective queries on classes and objects, set an ancestor, remove a method), but you can override those operations for other uses. If you want or need to make classes behave differently in different circumstances, you can change, for example, the method resolution and dispatch order.

You don’t have to do that often to make such a thing useful — even if you only use the MOP’s reflective capabilities, having a clean interface to do so is nice.

To test Class::MOP, I decided to rewrite a few parts of SUPER to use its reflection, not the reflection that Simon and I have built. (I don’t mean to say that I helped Simon build the first versions of SUPER, merely that I’ve added a couple of features and revised the internals somewhat to do so.)

From One MOP to Another

I skimmed the available documentation (start with Class::MOP, then move to Class::MOP::Class for the technical details). The examples focus on using the MOP to build new classes and objects directly. The docs say nothing about making the MOP available to all Perl classes, regardless of their method of declaration, but I thought they implied that the all-important meta() method would be available.

This method returns the metaclass object for an invocant. This object is the entry point into all of the reflective goodness described in Class::MOP::Class. If I were to use the MOP reflection in SUPER, I would need this to be available on arbitrary, ordinary objects, as I can’t guarantee and don’t want to enforce that people always use Class::MOP to create their objects and classes to use my little module.

I asked Stevan Little about this issue and he quickly responded that creating a new metaclass instance for a given object instance or class required the code:

        my $meta = Class::MOP::Class->initialize( $instance );

Even if $instance is a standard Perl object defined in the classical (that is, non-MOP) way, now $meta works with it. That’s what I wanted.

SUPER works by examining the call stack via caller() to find the name of the invoking method. Then it finds the parents of the current invocant and tries to find the next method to invoke, while walking up the inheritance or method resolution chain in the appropriate invocation order.

Doing that without the MOP requires looking in @ISA for each parent, recursively, or calling a barely-documented __get_parents() hook I had to add recently. Ick.

Doing that with the MOP required a quick rewrite of get_parents() to call class_precedence_list() on the metaclass object, to get a list of the ancestors of the invocant. The function needs a little bit more logic though, as the call to SUPER() can come from anywhere in the precedence chain, and the dispatch needs to go to the next level up from the current level, not the first level above the invocant.

Making that work is a simple partitioning algorithm I already had figured out and working. It took only a few minutes to replace code I disliked (but had debugged heavily) with method calls on the metaclass objects. The result is much cleaner, at least for my code.

All of my tests pass without modification. I have a lot of confidence in Class::MOP.

Conclusion

I didn’t try Class::MOP for defining new classes and creating new objects (it’s awfully verbose, and I don’t have a project where that’s useful at the moment), but I really did want better reflection (at least, behind a sane interface). It provides that.

I’m sure there’s a significant speed hit for using this approach in my code, so I’m not sure if it will survive benchmarking… but it does impress me that reflection in Perl 5 can be so much saner. (Besides, having a nice interface and a good test suite makes it possible to rewrite Class::MOP and even SUPER in XS for a huge speed boost.)

As usual, documentation lags behind the usefulness of this code. I do recommend looking through Class::MOP::Class for a good idea of what the modules can do; if you’ve used reflection productively in another language, you may find this interface much cleaner than the package variable and symbol table mucking that Perl 5 normally provides.

Here’s the patch I used. It’s not substantially shorter, but it is conceptually easier to understand:

--- lib/SUPER.pm~	2006-06-19 15:12:42.000000000 -0700
+++ lib/SUPER.pm	2006-06-19 15:12:25.000000000 -0700
@@ -29,6 +29,8 @@
 
 package SUPER;
 
+use Class::MOP;
+
 use strict;
 use warnings;
 
@@ -41,47 +43,44 @@
 use Carp;
 
 use Scalar::Util 'blessed';
-use Sub::Identify ();
 
 sub find_parent
 {
-	my ($class, $method, $prune, $invocant) = @_;
-	my $blessed                             = blessed( $class );
-	$invocant                             ||= $class;
-	$class                                  = $blessed if $blessed;
-	$prune                                ||= '';
-
-	my @parents = get_all_parents( $invocant, $class );
+	my ($class, $method, $prune) = @_;
+	my $blessed                  = blessed( $class );
+	$class                       = $blessed if $blessed;
+	$prune                     ||= '';
 
-	for my $parent ( @parents )
+	for my $parent ( get_parents( $class, $prune ) )
 	{
-		if ( my $subref = $parent->can($method) )
-		{
-			my $source = Sub::Identify::sub_fullname( $subref );
-			next if $source eq "${prune}::$method";
-			return ( $subref, $parent );
-		}
+		my $parent_meta = Class::MOP::Class->initialize( $parent );
+		next unless $parent_meta->has_method( $method );
+		my $subref      = $parent->can( $method );
+		return ( $subref, $parent );
 	}
 }
 
-sub get_all_parents
+sub get_parents
 {
-	my ($invocant, $class) = @_;
+	my ($invocant, $prune) = @_;
+	my $meta               = Class::MOP::Class->initialize( $invocant );
+	my @parents            = $meta->class_precedence_list();
+
+	# remove the object's class; it's not useful
+	shift  @parents;
+	return @parents unless $prune;
 
-	my @parents;
+	my @previous;
 
-	if ( $invocant->can( '__get_parents' ) )
-	{
-		@parents = $invocant->__get_parents();
-	}
-	else
+	# remove everything above the current level too
+	while ( my $parent = shift @parents )
 	{
-		no strict 'refs';
-		@parents = @{ $class . '::ISA' };
+		push @previous, $parent;
+		last if $parent eq $prune;
 	}
 
-	return 'UNIVERSAL' unless @parents;
-	return @parents, map { get_all_parents( $_, $_ ) } @parents;
+	return @previous unless @parents;
+	return @parents;
 }
 
 sub super()