Perl のクロージャ

いつもお世話になってるあの人とかあの人とかが山口家の逆襲->perl-解説->クロージャというクロージャの解説ページをブックマークしてるのをきっかけに、 Perl のクロージャについて自分もちゃんと理解できてるのかというのを考えてみましたが、どうも微妙です。

クロージャについて、何でいまいち理解しきれてない感じがあるのかというと、クロージャがどういうものであるかは知ってるけど、クロージャをどういう時に使うと良いのかが具体的にあれとこれという感じで思い付かないからなのではないかと思った。

なので、Perl でクロージャを使ってる実装とかを見て、どんなときに使われるものなのかをリストアップして理解を深めてみよう..のコーナーです。

クラスにデータを保持するためのクロージャ

僕がぱっと思いついたのは Class::DBI の中で使われている Ima::DBI におけるデータベースハンドラのキャッシュの実装あたり。それから、Class::DBI::Inheritable の実装周り。この両者の共通するところは、クロージャを Static メソッドとしてシンボルに登録して、クラスがデータを保持できるようにしているところでしょうか。

Class::DBI::Inheritable は、何かそのクラスのインスタンス全体で保存しておきたいと思ったデータをクラスに保存できるようにし、且つそのアクセサとデータを継承したりオーバーライドできるようにするためのモジュールです。

Damian ConwayとMichael G SchwernによるPerlのモジュールClass::Data::Inheritableを使うと、継承できるクラス変数をパッケージに追加できます。数年前にいったいどういう方法なのかとコードを読んだとき、なるほどこの手があったかと舌を巻いたものです。クロージャを使っているのです。クロージャは無名のオブジェクトだとSchemeで唱えられていますが、それを実感したときでした。
Perlのクラスはオブジェクトではなく、単なるパッケージ名にしかすぎません。それにクラス変数を載せて継承させようとしても、工夫がいります。そこに無名オブジェクトであるクロージャを使うのは、エレガントで格好いいなぁと思ったものでした。

という id:tociyuki さんの日記にもある通り、継承やオーバーライドが可能なクラス変数を実現させるためにクロージャを使っています。

実装の方はと言うと、

package Class::Data::Inheritable;

use strict qw(vars subs);
use vars qw($VERSION);
$VERSION = '0.04';

sub mk_classdata {
    my ($declaredclass, $attribute, $data) = @_;

    if( ref $declaredclass ) {
        require Carp;
        Carp::croak("mk_classdata() is a class method, not an object method");
    }

    my $accessor = sub {
        my $wantclass = ref($_[0]) || $_[0];

        return $wantclass->mk_classdata($attribute)->(@_)
          if @_>1 && $wantclass ne $declaredclass;

        $data = $_[1] if @_>1;
        return $data;
    };

    my $alias = "_${attribute}_accessor";
    *{$declaredclass.'::'.$attribute} = $accessor;
    *{$declaredclass.'::'.$alias}     = $accessor;
}

というコードになっています。

    my $accessor = sub {
        my $wantclass = ref($_[0]) || $_[0];

        return $wantclass->mk_classdata($attribute)->(@_)
          if @_>1 && $wantclass ne $declaredclass;

        $data = $_[1] if @_>1;
        return $data;
    };

の部分で、mk_classdata の引数としてわたってきたもののうち $attribute と $data の二つのレキシカル変数に対して無名サブルーチンからアクセスして、クロージャを作っています。

このクロージャを、最後の二行

    *{$declaredclass.'::'.$attribute} = $accessor;
    *{$declaredclass.'::'.$alias}     = $accessor;

でシンボルに代入し、mk_classdata を呼び出したクラスのメソッドに仕立て上げています。これでデータ($data)を保持したままのクラスメソッドが完成します。オーバーライドを実現する箇所のコードも含めて、すぐには思いつかないコードです。

Ima::DBI の方はと言いますと、データベースへの接続をクラスが保持し続けてそのコネクションを使い回すように、その実装にクロージャが使われています。抜粋すると、以下の箇所です。

