Mouseをわかりやすくするラッパーかいたよー

http://d.hatena.ne.jp/gfx/20111119/1321681656
「MouseはいいけどDSLはちょっと」というbonnuさんやxaicronさんのためのラッパーかいたよ〜。

package MouseX::Simple;
use strict;
use warnings;
use utf8;
use 5.15.1;
use Mouse ();

sub new {
    my $class = shift;
    my %args = @_==1 ? %{$_[0]} : @_;
    return bless {%args}, $class;
}

sub mk_accessors {
    my $class = shift;
    my $meta = Mouse->init_meta(for_class => $class);
    for my $name (@_) {
        $meta->add_attribute($name, +{is => 'rw'});
    }
}

sub mk_wo_accessors {
    my $class = shift;
    my $meta = Mouse->init_meta(for_class => $class);
    for my $name (@_) {
        $meta->add_attribute($name, +{is => 'wo'});
    }
}

sub mk_ro_accessors {
    my $class = shift;
    my $meta = Mouse->init_meta(for_class => $class);
    for my $name (@_) {
        $meta->add_attribute($name, +{is => 'ro'});
    }
}

1;
__END__

=head1 SYNOPSIS

    package MyApp;
    use parent qw(MouseX::Simple);
    __PACKAGE__->mk_accessors(qw(foo bar));

#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use 5.016000;
use lib 'lib';
use Test::More;

package MyObject {
    use parent qw(MouseX::Simple);
    __PACKAGE__->mk_accessors(qw(x y));
};

my $o = MyObject->new(x => 1, y => 53);
is($o->x, 1);
$o->x(4);
is($o->x, 4);
is($o->y, 53);

done_testing;

Published: 2011-11-19(Sat) 06:26