Hatena::Groupdann

dann's blog このページをアンテナに追加 RSSフィード

Fork me on GitHub

2008-05-31

Mooseでデザパタ - Visitorパターン

| Mooseでデザパタ - Visitorパターン - dann's blog を含むブックマーク はてなブックマーク - Mooseでデザパタ - Visitorパターン - dann's blog Mooseでデザパタ - Visitorパターン - dann's blog のブックマークコメント

#!/usr/bin/env perl
use strict;
use warnings;

# Visitor パターン
#
# Fileクラスはシステムで定義してあるのでFile以外のクラス名とすること
#
# 印字内容は検討中
#

{

    package FileNode;
    use Moose;
    use Perl6::Say;

    has name => ( is => 'rw', isa => 'Str', required => 1 );
    has size => ( is => 'rw', required => 1 );

    sub visit {
        my $self = shift;
        say "File : " . $self->name . " size " . $self->size . " byte";
    }
}

{

    package DirectoryNode;
    use Moose;
    use MooseX::ClassAttribute;
    use Moose::Autobox;
    use Perl6::Say;

    class_has 'currentdir' => ( is => 'rw', isa => 'Str', default  => '' );
    has name               => ( is => 'rw', isa => 'Str', required => 1 );
    has list => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );

    sub add {
        my ( $self, $entry ) = @_;
        $self->list->push($entry);
    }

    sub visit {
        my $self = shift;

        say __PACKAGE__->currentdir . "/" . $self->name . " ";
        my $savedir = __PACKAGE__->currentdir;
        __PACKAGE__->currentdir(
            __PACKAGE__->currentdir . "/" . $self->name );
        foreach my $item ( @{ $self->list } ) {
            $item->visit;
        }
        __PACKAGE__->currentdir($savedir);

    }
}

sub main {
    my $f1 = FileNode->new( name => "F1", size => 128 );
    my $d1 = DirectoryNode->new( name => "D1" );
    my $f2 = FileNode->new( name => "F2", size => 256 );
    my $d2 = DirectoryNode->new( name => "D2" );
    my $f3 = FileNode->new( name => "F3", size => 64 );
    my $d3 = DirectoryNode->new( name => 'D3' );
    my $f4 = FileNode->new( name => "F4", size => 1024 );
    my $f5 = FileNode->new( name => "F5", size => 256 );

    $d1->add($f1);
    $d1->add($d2);
    $d1->add($f2);
    $d2->add($f3);
    $d2->add($f4);
    $d2->add($d3);
    $d3->add($f5);

    $d1->visit;
}

main();

See also:

http://www.ceres.dti.ne.jp/~kaga/rubyvisitor.txt

Mooseでデザパタ - Proxyパターン

| Mooseでデザパタ - Proxyパターン - dann's blog を含むブックマーク はてなブックマーク - Mooseでデザパタ - Proxyパターン - dann's blog Mooseでデザパタ - Proxyパターン - dann's blog のブックマークコメント

my ( $self, $name ) = @_;
        if ( $self->real ) {
            $self->real->set_printer_name($name);
        }
        $self->name($name);
    }

    sub get_printer_name {
        my $self = shift;
        $self->name;
    }

    sub printstr {
        my ( $self, $string ) = @_;
        $self->realize;
        $self->real->printstr($string);
    }

    sub realize {
        my $self = shift;
        $self->real( Printer->new( name => $self->name ) ) unless ( $self->real );
    }

}

sub main {
    my $p = PrinterProxy->new( name => "Alice" );
    say "名前は現在" . $p->get_printer_name . "です。";
    $p->set_printer_name("Bob");
    say "名前は現在" . $p->get_printer_name . "です。";
    $p->printstr("Hello, world.");
}

main();

See also:

Mooseでデザパタ - Factory Methodパターン

| Mooseでデザパタ - Factory Methodパターン - dann's blog を含むブックマーク はてなブックマーク - Mooseでデザパタ - Factory Methodパターン - dann's blog Mooseでデザパタ - Factory Methodパターン - dann's blog のブックマークコメント

# Factory Method パターン
#
# Java言語で学ぶデザインパターンと同様の例題をPerl+Mooseで記述した。
#
# coded by Dann
#

{

    package Product;
    use Moose::Role;
    requires 'use';
}

{

    package Factory;
    use Moose::Role;
    requires 'create_product';
    requires 'register_product';

    sub create {
        my ( $self, $owner ) = @_;
        my $p = $self->create_product($owner);
        $self->register_product($p);
        $p;
    }
}

{

    package IDCard;
    use Moose;
    use Perl6::Say;
    with 'Product';
    has owner => ( is => 'rw', required => 1 );

    sub use {
        my $self = shift;
        say $self->owner . "のカードを使います";
    }
}