sub set_db {
    ....
        no strict 'refs';
    *{ $class . "::db_$db_name" } =
        $class->_mk_db_closure($data_source, $user, $password, $attr);
}

sub _mk_db_closure {
    my ($class, @connection) = @_;
    my $dbh;
    return sub {
        unless ($dbh && $dbh->FETCH('Active') && $dbh->ping) {
            $dbh = DBI->connect_cached(@connection);
        }
        return $dbh;
    };
}

_mk_db_closure でクロージャを作って、$dbh を保持するようにしておき、そのクロージャをクラスメソッドとして登録しています。DBI の connect_cached は、同じデータベースハンドラインスタンスなら接続を使い回すことができる便利な connect メソッドですが、その性質とクロージャ、それから Perl の Static メソッドのスコープをうまく組み合わせて利用していてうまいなあと思います。

mod_perl や FastCGI のような Perl のコンパイルコードが永続化する環境では、クラスに保持されたデータもメモリ内で永続化するので、Ima::DBI を使ってる Class::DBI を使えば、クロージャで保持されているデータベースハンドラも永続化され、接続が複数のリクエストにまたがって共有されます。

サブルーチンテンプレートとしてのクロージャ

ラクダ本を読んでたら、第二版の P.290 に

クロージャを、evalを使わずにサブルーチンテンプレートを書く方法、と考えることもできる。レキシカル変数はテンプレートに埋め込むパラメータのようなものである。

という解説がありました。

このサブルーチンテンプレートとしてのクロージャに関しては、Perlクックブック初版(すいません、手元に初版しかありませんでした。) の「レシピ 10.14 関数を再定義する」(P.364) 辺りに具体例があります。

my $string = red("careful here");
print $string;

<font color='red'>careful here</font>

といった色つきフォントタグを生成するサブルーチンを各色分用意するというところでクロージャを使う例です。

@colors = qw(red blue green yellow orange purple violet);
for my $name (@colors) {
    no strict 'refs';
    *$name = sub { "<font color='$name'>@_</font>" };
}

クロージャをつかって同じようなサブルーチンをまとめて作る、つまりはサブルーチンテンプレートです。(先の Class::Data::Inheritable や Ima::DBI も、サブルーチンテンプレートとしての側面もありますが、どちらかというとクラスにデータを保持するためあるいは局所化されたインスタンスをキャッシュするためという目的の方が主目的な感じです。)

この、サブルーチンテンプレートとしてのクロージャは、AUTOLOAD で処理の Delegate を行うコードなんかを書くときによく使うように思います。

例えば、Movable Type の O/R マッパから切り出された Data::ObjectDriver では、例えば RDBMS のあるレコードの title カラムに対して

$entry->title('foo bar');

としてアクセスすることができますが、これを実現するためにデータベースのカラム名から自動的にメソッドを作るということをしています。Data::ObjectDriver::BaseObject にその実装は書かれており、

our $AUTOLOAD;
sub AUTOLOAD {
    my $obj = $_[0];
    (my $col = $AUTOLOAD) =? s!.+::!!;
    no strict 'refs';
    Carp::croak("Cannot find method '$col' for class '$obj'") unless ref $obj;
    Carp::carp("Cannot find column '$col' for class '" . ref($obj) . "'")
        unless $obj->has_column($col);
    *$AUTOLOAD = sub {
        shift()->column($col, @_);
    };
    goto &$AUTOLOAD;
}

と、$AUTOLOAD から切り取ったカラム名 $col (レキシカル変数) を使ってクロージャを作り、それを型グロブに代入することで、以降それがインスタンスメソッドとして使われるようにするテクニックを用いています。AUTOLOAD にメソッド名が入ってくるのとサブルーチンテンプレートとしてのクロージャをうまく組み合わせている例と言えそうです。

