transfixed but not dead!

So instead of using roles wouldn’t it be nice if we could just do the following to an instantiated object:

$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

If you feel that the “classic” Moose code in my last post seems a bit chunky when compared to the Ruby example then have a look at MooseX::Declare

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

gist: 126839

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 }
}

gist: 126849

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/