I personally would describe that metaprogramming provides the ability to:

transform programs with programs

and leave it at that!

The article that stirred the metaprogramming pot was Metaprogramming: Ruby vs. Javascript. This actually is a good post and it helped fill in a few holes in my “fragile” Javascript knowledge.

Luckily I believe my Perl is a bit less fragile!, so I thought I would convert the metaprogramming examples into Perl & Moose.

So following the blogs examples, below defines the Ninja class in Moose. MooseX::SingletonMethod loads Moose with a bit of singleton method sugar.

use Modern::Perl;

{
    package Ninja;
    use MooseX::SingletonMethod;
    use namespace::clean -except => 'meta';
    
    has name => ( is => 'rw', isa => 'Str' );
}

my $drew = Ninja->new( name => 'Drew' );
my $adam = Ninja->new( name => 'Adam' );

Now we re-open the Ninja class and add battle_cry method like so:

{
    package Ninja;
    
    sub battle_cry {
        my $self = shift;
        say $self->name . ' says zing!!!'; 
    }
}

$drew->battle_cry;   # => Drew says zing!!!
$adam->battle_cry;   # => Adam says zing!!!

Now using MooseX::SingletonMethod we add throw_star singleton method into $drew object:

$drew->add_singleton_method( throw_star => sub {
    say "throwing star";
});

$drew->throw_star;   # => throwing a star

To call method dynamically we do this:

$drew->${ \'battle_cry' };   # => Drew says zing!!!

Create colour method closing over $colour_name (ie. closure):

my $colour_name = 'black';

Ninja->meta->add_method( colour => sub {
    my $self = shift;
    say "${ \$self->name }'s colour is $colour_name";
});

$drew->colour;    # => Drew's colour is black
$adam->colour;    # => Adam's colour is black

Finally… “defining a method dynamically on an instance that closes over local scope and accesses the instance’s state”

my $sword_symbol = '********';

$drew->add_singleton_method( swing => sub {
    my ($self, $sound_effect) = @_;
    say "${ \$self->name }: $sword_symbol $sound_effect";
});

$drew->swing( 'slash!!' );   # => Drew: ********* slash!!

Everything nicely works the same as the Ruby & Javascript blog examples.

To round things off, below is the complete example but with MooseX::Declare sugar stirred into the pot.

use Modern::Perl;
use MooseX::Declare;

class Ninja with MooseX::SingletonMethod::Role is mutable {
    has name => ( is => 'rw', isa => 'Str' );
}

my $drew = Ninja->new( name => 'Drew' );
my $adam = Ninja->new( name => 'Adam' );

###########################################################

class Ninja is mutable {    
    method battle_cry {
        say $self->name . ' says zing!!!'; 
    }
}

$drew->battle_cry;   # => Drew says zing!!!
$adam->battle_cry;   # => Adam says zing!!!

###########################################################

$drew->add_singleton_method( throw_star => sub {
    say "throwing star";
});

$drew->throw_star;   # => throwing a star

###########################################################

$drew->${ \'battle_cry' };   # => Drew says zing!!!

###########################################################

my $colour_name = 'black';

Ninja->meta->add_method( colour => sub {
    my $self = shift;
    say "${ \$self->name }'s colour is $colour_name";
});

$drew->colour;    # => Drew's colour is black
$adam->colour;    # => Adam's colour is black

###########################################################

my $sword_symbol = '********';

$drew->add_singleton_method( swing => sub {
    my ($self, $sound_effect) = @_;
    say "${ \$self->name }: $sword_symbol $sound_effect";
});

$drew->swing( 'slash!!' );   # => Drew: ********* slash!!

/I3az/

PS. If you want Moose in Javascript then have a look at Joose

$baz->add_singleton_method( legs => sub { 2 } );

Well if we define our Animal class like so then we can!

use MooseX::Declare;

class Animal {
    method walk { "unknown" }
    method wild { "wild?... I'm bliming livid!" }
    
    method add_singleton_method( $method_name, $method ) {        
        my $singleton = $self->meta->create_anon_class(
            superclasses => [ $self->meta->name ],
            methods      => { $method_name => $method },
        );
        $singleton->add_method( meta => sub { $singleton } );
        $singleton->rebless_instance( $self );
    }
}

This add_singleton_method does all the dirty work that applying a role to an object did in previous post.

To break this down:

my $singleton = $self->meta->create_anon_class(
    superclasses => [ $self->meta->name ],
    methods      => { $method_name => $method },
);