アクセサを自動で作るといえば、ずばりアクセサ自動生成用モジュールである Class::Accessor なんかもクロージャでアクセサを動的生成していて、

sub make_accessor {
    my ($class, $field) = @_;

    # Build a closure around $field.
    return sub {
        my $self = shift;

        if(@_) {
            return $self->set($field, @_);
        }
        else {
            return $self->get($field);
        }
    };
}

とこんな具合で、フィールド名からクロージャを作ってやってこの make_accessors の呼び出し元で作ったクロージャを型グロブに代入している、という案配です。

カウンターとしてのクロージャ

クロージャを使ったサンプルに良く出てくるのがカウンタとしてのクロージャです。クロージャが呼び出されるたびにレキシカル変数がインクリメントされていき、数が数えられるとかそうった類。コールバックを要求するライブラリなんかを使ってると知らず知らずのうちにこれを使ってたり、ということがありそうです。

アルパカ本 (asin:4873111676) には File::Find を使った例が載っています。

use File::Find;

sub create_find_callback_that_counts {
    my $count = 0;
    return sub { print ++$count, ": $File::Find::name?n" };
}

my $callback1 = create_find_callback_that_counts();
my $callback2 = create_find_callback_that_counts();
print "my bin:?n";
find($callback1, "bin");
print "my lib:?n";
find($callback2, "lib");

