PerlにおけるRubyライクなブロックにまつわる、関数のプロトタイプについてのまとめ。

Amon2のbasic flavorな自動出力を眺めていたら、"script/myapp-server"*1にこんなソースが有りました。

my $app = builder {
    enable 'Plack::Middleware::Static',
        path => qr{^(?:/static/)},
        root => File::Spec->catdir(dirname(__FILE__), '..');
    enable 'Plack::Middleware::Static',
        path => qr{^(?:/robots\.txt|/favicon\.ico)$},
        root => File::Spec->catdir(dirname(__FILE__), '..', 'static');
    enable 'Plack::Middleware::ReverseProxy';

    MyApp::Web->to_app();
};

builderというのは、Plack::BuilderモジュールDSLのようですが、文法が謎だったので調べてみたところ、PerlでもRubyのブロックのようなことが出来るとのことでした。

文法的には、関数のプロトタイプコンパイル時引数チェック)機能により実現されるようです。プロトタイプはsubの関数名の後に括弧で指定します。

# ($$) なので引数は2つのスカラ値限定
sub do_with_only_two_arguments($$) { print join(' ', @_), "\n"; }

上記の様な関数を定義した場合、引数が2つのスカラ値でない場合、コンパイルにエラーになります。

use strict;
use warnings;
use utf8;

sub do_with_only_two_arguments($$) { print join(' ', @_), "\n"; }

do_with_only_two_arguments 10, 20;
do_with_only_two_arguments [10], {'hoge' => 20};

# 実行結果
10 20
ARRAY(0x7f842b0040b8) HASH(0x7f842b027cb0)

#-------------------
use strict;
use warnings;
use utf8;

sub do_with_only_two_arguments($$) { print join(' ', @_), "\n"; }

@a = (10, 20);
do_with_only_two_arguments @a;

# 実行結果
Not enough arguments for main::do_with_only_two_arguments at script/sub.pl line 8, near "@a;"
Execution of script/sub.pl aborted due to compilation errors.

引数指定に誤りがある場合は、コンパイル時にエラーになるので、スクリプトが一切実行されること無く終了します。

プロトタイプには特殊な記法が多数あるので、ここでは一部だけ取り上げます。

  • "&"プロトタイプ
    • これによりRubyのブロック的なことができます。
    • 一番目の引数にしか指定できないようです(要調査)
  • "\[]"(バックスラッシュ記法)
  • "+"プロトタイプ
    • リテラルな配列やハッシュが与えられた場合は"\[@%]"として、それ以外の場合はスカラ値として扱われる。
    • これを指定する時は、引数の型をチェックする必要がある*2

最後に、色々実験したコードも載せておきます。

use strict;
use warnings;
use utf8;

my @a = (1..3);


# +プロトタイプ
sub print_array(+) {
    my $aref = shift;
    die "Not an array or arrayref" unless ref $aref eq 'ARRAY';
    print join(' ', @$aref), "\n";
}

print_array @a;
print_array \@a;
eval { print_array 1; };
print $@ if ($@);


# 引数の数が重要
sub print_one_scalar_argument($) { print_array @_; }
sub print_two_scalar_arguments($$) { print_array @_; }

print_one_scalar_argument 10;
print_one_scalar_argument @a; # スカラで評価される
print_two_scalar_arguments 10, 20;
print_two_scalar_arguments [10], {'a' => 20};


# プロトタイプ無指定の場合は恐らくこれ?
sub print_only_array(@) { print_array @_; } 

print_only_array @a;
print_only_array 1, 2, 3;


# ブロックを無名関数のように渡せる
sub do_block(&) { shift->(); }

do_block { print "hoge\n"; };


# local宣言でブロック内の$_変数を書き換える。
# local宣言の変数は、そこから呼ばれる関数において参照が可能なので、
# ブロックで$_を参照することで、ここで書き換えた値が得られる。
# localなのでブロックを抜けると(=ループの度)$_は復元される。
# …実にキモいが巧い。
sub index_of(&\[@]) {
    my ($block, $target) = @_;
    for (my $i = 0; $i < @$target; ++$i) {
        local $_ = $target->[$i];
        return $i if &$block;
    }
}

my $idx = index_of { $_ == 3 } @a;
print $idx, "\n";


# 無名関数でもいいじゃない?
sub do_sub_with_100($) { shift->(100); }

do_sub_with_100 sub { print shift, "\n"; };

実行結果

$ perl test.pl 
1 2 3
1 2 3
Not an array or arrayref at test.pl line 11.
10
3
10 20
ARRAY(0x7fce90827cb0) HASH(0x7fce90827d70)
1 2 3
1 2 3
hoge
2
100

*1:プロジェクト名はMyAppとする

*2:とperldocには書かれていませんが、バックスラッシュ記法でも複数のリテラルを許容する時は、場合によってはチェックが必要な気がします