YAPC::Asia::2008

Hackerthonの成果物、というわけではないのですが、Attribute::Method を Attribute::Util の一部としてリリースしたのでお報せします。

こういうことが出来ます。

package Lazy;
use strict;
use warnings;
use Attribute::Method qw( $val );
sub new : Method {
  bless { @_ }, $self
}
sub set_foo : Method( $val ){
   $self->{foo} = $val;
}
sub get_foo : Method {
   $self->{val};
}
# ...
1;

見ての通り、my $self = shift;は不要です。フォーマルパラメターもサポートしております。

asin:4873113148
PERL HACKS(日本語版)
[英語版]

このトリック、実は PERL HACKS の Hack #47 として紹介されています。が、そこに乗っているコードは少し buggy だったのでちゃんと動くようにしてみました。

package Attribute::Method;

use warnings;
use strict;
use Attribute::Handlers;
use B::Deparse;

our $VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)/g;

my $dp        = B::Deparse->new();
my %sigil2ref = (
    '$' => \undef,
    '@' => [],
    '%' => {},
);

sub import {
    my ( $class, @vars ) = @_;
    my $pkg = caller();
    push @vars, '$self';
    for my $var (@vars) {
        my $sigil = substr( $var, 0, 1, '' );
        no strict 'refs';
        *{ $pkg . '::' . $var } = $sigil2ref{$sigil};
    }
}

sub UNIVERSAL::Method : ATTR(RAWDATA) {
    my ( $pkg, $sym, $ref, undef, $args ) = @_;
    my $src = $dp->coderef2text($ref);
    if ($args) {
        $src =~ s/\{/sub{\nmy \$self = shift; my ($args) = \@_;\n/;
    }
    else {
        $src =~ s/\{/sub{\nmy \$self = shift;\n/;
    }
    no warnings 'redefine';
    *$sym = eval qq{ package $pkg; $src };
}

"Rosebud"; # for MARCEL's sake, not 1 -- dankogai

importでパラメターに使う変数を全部書き出さないといけないというのがダサいといえばダサいのですが、直接@_を使うようにすればそれも不要です。

Enjoy!

Dan the Attribute::Handlers Handler