File::Find を使ってあるディレクトリ以下のファイル/ディレクトリ数を数えるというものですが、クロージャを使ってカウンタ($count を作り、それをもって数えるという方法。グローバル変数でこれをやるのはちょっと嫌な感じですが、クロージャにすれば、カウンタを局所化できるとか、あるいはクロージャを複数生成すればそれごとにカウンタを持つことができるといった利点が得られます。

メンバポインタとしてのクロージャ

またラクダ本ですが、P.291 に

Perlは、C++のようなメンバポインタは提供しないが、クロージャを利用すれば同じような効果が得られる。あるオブジェクトのメソッドへのポインタが必要だとしよう。そのためには、オブジェクトとメソッドを、クロージャに束縛されたレキシカル変数として、記憶しておくことが可能である。

という解説があります。なんのこっちゃと思ったのですが、一緒に載っていた例をみたらなんとなく理解できました。

sub get_method_ref {
    my ($self, $method) = @_;
    return sub { return $self->$method(@_) };
}

$dog_wag = get_method_ref($dog, 'wag');
&$dog_wag("tail"); # $dog->wag('tail') を呼び出す

get_method_ref() の中で、レキシカル変数 $self をクロージャを利用して記憶します。すると、このオブジェクトはスコープがはずれた後からでもこのクロージャを使って参照できるので、クロージャを参照できるところならいつでもそのオブジェクトに対してメソッドを発行できる、というもののようです。(解説が難しい)

これを使えば、例えばアプリケーションのライフサイクルの中で、生成されたインスタンスにまとめて任意の処理を行わせたりすることができるなあと思いました。Template Method やデストラクタのようなものを使わないで複数のインスタンスの終了処理を最後に実行するとか、そういうの。

試しに実装してみました。

package Dog;
use strict;
use warnings;
use base qw(Class::Accessor);
__PACKAGE__->mk_accessors(qw(name));

sub bark {
    printf "%s: bow wow!?n", shift->name;
}

1;

とりあえず何の変哲もない犬とか、

package Human;
use strict;
use warnings;
use base qw(Class::Accessor);
__PACKAGE__->mk_accessors(qw(name age));

sub greetings {
    my $self = shift;
    printf "%s: Hi, I am %s, %d years old.?n",
        $self->name, $self->name, $self->age;
}

1;

人間とかを用意しました。

それから、メンバポインタなる概念を利用した、特定の時点で呼び出したいオブジェクトとそのメソッドを登録するプールを作ってみます。プールにオブジェクトを登録すると、_get_method_pointer によってクロージャが生成され、そのクロージャはプールインスタンスのインスタンス変数にリストとして保持されます。

package MethodPool;
use strict;
use warnings;

sub new {
    bless { pool => [] }, shift;
}

sub register {
    my $self = shift;
    my ($obj, $method) = @_;
    push @{$self->{pool}}, _get_method_pointer($obj, $method);
}

sub execute {
    $_->(@_) for @{shift->{pool}};
}

sub _get_method_pointer {
    my ($obj, $method) = @_;
    return sub { return $obj->$method(@_) };
}

1;

これらのクラスを使って、

#!/usr/local/bin/perl
use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/lib";

use Dog;
use Human;
use MethodPool;

my $dog = Dog->new;
$dog->name('cinnamon');

my $jack = Human->new;
$jack->name('Jack Bauer');
$jack->age(35);

my $pool = MethodPool->new;
$pool->register($dog, 'bark');
$pool->register($jack, 'greetings');

$pool->execute;

というコードを実行すると

$ perl pool.pl 
cinnamon: bow wow!
Jack Bauer: Hi, I am Jack Bauer, 35 years old.

という風に結果が得られます。$pool->execute はいつ実行してもいいし、$dog や $jack のスコープがはずれたところで実行してもちゃんと動くというところがポイントです。

メンバポインタとしてのクロージャを使うと、こんな風にインスタンスを保持しておいて、ちょっとスコープ的に離れたところからそれらのメソッドを呼び出してみるということができそうです。

高階関数としてのクロージャ

おそらくこれがクロージャがクロージャとして最も力を発揮するところだと思うのですが、勉強不足でまだうまく説明できません。XMLをPerlの高階関数で。: torus solutions! を読んでくださいとかいってお茶を濁す。

Higher-Order Perl: Transforming Programs with Programs を注文したので、それ呼んでからもう一回この話題にふれてみようと思います。

Higher-Order Perl: Transforming Programs with Programs

Higher-Order Perl: Transforming Programs with Programs

bless を使わないでオブジェクト相当のものを作るためのクロージャ

クロージャはコード(無名サブルーチン)とデータ(レキシカル変数)をまとめたものなので、これは言うなればオブジェクトのようなもので、それっぽく書くとオブジェクト指向っぽく見えるというもの。カプセル化された状態や振る舞いなどを持つレコードを作成したいけど、そのためにクラスを作るのはちょっと大げさ、という場合に使うといいそうです。(クックブックのレシピ 11.7 P.389 あたり)

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

sub mk_counter {
    my $count = shift;
    my $start = $count;
    my $bundle = {
        NEXT  => sub { return ++$count },
        PREV  => sub { return --$count },
        GET   => sub { return $count },
        SET   => sub { $count = shift },
        BUMP  => sub { $count += shift },
        RESET => sub { $count = $start },
    };
    $bundle->{LAST} = $bundle->{PREV};
    return $bundle;
}

my $c1 = mk_counter(20);
my $c2 = mk_counter(70);

printf "next c1: %d?n", $c1->{NEXT}->();
printf "next c2: %d?n", $c2->{NEXT}->();

こんな感じで、レキシカル変数をインスタンス変数とみなし、無名サブルーチンをメソッドと見なして、ハッシュのキーをメソッドの dispatch テーブルに使ってオブジェクト指向っぽいことをしてみるというものです。

このクロージャで OO の話は

ふと思いついて試してみたのですが、Perlでもクロージャを使ったOOPを扱えるみたいです。たぶん既出なのだろうと思いますが、見つけきれなかったのでエントリーを打ってみます。

という id:tociyuki さんの記事が具体的で詳しいです。

ということで、ラクダ本、クックブック、アルパカ本や CPAN モジュール周りの実装からクロージャの使いどころをいくつかまとめてみました。まだ他にもいろいろあると思うので、ツッコミご意見その他、NDOメソッドでお待ちしております。

続・初めてのPerl - Perlオブジェクト、リファレンス、モジュール

続・初めてのPerl - Perlオブジェクト、リファレンス、モジュール