This creates our anonymous class ($singleton). The “superclasses” part makes it a subclass of Animal and the “methods” part is where we add predefined methods (which we provide as args in add_singleton_methods)

$singleton->add_method( meta => sub { $singleton } );

Above adds the all important meta method. Without this then things can get a bit hairy!

$singleton->rebless_instance( $self );

This now reblesses the instance with this new anonymous class.

Now we can produce that singleton method like so:

my $baz = Animal->new;
$baz->add_singleton_method( legs => sub { 2 } );
say $baz->legs;   # => 2

And it all works in exactly same way as with role examples previously mentioned.

Now we can keep creating further anonymous subclasses by using add_singleton_method or you can just use Moose meta method to add more methods to current anonymous class:

$baz->meta->add_method( walk => sub { "when not drunk!" } );

Now if we tidy up the mechanics of all this into a Moose role with some extra fancy API:

NB. Think I’m safe from the Trade Description Act for my blog title over this role usage!)

package DoesSingletonMethod;
use Moose::Role;

our $singleton = sub {
    my $self    = shift;
    my $methods = shift || {};
    
    my $meta = $self->meta->create_anon_class(
        superclasses => [ $self->meta->name ],
        methods      => $methods,
    );
    
    $meta->add_method( meta => sub { $meta } );
    $meta->rebless_instance( $self );
};

sub become_singleton      { $_[0]->$singleton }

sub add_singleton_method  { $_[0]->$singleton({ $_[1] => $_[2] }) }

sub add_singleton_methods { 
    my $self = shift;
    $self->$singleton({ @_ });
}


no Moose::Role;
1;

This nows means we can do the following:

use MooseX::Declare;

class Animal with DoesSingletonMethod {
    method walk { "unknown" }
    method wild { "wild?... I'm bliming livid!" }
}

# one way to create singleton method....
my $baz = Animal->new;
$baz->become_singleton;                   # make $baz a singleton
$baz->meta->add_method( baz => 'baz!' );  # add method "baz" using meta

# and another.....
my $foo = Animal->new;
$foo->add_singleton_method( foo => sub { 'foo!' } );

# and finally multiple methods....
my $bar = Animal->new;
$bar->add_singleton_methods( 
    bar1 => sub { 'bar1!' }, 
    bar2 => sub { 'bar2!' },
);

Hmmm this is nice. Perhaps I’ll wrap this up as MooseX::SingletonMethod and upload to CPAN

Moritz is absolutely correct so I’ll make immediate amends by reproducing the core of my last post about how Moose Roles implemented singleton methods with some helpful diagrams.

So first here is the initial Animal class code again:

use MooseX::Declare;

class Animal {
    method walk { "unknown" }
    method wild { "wild?... I'm bliming livid!" }
}

my $baz = Animal->new;

Here is a diagram which shows the object ($baz) & each class with its methods:

From this we can see that:

• $baz is the instantiated object of the Animal class.
• The Animal class contains all the methods we defined (along with “new” & “meta”) and its superclass is Moose::Object.

NB. Moose::Object is the ultimate superclass which all Moose classes relate back to. In Moose::Object we can see all the base methods.

Next is the DoesHuman role and it being applied to the $baz object:

role DoesHuman {
    method walk { "when not drunk!" }
    method legs { 2 }
}

DoesHuman->meta->apply( $baz );

And finally this is how the class relationship now looks for $baz object after the above role was applied:

The anonymous class was created when the DoesHuman role was applied to $baz object and it now stands proudly at the front of the inheritance chain for $baz object.

Thus we have added singleton method(s) to an object by using Moose roles.

This is a clear example of a picture being definitely worth a thousand words

So to help explain all this I’ll create a simple (contrived!) example:

use MooseX::Declare;

class Animal {
    method walk { "unknown" }
    method wild { "wild?... I'm bliming livid!" }
}

Now if we introspect this:

my $baz = Animal->new;
say "baz is an Animal and its " . $baz->walk . " if he can walk or not?";
say "baz methods are: ", join " | ", $baz->meta->get_method_list;
say "baz ISA: ", join " | ", $baz->meta->class_precedence_list;

We will see this:

baz is an Animal and its unknown if he can walk or not?
baz methods are: walk | new | wild | meta
baz ISA: Animal | Moose::Object

Using get_method_list returns methods just in this class (running get_all_method_names would return all resolvable methods via inheritance).

And using class_precedence_list returns the class interitance chain starting with its own class Animal. NB. Moose::Object is the base class for all Moose objects.

