Hatena::Groupdann

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

Fork me on GitHub

2008-05-31

MooseでList::RubyLike

MooseでList::RubyLike - dann's blog を含むブックマーク はてなブックマーク - MooseでList::RubyLike - dann's blog MooseでList::RubyLike - dann's blog のブックマークコメント

List::RubyLikeをMoose::Autobox用に移植してみました。

まだ足りないメソッドはありますが、おいおい追加していきます。

コード

package Moose::Autobox::Array::RubyLike;
use Moose::Role;
use Moose::Autobox;
use List::Util;
use Carp qw/croak/;

our $VERSION = '0.01';

sub find {
    my ( $array, $cond ) = @_;
    my $code
        = ( ref $cond and ref $cond eq 'CODE' )
        ? $cond
        : sub { $_ eq $cond };

    for (@$array) { &$code and return $_ }
    return;
}

sub delete_at {
    my ( $array, $pos ) = @_;
    my $last_index = $array->_last_index;
    return if $pos > $last_index;
    my $result;
    $_ == $pos
        ? $result
        = $array->shift
        : $array->push( $array->shift )
        for 0 .. $last_index;
    return $result;
}

sub delete_if {
    my ( $array, $code ) = @_;
    croak "Argument must be a code" unless ref $code eq 'CODE';
    my $last_index = $array->_last_index;
    for ( 0 .. $last_index ) {
        my $item = $array->shift;
        local $_ = $item;
        $array->push($item) if $code->($_);
    }
    return $array;
}

sub _last_index {
    my $array = CORE::shift;
    $array->length ? $array->length - 1 : 0;
}

sub each {
    my ( $array, $code ) = @_;
    croak "Argument must be a code" unless ref $code eq 'CODE';
    my @copied = @{$array};
    $code->($_) for @copied;
    $array;
}

sub compact {
    my $array = shift;
    $array->grep( sub {defined} );
}

sub is_empty {
    !$_[0]->length;
}

sub sum {
    List::Util::sum @{ $_[0] };
}

*collect = \↦

1;

__END__

テスト

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

use Test::More tests => 15;

BEGIN {
    use_ok('Moose::Autobox');
}

use Moose::Autobox;
Moose::Autobox->mixin_additional_role( 'ARRAY',
    'Moose::Autobox::Array::RubyLike' );

#find
my $list = [ 1 .. 3 ];
is $list->find( sub { $_ == 1 } ), 1, 'contain 1';
is $list->find( sub { $_ == 2 } ), 2, 'contain 2';
is $list->find( sub { $_ == 3 } ), 3;
is $list->find( sub { $_ == 4 } ), undef;
is $list->find(1), 1;
is $list->find(2), 2;
is $list->find(3), 3;
is $list->find(4), undef;

# delete_at
$list = [ 1, 2, 3, 4, 5 ];
ok not $list->delete_at(5);
is_deeply( $list->delete_at(2), 3 );
is_deeply( $list->delete_at(0), 1 );

# delete_if
$list = [ 1, 2, 3, 4, 5 ];
is_deeply( $list->delete_if( sub { $_ < 3 ? 1 : 0 } ), [ 1, 2 ] );

# each
$list = [ 'foo', 'bar', 'baz' ];
my @resulsts;
my $ret = $list->each( sub { s!^ba!!; push @resulsts, $_ } );
is_deeply \@resulsts, [ 'foo', 'r',   'z' ];
is_deeply $ret,       [ 'foo', 'bar', 'baz' ];

# 微妙にメソッドが足りないのは後で追加する予定。githubにでもいれとくかなぁ。

# 本当はMoose::Autobox::Listのほうに追加したいんだけど、ちとMoose::Autobox::List, Moose::Autobox::Arrayを結構変更しないといけない。

MooseでDP入門を書いて思った事

MooseでDP入門を書いて思った事 - dann's blog を含むブックマーク はてなブックマーク - MooseでDP入門を書いて思った事 - dann's blog MooseでDP入門を書いて思った事 - dann's blog のブックマークコメント

