人生ずっと勉強

人生ずっと勉強ですね。 https://twitter.com/KiyotakaGoto

no 関数を理解しようとしたら Mouse を読んでた

社内モジュールに Mouse を使っているものがあって、
その中で no Mouse; しているところがあった。
「no Mouse; ってなんだ?」と思ったので、ぐぐりながら、
どうせならと勉強のため少しだけ、Mouse の中を読んでみた(Mouse version 1.05)。

社内モジュールは(たしか)以下の様な感じで has をインポートして、アクセサを定義したのち、
no Mouse; していた。

use Mouse qw/ has /;

has 'hoge' => ( is => 'rw', isa => 'Int' );

no Mouse;

no 関数は結局、Module::unimport を呼び出すだけらしい。(参考:perlでモジュールのimportとunimport | taichino.com

なら Mouse 内に unimport の定義があるんだろうと思って検索してみたら、ない。
import すらない。
ただ、こんなのがあった。

Mouse::Exporter->setup_import_methods(
    as_is => [qw(
        extends with
        has
        before after around
        override super
        augment  inner
    ),
        \&Scalar::Util::blessed,
        \&Carp::confess,   ],
);

怪しいので覗いてみる。

sub setup_import_methods{
    my($class, %args) = @_;
    my $exporting_package = $args{exporting_package} ||= caller();
    my($import, $unimport) = $class->build_import_methods(%args);
    Mouse::Util::install_subroutines($exporting_package,
        import   => $import,
        unimport => $unimport,
        export_to_level => sub {
            my($package, $level, undef, @args) = @_; # the third argument is redundant
            $package->import({ into_level => $level + 1 }, @args);        },
        export => sub {
            my($package, $into, @args) = @_;
            $package->import({ into => $into }, @args);        },
    );
    return;
}

どうやら Mouse::Util::install_subroutines で、import と unimport をimport してるようだ。

sub install_subroutines {
    my $into = shift;

    while(my($name, $code) = splice @_, 0, 2){
        no strict 'refs';
        no warnings 'once', 'redefine';
        use warnings FATAL => 'uninitialized';
        *{$into . '::' . $name} = \&{$code};
    }
    return;
}

たしかに型グロブにほりこんでいるようです。
これで Mouse に import メソッドと unimport メソッドが定義されるわけか。
import, unimport を定義する Mouse::Exporter::build_import_methods をみてみると、

sub build_import_methods{
    my($self, %args) = @_;
(中略)
    return (\&do_import, \&do_unimport);
}

となっていて、do_import, do_unimport は(完全には理解してませんが)、
それぞれ以下のようにサブルーチンを import したり削除したりしている様子があります。

sub do_import {
(中略)
    if(@exports){
        my @export_table;
        foreach my $keyword(@exports){
            push @export_table,
                $keyword => ($spec->{EXPORTS}{$keyword}
                    || Carp::confess(qq{The $package package does not export "$keyword"})
                );
        }
        Mouse::Util::install_subroutines($into, @export_table);
    }
    else{
        Mouse::Util::install_subroutines($into, %{$spec->{DEFAULT}});
    }
    return;
}

sub do_unimport {
    my($package, $arg) = @_;
 (中略)
    my $from = _get_caller_package($arg);

    my $stash = do{
        no strict 'refs';
        \%{$from . '::'}
    };

   for my $keyword (@{ $spec->{REMOVABLES} }) {
        next if !exists $stash->{$keyword};
        my $gv = \$stash->{$keyword};

        # remove what is from us
        if(ref($gv) eq 'GLOB' && *{$gv}{CODE} == $spec->{EXPORTS}{$keyword}){
            delete $stash->{$keyword};
        }
    }
    return;
}

ここまでで no 関数と、呼び出される unimport の関係はわかった。
ので、ここで終わってもよかったんですが、せっかくなので次は、
use Mouse; してるモジュールをなぜ new できるのかを調べることにした。
Mouse.pm には new メソッドがなかった。

use Mouse; したら import Mouse されるので、さっきの do_import を見ると、

   if($spec->{INIT_META}){
        my $meta;
        foreach my $init_meta(@{$spec->{INIT_META}}){
            $meta = $package->$init_meta(for_class => $into);
        }

という記述がある。
実際、Mouse.pm に、

sub init_meta {
    shift;
    my %args = @_;

    my $class = $args{for_class}
        or confess("Cannot call init_meta without specifying a for_class");

    my $base_class = $args{base_class} || 'Mouse::Object';
    my $metaclass  = $args{metaclass}  || 'Mouse::Meta::Class';

と、定義もある。これを見る限り、Mouse::Object がベースクラス、メタクラスが Mouse::Meta::Class となっている。
PurePerl.pm で定義をみてみると、Mouse::Object に以下のように new が、

sub new {
    my $class = shift;
    my $args  = $class->BUILDARGS(@_);
    return $class->meta->new_object($args);
}

Mouse::Meta::Class に以下のように new_object が定義されている。そしてこの new_object の中で、
BUILD メソッドが呼ばれている。

sub new_object {
    my $meta = shift;
    my %args = (@_ == 1 ? %{$_[0]} : @_);

    my $object = bless {}, $meta->name;

    $meta->_initialize_object($object, \%args, 0);
    # BUILDALL
    if( $object->can('BUILD') ) {
        for my $class (reverse $meta->linearized_isa) {
            my $build = Mouse::Util::get_code_ref($class, 'BUILD')
                || next;

            $object->$build(\%args);
        }
    }
    return $object;
}

ということで、use Mouse; したモジュールを new すると、
Mouse::Object に定義のある new

Mouse::Meta::Class に定義のある new_object

use Mouse; したモジュールに定義のある BUILD メソッドが呼ばれる

という流れらしい。
Mouse 使うときはコンストラクタ的に new でなく BUILD メソッドを用意するのはこのためか。