moose_delegate_to_method.pl

#!/usr/bin/perl

# 犬か猫かランダムに選択してワンとかニャーとか言わせたいときどうするか
# http://twitter.com/bulkneets/status/24724786124

use strict;

package Cat;
sub say { warn "Nya-" }
sub say2 { warn "Mya-" }

package Dog;
sub say { warn "Bow!" }
sub say2 { warn "Wow!" }

{
    # 動かない
    package Animal;
    use Any::Moose;

    has 'random' => (
        is      => 'ro',
        handles => [qw(say say2)],
    );

    sub random {
        my $self = shift;
        (rand() < 0.5) ? "Cat" : "Dog";
    }
}

{
    # 適当なattrに毎回結果セットして呼び出す
    # 動く
    package Animal2;
    use Any::Moose;

    has 'result_random' => (
        is      => "rw",
        lazy_build => 1,
        builder => "random",
        init_arg => undef,
        handles => [qw(say say2)],
    );
    for (qw(say say2)) { after $_ => sub { $_[0]->clear_result_random } }

    sub random {
        my $self = shift;
        (rand() < 0.5) ? "Cat" : "Dog";
    }
}

{
    package Animal3;
    use Moose;
    # beforeでセットして呼び出す
    # Mouseで動かない、delegate前にbefore処理してないっぽい => fixed Mouse 0.70!
    
    has '__random' => (
        is      => 'ro',
        reader  => "random",
        handles => [qw(say say2)],
    );

    before "random" => sub {
        my $self = shift;
        warn "before";
        $self->{__random} = (rand() < 0.5) ? "Cat" : "Dog";
    };
}

{
	package Animal4;
	use Moose;
	# coderefにself束縛しといて呼び出す
	# use Mouse; 動かない: Could not load class (Mouse::Meta::Attribute::Custom::Trait::Code) => MouseX::NativeTraits 必要

	has '__hoge' => (
	    traits  => ['Code'],
	    is      => 'ro',
	    isa     => 'CodeRef',
	    default => sub {
	        my $self = shift;
	        sub {
	            my $method = shift;
	            $self->random->$method(@_);
	        }
	    },
	    handles => { map { $_ => ['execute' => $_] } qw(say say2), },
	);
	}

	sub random {
	    my $self = shift;
	    ( rand() < 0.5 ) ? "Cat" : "Dog";
	}
}

{
    # 結局こうした
    package Animal5;
    use Any::Moose;

    {
        for my $method (qw(say say2)) {
            __PACKAGE__->meta->add_method($method => sub {
                my $self = shift;
                $self->random->$method(@_)
            });
        }
    }

    sub random {
        my $self = shift;
        ( rand() < 0.5 ) ? "Cat" : "Dog";
    }
}


package main;

my $test = Animal->new;
$test->say;
$test->say;
$test->say;
$test->say;

$test = Animal3->new;
$test->say;
$test->say;
$test->say;
$test->say;