Mooseでデザパタ - Chain Of Responsibilityパターン

#!/usr/bin/env perl
{

    package Trouble;
    use Moose;
    has number => ( is => 'rw', isa => 'Int', required => 1 );

}

{

    package Support;
    use Moose::Role;
    use Perl6::Say;
    has name => ( is => 'rw', isa => 'Str', required => 1 );
    has next => ( is => 'rw' );
    requires 'resolve';

    sub support {
        my ( $self, $trouble ) = @_;
        if ( $self->resolve($trouble) ) {
            $self->done($trouble);
        }
        elsif ( $self->next ) {
            $self->next->support($trouble);
        }
        else {
            $self->fail($trouble);
        }
    }

    sub done {
        my ( $self, $trouble ) = @_;
        say "[Trouble "
            . $trouble->number . "]"
            . " is resolved by " . "["
            . $self->name . "].";
    }

    sub fail {
        my ( $self, $trouble ) = @_;
        say "[Trouble " . $trouble->number . "]" . " cannot be resolved.";
    }
}

{

    package NoSupport;
    use Moose;
    with 'Support';

    sub resolve {
        my ( $self, $trouble ) = @_;
        return 0;
    }
}

{

    package LimitSupport;
    use Moose;
    with 'Support';
    has limit => ( is => 'rw', isa=>'Int', required => 1 );

    sub resolve {
        my ( $self, $trouble ) = @_;
        if ( $trouble->number < $self->limit ) {
            return 1;
        }
        else {
            return 0;
        }
    }
}

{

    package OddSupport;
    use Moose;
    with &#39;Support&#39;;

    sub resolve {
        my ( $self, $trouble ) = @_;
        if ( $trouble->number % 2 == 1 ) {
            return 1;
        }
        else {
            return 0;
        }
    }
}

{

    package SpecialSupport;
    use Moose;
    with &#39;Support&#39;;
    has number => ( is => &#39;rw&#39;, isa => &#39;Int&#39;, required => 1 );

    sub resolve {
        my ( $self, $trouble ) = @_;
        if ( $trouble->number == $self->number ) {
            return 1;
        }
        else {
            return 0;
        }
    }
}

sub main {
    my $alice = NoSupport->new( name => "Alice" );
    my $bob = LimitSupport->new( name => "Bob", limit => 100 );
    my $charlie = SpecialSupport->new( name => "Charlie", number => 429 );
    my $diana = LimitSupport->new( name => "Diana", limit => 200 );
    my $elmo = OddSupport->new( name => "Elmo" );
    my $fred = LimitSupport->new( name => "Fred", limit => 300 );

    # 連鎖の形成
    $alice->next($bob);
    $bob->next($charlie);
    $charlie->next($diana);
    $diana->next($elmo);
    $elmo->next($fred);

    # さまざまなトラブル発生
    my $i = 0;
    while ( $i < 500 ) {
        $alice->support( Trouble->new( number => $i ) );
        $i += 33;
    }
}

main();

Moose的なポイントとしては、Roleを抽象クラスとして使っているというところでしょうか。

See also:
http://www.ceres.dti.ne.jp/~kaga/chain.txt