So no surprises here. So what happens when I sprinkle some fairy dust on $baz by applying a role to this object (and creating a Singleton Method):

role DoesHuman {
    method walk { "when not drunk!" }
    method legs { 2 }
}

DoesHuman->meta->apply( $baz );

say "baz is now Human with " . $baz->legs . " legs and walks " . $baz->walk;
say "baz methods are: ", join " | ", $baz->meta->get_method_list;
say "baz ISA: ", join " | ", $baz->meta->class_precedence_list
say "baz says: ", $baz->wild;

This produces:

baz is now Human with 2 legs and walks when not drunk!
baz methods are: legs | walk | meta
baz ISA: Class::MOP::Class::__ANON__::SERIAL::2 | Animal | Moose::Object
baz says: wild?… I’m bliming livid!

First lets look at the object methods. legs has been added and walk has also nicely been replaced. So this does exactly what I asked it to do.

But hold on… where has wild gone from the method list? And yet when I do $self->wild it works fine??

Well if you followed Dave Thomas video link I gave in first post then this is easily explained (even though he’s talking about Ruby!).

If you look at the class inheritance you can see what happened. Here is my attempt to explain whats going on:

Applying DoesHuman role to $baz object has created new anonymous class called (in this instance) “Class::MOP::Class::__ANON__::SERIAL::2″ and puts the DoesHuman role methods legs and walk into there and then makes this class a child of Animal. $baz is then assigned (blessed) to this new anon class.

Or has Dave Thomas says:

move one to the right and then up one

But that only makes sense if you use same diagrams he had!

All very neat! In a nutshell its created a unique anonymous class with the role methods which $baz uses instead of the Animal class.

And you can keep adding to this anon class chaining:

role DoesMale {
    method sex  { "male" }
    method wild { "nice to meet u!" }
}

DoesMale->meta->apply( $baz );

say "baz is now a " . $baz->sex;
say "baz methods are: ", join " | ", $baz->meta->get_method_list;
say "baz ISA: ", join " | ", $baz->meta->class_precedence_list;
say "baz says: ", $baz->wild;

baz is now a male
baz methods are: sex | wild | meta
baz ISA: Class::MOP::Class::__ANON__::SERIAL::3 | Class::MOP::Class::__ANON__::SERIAL::2 | Animal | Moose::Object
baz says: nice to meet u!

/I3az/

Some references:

1. Roles, Singleton Methods & MooseX::Declare
2. Using Moose Roles to create Singleton Methods
3. Moose::Manual::MOP
4. CLass::MOP::Class or (kobesearch)

MooseX::Declare cuts out the following boilerplate code from my previous Point example:

    {
        package Point;
        use Moose;
        ...
        no Moose;
        __PACKAGE__->meta->make_immutable;
    }

Down to just this:

use MooseX::Declare;
class Point {
    ...
}

Here is the first Point code & usage example using Moosex::Declare:

use MooseX::Declare;
 
class Point {    
    has x => ( isa => 'Int', is => 'rw' );
    has y => ( isa => 'Int', is => 'rw' );
 
    method negated   { $self->new( x => -$self->x, y => -$self->y ) }
 
    method transpose { $self->new( x => $self->y,  y => $self->x  ) }
 
    method inspect   { say $self->x . ' @ ' . $self->y              }
}
 
my $p = Point->new( x => 4, y => 3 );
 
$p->negated->inspect;      # => -4 @ -3
$p->transpose->inspect;    # => 3 @ 4
 
role Negated {
    requires 'transpose';
    method negated { $self->transpose };
}
 
Negated->meta->apply( $p );
$p->negated->inspect;      # => 3 @ 4
$p->transpose->inspect;    # => 3 @ 4

Nice eh! Here is the second example of code transformed by MooseX::Declare:

use MooseX::Declare;

role DoesNegated {
    method negated { $self->new( x => -$self->x, y => -$self->y ) }
}

role DoesTranspose {
    method transpose { $self->new( x => $self->y, y => $self->x ) }
}

class Point with DoesNegated with DoesTranspose {    
    has x => ( isa => 'Int', is => 'rw' );
    has y => ( isa => 'Int', is => 'rw' );

    method inspect { say $self->x . ' @ ' . $self->y }
}

Then like in previous post to apply a role to object is just:

DoesTranspose->meta->apply( $p, alias => { transpose => 'negated' } );

Now if that doesn’t make you dribble then I don’t know what will

/I3az/