{

    package IDCardFactory;
    use Moose;
    use Moose::Autobox;
    with 'Factory';
    has owners => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );

    sub create_product {
        my ( $self, $owner ) = @_;
        IDCard->new( owner => $owner );
    }

    sub register_product {
        my ( $self, $product ) = @_;
        $self->owners->push( $product->owner );
    }
}

sub main {
    my $factory = IDCardFactory->new;
    my $card1   = $factory->create("結城浩");
    my $card2   = $factory->create("とむら");
    my $card3   = $factory->create("佐藤花子");
    $card1->use;
    $card2->use;
    $card3->use;
}

main();

Mooseでデザパタ - Bridgeパターン

| Mooseでデザパタ - Bridgeパターン - dann's blog を含むブックマーク はてなブックマーク - Mooseでデザパタ - Bridgeパターン - dann's blog Mooseでデザパタ - Bridgeパターン - dann's blog のブックマークコメント

#!/usr/bin/env perl
use strict;
use warnings;

# Bridge パターン
#
# Java言語で学ぶデザインパターンと同様の例題をPerl+Mooseで記述した。
#
# coded by Dann
#
{

    package Display;
    use Moose;
    has impl => (
        is       => 'rw',
        required => 1,
        handles  => {
            printf => 'raw_print',
            close  => 'raw_close',
            open   => 'raw_open'
        }
    );

    sub display {
        my $self = shift;
        $self->open;
        $self->printf;
        $self->close;
    }
}

{

    package CountDisplay;
    use Moose;
    extends 'Display';

    sub multi_display {
        my ( $self, $times ) = @_;
        $self->open;
        for ( 1 .. $times ) {
            $self->printf;
        }
        $self->close;
    }
}
{

    package DisplayImpl;
    use Moose::Role;
    requires 'raw_open';
    requires 'raw_print';
    requires 'raw_close';
}
{

    package StringDisplayImpl;
    use Moose;
    use Moose::Autobox;
    use Perl6::Say;
    with 'DisplayImpl';
    has string => ( is => 'rw', isa => 'Str', required => 1 );
    has width => (
        is      => 'rw',
        isa     => 'Str',
        lazy    => 1,
        default => sub { shift->string->length },
    );

    sub raw_open {
        my $self = shift;
        $self->print_line;
    }

    sub raw_print {
        my $self = shift;
        say "|" . $self->string . "|";
    }

    sub raw_close {
        my $self = shift;
        $self->print_line;
    }

    sub print_line {
        my $self = shift;
        print "+";
        for ( 1 .. $self->width ) {
            print "-";
        }
        say "+";
    }
}

sub main {
    my $d1 = Display->new(
        impl => StringDisplayImpl->new( string => "Hello, Japan." ) );
    my $d2 = CountDisplay->new(
        impl => StringDisplayImpl->new( string => "Hello, World." ) );
    my $d3 = CountDisplay->new(
        impl => StringDisplayImpl->new( string => "Hello, Universe." ) );
    $d1->display;
    $d2->display;
    $d3->display;
    $d3->multi_display(5);
}

main();

Moose的には

  • interfaceとしてのRole
  • handlesで処理を委譲

がポイントでしょうか

Mooseでデザパタ - Templateパターン

| Mooseでデザパタ - Templateパターン - dann's blog を含むブックマーク はてなブックマーク - Mooseでデザパタ - Templateパターン - dann's blog Mooseでデザパタ - Templateパターン - dann's blog のブックマークコメント

H" );
    my $d2 = StringDisplay->new( stringchr => "Hello, world." );
    my $d3 = StringDisplay->new( stringchr => "こんにちわ。" );
    $d1->display;
    $d2->display;
    $d3->display;
}

main();

Moose的なポイントは

  • 抽象クラスとしてのRole

でしょうか。

Template Methodのように一部が空実装というケースであれば、around modifireを使って実装してもよいでしょう。

See also:

http://www.ceres.dti.ne.jp/~kaga/template.txt

2008-05-30

Mooseでデザパタ - Singletonパターン

| Mooseでデザパタ - Singletonパターン - dann's blog を含むブックマーク はてなブックマーク - Mooseでデザパタ - Singletonパターン - dann's blog Mooseでデザパタ - Singletonパターン - dann's blog のブックマークコメント

#!/usr/bin/env perl
use strict;
use warnings;

use Perl6::Say;
{

    package Single;
    use MooseX::Singleton;
}

sub main {
    my $obj1 = Single->instance;
    my $obj2 = Single->instance;
    
    if ( $obj1 == $obj2 ) { 
        say "obj1とobj2は同じインスタンスです。";
    }   
    else {
        say "obj1とobj2は同じインスタンスではありません。";
    }   
}

