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

Still having posted my last little ditty on having role attached to Moose I thought I make some slight amendments to MooseX::SingletonMethod module to pull this slightly annoying thorn from my paw.

Version 0.02 will soon be on CPAN and now works either of these ways:

package Baz;
use MooseX::SingletonMethod;
...
no MooseX::SingletonMethod;
1;

or as a role:

package Baz;
use Moose;
with 'MooseX::SingletonMethod::Role';
...
no Moose;
1;

Hate to change API but MX::SM is only a a few weeks old so I’m hopeful that the hordes of users that use this module will understand

/I3az/

use Moose;
with 'MooseX::SingletonMethod';

But wouldn’t it be even nicer if you could replace the two lines with something like:

use MyMoose;

Well you can by applying the role to the base object (Moose::Object) like so:

package MyMoose;

use Moose ();
use Moose::Exporter;
use Moose::Util::MetaRole;

Moose::Exporter->setup_import_methods( also => 'Moose' );

sub init_meta {
    shift;
    my %options = @_;

    my $meta = Moose->init_meta( %options );

    Moose::Util::MetaRole::apply_base_class_roles(
        for_class => $options{ for_class },
        roles     => [ 'MooseX::SingletonMethod' ],  # <= my roles
    );

    return $meta;
}

1;

And then we can create Moose class and use it like so:

package Baz;
use MyMoose;
has 'name' => ( is => 'rw', isa => 'Str' );


package main;

my $baz = Baz->new( name => 'baz' );

$baz->add_singleton_method( hello => sub { 'hello ' . $_[0]->name } ); 

say $baz->hello;   # => 'hello baz'

Of course you don’t need to stop with just adding MooseX::SingletonMethod role only… add all your favourite roles in there!

For more info see Moose::Cookbook::Extending::Recipe2

/I3az/

Here is the synopsis from the pod:

package Baz;
use Moose;
with 'MooseX::SingletonMethod::Role';
no Moose;

package main;
my $baz = Baz->new;
my $foo = Baz->new;

# add singleton method called "baz" just to $baz and not to Baz class
$baz->add_singleton_method( baz => sub { 'baz!' } ); 

say $baz->baz;   # => 'baz!'
say $foo->baz;   # ERROR: Can't locate object method "baz"....

MooseX is the namespace for adding extensions around Moose. Its the playground of future Moose features where modules get torn, beaten and bruised in a development rite of passage.

It would one day be nice to see MooseX::SingletonMethod features grow up and become part of standard Moose family

MooseX::SingletonMethod can also be found in these exotic areas of the web:

• on GitHub
• on Ohloh
• and on FreshMeat

/I3az/

PS. While sticking my flag into the MooseX::SingletonMethod namespace I noticed the following module by Simon Cozens:

• Class-SingletonMethod

I’m amazed this as passed me by especially has I first came to understand Singleton Methods from Simon’s excellent “Advanced Perl Programming” book. Just shows you how deep and diverse the CPAN universe is!

Update: Code now uses MX::SM::Role

$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/

p := 4 @ 3.
p changeClassTo: (p class copy superclass: p class).
p class methodDictionary at: #negated put: (p class methodDictionary at: #transpose).
p negated


My exposure to Smalltalk is limited to a quick look at Seaside web framework which is a bit like learning Rails instead of starting with Ruby

I can just about grok what this code does. Thankfully Rick DeNatale provided a nice Ruby conversion

Here is Rick’s subset of Smalltalk’s Point which replicates what the first Smalltalk line “p := 4 @ 3.” does:

class Point
  attr_accessor :X, :y    # :X should be lowercase but Wordpress keeps converting it to a smiley!

  def initialize(x, y)
    @x, @y = x, y
  end

  def negated
    self.class.new(-x, -y)
  end

  def transpose
    self.class.new(y, x)
  end

  def inspect
    "#{@x} @ #{@y}"
  end
end


p = Point.new(4,3)

p.negated          # => -4 @ -3
p.transpose        # => 3 @ 4

So negated & transpose methods return new Point objects so all very straightforward so far.

In the Smalltalk code the object negated method gets amended to use the transpose method instead.
You can do this in Ruby by opening up the objects method like so:

def p.negated
  transpose
end

p.negated          # => 3 @ 4
p.transpose        # => 3 @ 4

Nice eh! The Ruby world refer to this has a Singleton Method. These are methods which are defined in the object and not the class.

I highly recommend watching this excellent video talk by Dave Thomas which provides excellent lucidity to how Ruby objects work.

Now how about Perl? I suspect you can use some MOP meta magic to do same but did you know that Moose Roles can be applied directly to objects?

Here’s is the Ruby Point code in Perl using classic Moose.

{
    package Point;
    use Moose;

    has x => ( isa => 'Int', is => 'rw' );
    has y => ( isa => 'Int', is => 'rw' );

    sub negated {
        my $self = shift;
        $self->new( x => -$self->x, y => -$self->y );
    }

    sub transpose {
        my $self = shift;
        $self->new( x => $self->y, y => $self->x );
    }

    sub inspect { say "$_[0]->{x} \@ $_[0]->{y}" }
    
    no Moose;
}


my $p = Point->new( x => 4, y => 3 );

$p->negated->inspect;     # => -4 @ -3
$p->transpose->inspect;   # => 3 @ 4

So all works same as the Ruby example. Now if we create a role like so:

{
    package Negated;
    use Moose::Role;
    
    requires 'transpose';
    
    sub negated { 
        my $self = shift;
        $self->transpose;
    }
    
    no Moose::Role;
}

You can then “apply” it to any object like so:

Negated->meta->apply( $p );
$p->negated->inspect;     # => 3 @ 4
$p->transpose->inspect;   # => 3 @ 4

Lovely jubbly!

And as we’ve gone down this Moose Role route we might as well wrap it all up like this:

{
    package Point;
    use Moose;

    with qw/DoesNegated DoesTranspose/;
    
    has x => ( isa => 'Int', is => 'rw' );
    has y => ( isa => 'Int', is => 'rw' );

    sub inspect { say "$_[0]->{x} \@ $_[0]->{y}" }
    
    no Moose;
}

{
    package DoesNegated;
    use Moose::Role;
        
    sub negated {
        my $self = shift;
        $self->new( x => -$self->x, y => -$self->y );
    }
    
    no Moose::Role;
}

{
    package DoesTranspose;
    use Moose::Role;
        
    sub transpose {
        my $self = shift;
        $self->new( x => $self->y, y => $self->x );
    }
    
    no Moose::Role;
}

my $p = Point->new( x => 4, y => 3 );

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

$p->negated->inspect;     # => 3 @ 4
$p->transpose->inspect;   # => 3 @ 4

This time I used the “alias” option to rename the applied method on the Moose hoof

And u can keep applying roles to objects at your hearts content adding or replacing methods
as many times as u like.

/I3az/

Some references:

• Moose Cookbook Roles Recipe 3
• my Stackoverflow answer about applying roles on objects