hyukiさんのDP入門のRuby版コードをそのままPerlにportingしてみて何点か思った事。

Mooseで少し思ったところ

  • コンストラクタで何か処理させたい場合は、BUILD使うってのがFAQに書いてあるんだけど直感的でない
  • hasのdefaultで設定する要素にparameter渡したい場合はどう書くべきかがよくかよくわからない
  • RubyのeachはMoose::Autoboxに追加したい.
    • autoboxみるとforeachとforをまんま使えるようにしてあるなぁ
  • インターフェースをRoleで書くのがいいのかは微妙
    • 名前だけの強制だと引数がわからないから。signatureレベルで強制できるともう少しいいかも。
    • 名前だけでもあったほうがbetterだとは思うけれど、コードが仕様にならないという点で少し微妙。

オリジナルのコードについて

  • porting元のコードがそんなにRubyっぽいわけじゃない(それがそんなに悪いわけじゃないけれど)
  • 一部のインスタンス変数はread onlyでよいっぽいんだけど、元のコードの意図がよくわからないものは全部rwにした
    • まぁ、使う人は適当に.

コードのフォーマット

  • perltidyでまんまやってるのだけけれど、hasとかは1行じゃなくて複数行にしたい
    • 面倒なので、perltidy側でやりたい。どっかの設定でいじれるのかがよくわかってない

パターンについて

  • LLっぽいパターンの例も、別の形で書きたい。
  • DIを使った応用について書きたい
  • concere, subtypeを使った例とかは、結構使う場面も多いし有用だと思うんだけれど、このDP入門では使う場面があんまりなさそう

ということで、参考になるコードあれば、是非色々と教えてもらえると嬉しいです。

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 のブックマークコメント

#!/usr/bin/env perl
use strict;
use warnings;
use Perl6::Say;

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

{

    package Printable;
    use Moose::Role;
    requires 'set_printer_name';
    requires 'get_printer_name';
    requires 'printstr';
}

{

    package Printer;
    use Moose;
    use Perl6::Say;
    with 'Printable';
    has name => ( is => 'rw', isa => 'Str', required => 1 );

    sub BUILD {
        my $self = shift;
        $self->heavy_job(
            "Printerのインスタンス(" . $self->name . ")を生成中" );
    }

    sub printer {
        my $self = shift;
        $self->heavy_job("Printerのインスタンスを生成中");
    }

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

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

    sub printstr {
        my ( $self, $string ) = @_;
        say '=== ' . $self->name . ' ===';
        say $string;
    }

    sub heavy_job {
        my ( $self, $msg ) = @_;
        print $msg;
        for ( 0 .. 5 ) {
            sleep(1);
            print '.';
        }
        say ' ';
        say '完了。';
    }

}

{

    package PrinterProxy;
    use Moose;
    with 'Printable';

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

    sub set_printer_name {
        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 のブックマークコメント

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

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

{

    package AbstractDisplay;    # 抽象クラスAbstractDisplay
    use Moose::Role;
    requires 'open';
    requires 'custom_print';
    requires 'close';

    sub display {
        my $self = shift;
        $self->open;
        for ( 1 .. 5 ) {
            $self->custom_print;
        }
        $self->close;
    }
}

{

    package CharDisplay;
    use Moose;
    use Perl6::Say;
    with 'AbstractDisplay';
    has ch => ( is => 'rw', required => 1 );

    sub open {
        print "<";
    }

    sub custom_print {
        my $self = shift;
        print $self->ch;
    }

    sub close {
        say ">";
    }
}
{

    package StringDisplay;
    use Moose;
    use Perl6::Say;
    use Moose::Autobox;
    with 'AbstractDisplay';
    has stringchr => ( is => 'rw', required => 1 );

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

    sub custom_print {
        my $self = shift;
        say "|" . $self->stringchr . "|";
    }

    sub close {
        my $self = shift;
        $self->print_line;

    }

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

sub main {
    my $d1 = CharDisplay->new( ch => "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