main();

MooseX::Singletonを使うのがポイントです

See also:

http://www.ceres.dti.ne.jp/~kaga/singleton.txt

Mooseでデザパタ - Adapterパターン

| Mooseでデザパタ - Adapterパターン - dann's blog を含むブックマーク はてなブックマーク - Mooseでデザパタ - Adapterパターン - dann's blog Mooseでデザパタ - Adapterパターン - dann's blog のブックマークコメント

{

    package Banner;
    use Moose;
    use Perl6::Say;
    has string => ( is => 'rw', isa => 'Str', required => 1 );

    sub show_with_paren {
        my $self = shift;
        say '( ' . $self->string . ' )';
    }

    sub show_with_aster {
        my $self = shift;
        say '* ' . $self->string . ' *';
    }
}

{

    package PrintBanner;
    use Moose;

    has string => ( is => 'rw', isa => 'Str', required => 1 );
    has banner => (
        is      => 'rw',
        default => sub {
            Banner->new( string => (shift)->string );
        },
        handles => {
            print1 => 'show_with_paren',
            print2 => 'show_with_aster'
        },
        lazy => 1,
    );
}

# 委譲を使ったAdapterパターンの実行例
# print1 print2 インターフェイスで既存の
# showWithParen showWithAsterを使用している
my $p = PrintBanner->new( string => "Hello" );
$p->print1;
$p->print2;

Moose的なポイントは、

  • handlesで委譲を実現している点

です

See also:

http://www.ceres.dti.ne.jp/~kaga/adapter2.txt

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

| Mooseでデザパタ - Chain Of Responsibilityパターン - dann's blog を含むブックマーク はてなブックマーク - Mooseでデザパタ - Chain Of Responsibilityパターン - dann's blog Mooseでデザパタ - Chain Of Responsibilityパターン - dann's blog のブックマークコメント

#!/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 'Support';

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

{

    package SpecialSupport;
    use Moose;
    with 'Support';
    has number => ( is => 'rw', isa => 'Int', 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

2008-05-29

Mooseでデザパタ - Compositeパターン

| Mooseでデザパタ - Compositeパターン - dann's blog を含むブックマーク はてなブックマーク - Mooseでデザパタ - Compositeパターン - dann's blog Mooseでデザパタ - Compositeパターン - dann's blog のブックマークコメント

#!/usr/bin/env perl
use strict;
use warnings;

{

    package Entry;
    use Moose::Role 'requires';

    requires 'get_name';
    requires 'get_size';
}

{

    package File;
    use Moose;
    use Perl6::Say;
    with 'Entry';

    has name => ( is => 'rw', isa => 'Str', required => 1 );
    has size => ( is => 'rw', isa => 'Int', required => 1 );

    sub get_name {
        my $self = shift;
        $self->name;
    }

    sub get_size {
        my $self = shift;
        $self->size;
    }

    sub print_list {
        my ( $self, $prefix ) = @_;
        say $prefix . '/' . $self->name . '(' . $self->size . ')';
    }
}

{

    package Directory;
    use Moose;
    use Moose::Autobox;
    use Perl6::Say;
    with 'Entry';

    has name => ( is => 'rw', isa => 'Str', required => 1 );
    has directory => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );

    sub get_name {
        my $self = shift;
        $self->name;
    }

    sub get_size {
        my $self = shift;
        my $size = 0;
        foreach my $entry ( @{ $self->directory } ) {
            $size += $entry->get_size;
        }
        return $size;
    }

    sub add {
        my ( $self, $entry ) = @_;
        $self->directory->push($entry);
    }

    sub print_list {
        my ( $self, $prefix ) = @_;
        say $prefix . '/' . $self->get_name . '(' . $self->get_size . ')';
        foreach my $entry ( @{ $self->directory } ) {
            $entry->print_list( $prefix . "/" . $self->get_name );
        }
    }
}

use Perl6::Say;
say "Making root entries...";
my $root_dir = Directory->new( name => "root" );
my $bin_dir  = Directory->new( name => "bin" );
my $tmp_dir  = Directory->new( name => "tmp" );
my $usr_dir  = Directory->new( name => "usr" );
$root_dir->add($bin_dir);
$root_dir->add($tmp_dir);
$root_dir->add($usr_dir);
$bin_dir->add( File->new( name => "vi",    size => 10000 ) );
$bin_dir->add( File->new( name => "latex", size => 20000 ) );
$root_dir->print_list(" ");

Moose的なポイントは、

でしょうか

See also:

http://www.ceres.dti.ne.jp/~kaga/composite.txt

# Moose::Autoboxを少し拡張すれば、ほとんどRubyのコードと等価なコードにできそうですね

# 暇なときにパッチ作るかなぁ