日向夏特殊応援部隊

俺様向けメモ

Catalyst Source Code Walking #01

Perl CPAN Catalyst

はじめに

遅ればせながらじっくりCatalystのsourceを読んでみようかと思ったので、
備忘録を兼ねてシリーズ化してみます。


ちなみにソースコードはCatalyst::Runtimeの5.7003を見てます。


まずbootstrapとなるscript(project_server.pl)から見れば当然、Catalyst.pmを継承したクラスが基点となってるのは明らかなので、ここから読んでみます。

ここでは、

$ catalyst.pl MyApp

でプロジェクトを作った物だとします。


まず出来上がったMyApp.pmを見てみます。

Catalyst->import

use Catalyst qw/-Debug ConfigLoader Static::Simple/;

our $VERSION = '0.01';

#
# Configure the application 
#
__PACKAGE__->config( name => 'MyApp' );

#
# Start the application
#
__PACKAGE__->setup;

ここから見れば、

  1. Catalyst->import
  2. MyApp->config
  3. MyApp->setup

と言う順番でCatalystが起動してるのが分かります。
従って順番に追って行きましょう。

sub import {
    my ( $class, @arguments ) = @_;

    # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
    # callers @ISA.
    return unless $class eq 'Catalyst';

    my $caller = caller(0);

    unless ( $caller->isa('Catalyst') ) {
        no strict 'refs';
        push @{"$caller\::ISA"}, $class, 'Catalyst::Controller';
    }

    $caller->arguments( [@arguments] );
    $caller->setup_home;
}

このような実装になっているので、callerであるMyAppモジュールに対して、まだCatalystをuseしただけのモジュールなので@ISAに当然Catalystが入ってないのでunlessブロックに行き、Catalyst. Catalyst::ControllerがMyAppに無理やり継承されます。


またimportで渡した引数全てがargumenstにセットされてsetup_homeメソッドを叩くようになります。


従って先の起動順にsetup_homeが加わります。

  1. Catalyst->import
  2. Catalyst->setup_home
  3. MyApp->config
  4. MyApp->setup
Catalyst::Controller

さて、ここで無理やり継承したCatalyst::Controllerを見てみると、

package Catalyst::Controller;

use strict;
use base qw/Catalyst::Base/;

しか無いのですぐにCatalyst::Baseへ飛びます。

Catalyst::Base

まずCatalyst::Baseの冒頭を見てみます。

package Catalyst::Base;

use strict;
use base qw/Catalyst::Component Catalyst::AttrContainer Class::Accessor::Fast/;

use Catalyst::Exception;
use Catalyst::Utils;
use Class::Inspector;
use NEXT;

注目すべきクラスとしては、

でしょう。*1

Catalyst::Component

まずはCatalyst::Componentから

package Catalyst::Component;

use strict;
use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
use NEXT;
use Catalyst::Utils;

って訳でCatalyst::Componentを継承したクラスはClass::Accessor::Fast, Class::Data::Inheritableをそのまま使えるのと、Damian Conwey先生のNEXTが使えるのとUtils読んでるだけみたいですね。


Class::Inspectorは特定のクラスの情報を取得する為のモジュール、NEXTモジュールは継承ツリーのダイアモンドにある同名のメソッドを実行していくモジュールで大体説明合ってるかな。


Catalystにおいて、Catalyst::Componentが基本的には最小の単位の一つと言っても良さそうですね。

Catalyst::AttrContainer

次にCatalyst::AttrContainerを見てみましょう。

package Catalyst::AttrContainer;

use strict;
use base qw/Class::Accessor::Fast Class::Data::Inheritable/;

use Catalyst::Exception;
use NEXT;

__PACKAGE__->mk_classdata($_) for qw/_attr_cache _action_cache/;
__PACKAGE__->_attr_cache( {} );
__PACKAGE__->_action_cache( [] );

# note - see attributes(3pm)
sub MODIFY_CODE_ATTRIBUTES {
    my ( $class, $code, @attrs ) = @_;
    $class->_attr_cache( { %{ $class->_attr_cache }, $code => [@attrs] } );
    $class->_action_cache(
        [ @{ $class->_action_cache }, [ $code, [@attrs] ] ] );
    return ();
}

sub FETCH_CODE_ATTRIBUTES { $_[0]->_attr_cache->{ $_[1] } || () }

親切にもattributesのperldocを見ろとありますので、見てみましょう。

FETCH_type_ATTRIBUTES

This method receives a single argument, which is a reference to the variable or subroutine for which package-defined attributes are desired. The expected return value is a list of associated attributes. This list may be empty.

MODIFY_type_ATTRIBUTES

This method is called with two fixed arguments, followed by the list of attributes from the relevant declaration. The two fixed arguments are the relevant package name and a reference to the declared subroutine or variable. The expected return value is a list of attributes which were not recognized by this handler. Note that this allows for a derived class to delegate a call to its base class, and then only examine the attributes which the base class didn't already handle for it.

The call to this method is currently made during the processing of the declaration. In particular, this means that a subroutine reference will probably be for an undefined subroutine, even if this declaration is actually part of the definition.

で必要な部分を物凄い意訳*2してみると、

FETCH_type_ATTRIBUTES
サブルーチンまたは変数のリファレンスを渡すことにより、現在関連付けられているattributesのリストを返します。ひょっとしたら空リストかもしれません。
MODIFY_type_ATTRIBUTES
このメソッドは二つの固定引数と該当する宣言(変数宣言orサブルーチン宣言)から指定されたattributesのリストを渡す事によって呼び出されます。最初の二つの固定引数は該当するパッケージ名と宣言されたサブルーチンまたは変数のリファレンスです。戻り値はこのハンドラによってまだ認められていないattributesのリストになります。このメソッドを呼び出す事は派生クラスから基底クラスへの委譲呼び出しを許可し、そしてそのとき基底クラスではまだハンドルされていないattributesを調査するだけである事を知っておかねばならない。このメソッドの呼び出しは現在では宣言の処理中に作られます。特に、これが意味するところは例えこの宣言が実際の定義部であっても、サブルーチンリファレンスはひょっとしたら未定義のサブルーチンになるかもしれないと言う事である。

ちょっとMODIFY_type_ATTRIBUTESの部分の訳が怪しい。誰かhelpして下さい。ｗ


まぁ上記の怪しい和訳を元に再度コードを見たら、割とそのまま読めば分かって、
_attr_cacheに対してサブルーチンリファレンスをキーに、割り当てられたattributesを値にしたハッシュリファレンスを保持させてたり、_action_cacheはまたちょっと違うデータ構造でキャッシュしてるだけですね。

Catalyst->setup_home

さてimportの最後で呼び出されたsetup_homeを見てみると、

sub setup_home {
    my ( $class, $home ) = @_;

    if ( $ENV{CATALYST_HOME} ) {
        $home = $ENV{CATALYST_HOME};
    }

    if ( $ENV{ uc($class) . '_HOME' } ) {
        $home = $ENV{ uc($class) . '_HOME' };
    }

    unless ($home) {
        $home = Catalyst::Utils::home($class);
    }

    if ($home) {
        $class->config->{home} ||= $home;
        $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
    }
}

とあります。

みたいな選択肢があるみたいですね。

MyApp->config

実際にはCatalystクラスにあるconfigメソッドに相当しますので、そのソースを見てみましょう。

sub config {
    my $c = shift;

    $c->log->warn("Setting config after setup has been run is not a good idea.")
      if ( @_ and $c->setup_finished );

    $c->NEXT::config(@_);
}

設定値の代入があり、さらにsetupが終了してたらログにwarningが出ますね。
まぁ、当たり前の処理っちゃそうだけど、きめ細かいですね。


さらにここでNEXTモジュールの登場。
継承ツリーが存在すれば階層的にconfigメソッドが呼び出されます。


でMyAppはCatalystとCatalyst::Controllerを継承しているハズなので、継承ツリーを見て*3みましょう。


で先ほど継承関係については言及したので結論から言えばCatalyst::Componentにconfigメソッドが存在します。

sub config {
    my $self = shift;
    my $config = $self->_config;
    unless ($config) {
        $self->_config( $config = {} );
    }
    if (@_) {
        my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} };
        $self->_config(
            $self->merge_config_hashes( $config, $newconfig )
        );
    }
    return $config;
}

_configは、

__PACKAGE__->mk_classdata($_) for qw/_config _plugins/;

とあるのでクラスデータです。あと渡すデータはハッシュまたはハッシュリファレンスどちらでもOKみたいですね。
さらにmerge_config_hashesメソッドで元のconfigと新しいconfigをmergeしてます。


CatalystクラスでのconfigメソッドはNEXTによるredispatchをするだけで、実際にはCatalyst::Componentのconfigにぶち込まれるってのが分かります。

MyApp->setup

ここら辺から起動時の初期化処理の本番になります。
長いので分割してみていきます。

sub setup {
    my ( $class, @arguments ) = @_;

    $class->log->warn("Running setup twice is not a good idea.")
      if ( $class->setup_finished );

    unless ( $class->isa('Catalyst') ) {

        Catalyst::Exception->throw(
            message => qq/'$class' does not inherit from Catalyst/ );
    }

    if ( $class->arguments ) {
        @arguments = ( @arguments, @{ $class->arguments } );
    }

まずは先にも出てきましたがsetupが終了していたら怒られます。
そしてargumentsですが、先ほどCatalystのuse時に渡した時のargumentsに追加する形で、
さらに渡す事が出来ます。


PODにも書いてあるように、

MyApp->setup(qw|-Debug -Home=/home/myapp/libs/MyApp|);

みたいになります。


ちょっとフライングですが-を先頭につけると内部的にflag扱いになります。
以下のコードがその処理に当たります。

    # Process options
    my $flags = {};

    foreach (@arguments) {

        if (/^-Debug$/) {
            $flags->{log} =
              ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
        }
        elsif (/^-(\w+)=?(.*)$/) {
            $flags->{ lc $1 } = $2;
        }
        else {
            push @{ $flags->{plugins} }, $_;
        }
    }

で-Flag=Valueみたいなフォーマットだと、
値つきのflagになります。それ以外はplugin扱いになるようです。

    $class->setup_home( delete $flags->{home} );

    $class->setup_log( delete $flags->{log} );
    $class->setup_plugins( delete $flags->{plugins} );
    $class->setup_dispatcher( delete $flags->{dispatcher} );
    $class->setup_engine( delete $flags->{engine} );

この処理を見るとsetup内でさらに細分化された初期化処理が存在します。*4
従って、

  1. Catalyst->import
  2. Catalyst->setup_home
  3. MyApp->config
  4. MyApp->setup
    1. MyApp->setup_home
    2. MyApp->setup_log
    3. MyApp->setup_plugins
    4. MyApp->setup_dispatcher
    5. MyApp->setup_engine

と言う流れになると言えます。それぞれは後で述べる事にします。

    for my $flag ( sort keys %{$flags} ) {

        if ( my $code = $class->can( 'setup_' . $flag ) ) {
            &$code( $class, delete $flags->{$flag} );
        }
        else {
            $class->log->warn(qq/Unknown flag "$flag"/);
        }
    }

flagとして有効な物はsetup_flagと言う形でメソッド化されていないとダメみたいです。
従ってどこかしらで定義して挙げれば任意のflagが立てれますね。*5


ここはHack出来るポイントの一つになりますね。

    eval { require Catalyst::Devel; };
    if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
        $class->log->warn(<<"EOF");
You are running an old script!

  Please update by running (this will overwrite existing files):
    catalyst.pl -force -scripts $class

  or (this will not overwrite existing files):
    catalyst.pl -scripts $class
EOF
    }

Catalyst::Develモジュールをrequireしてますね。
環境変数CATALYST_SCRIPT_GENが存在して、尚且つその値がCatalyst::DevelのCATALYST_SCRIPT_GENより値が小さい場合は古いcatalyst.plを使ってるとみなされるみたいですね。


ただ今読んでいた限りではこの環境変数がセットされてなかったようなので、通常起動では無関係な処理だと思われます。恐らくcatalyst.plでHelper使った時に必要なんじゃなかろうか。*6
ここの部分はそのうち記述を直します。

    if ( $class->debug ) {
        my @plugins = map { "$_  " . ( $_->VERSION || '' ) } $class->registered_plugins;

        if (@plugins) {
            my $t = Text::SimpleTable->new(74);
            $t->row($_) for @plugins;
            $class->log->debug( "Loaded plugins:\n" . $t->draw );
        }

        my $dispatcher = $class->dispatcher;
        my $engine     = $class->engine;
        my $home       = $class->config->{home};

        $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
        $class->log->debug(qq/Loaded engine "$engine"/);

        $home
          ? ( -d $home )
          ? $class->log->debug(qq/Found home "$home"/)
          : $class->log->debug(qq/Home "$home" doesn't exist/)
          : $class->log->debug(q/Couldn't find home/);
    }

この部分は諸々のデバッグログ吐き出しですね。
恐らくコンソールで多くの方が良く見てるんじゃないすかね。

    # Call plugins setup
    {
        no warnings qw/redefine/;
        local *setup = sub { };
        $class->setup;
    }

ここで再びsetupをlocalでtmp化して実行してるんだけど…。


コメントを見るとロードしたpluginのsetupを実行している模様。*7

    # Initialize our data structure
    $class->components( {} );

    $class->setup_components;

    if ( $class->debug ) {
        my $t = Text::SimpleTable->new( [ 63, 'Class' ], [ 8, 'Type' ] );
        for my $comp ( sort keys %{ $class->components } ) {
            my $type = ref $class->components->{$comp} ? 'instance' : 'class';
            $t->row( $comp, $type );
        }
        $class->log->debug( "Loaded components:\n" . $t->draw )
          if ( keys %{ $class->components } );
    }

    # Add our self to components, since we are also a component
    $class->components->{$class} = $class;


そしてsetup_componentsでcomponentの初期化が始まり、自分自身もcomponentなので、
最後に自分自身を追加します。

    $class->setup_actions;

    if ( $class->debug ) {
        my $name = $class->config->{name} || 'Application';
        $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
    }
    $class->log->_flush() if $class->log->can('_flush');

    $class->setup_finished(1);
}


最後にactionの初期化をsetup_actionsで行い初期化終了です。

まとめ(仮)

  1. Catalyst->import
  2. Catalyst->setup_home
  3. MyApp->config
  4. MyApp->setup
    1. MyApp->setup_home
    2. MyApp->setup_log
    3. MyApp->setup_plugins
    4. MyApp->setup_dispatcher
    5. MyApp->setup_engine
    6. MyApp->setup_flags (あれば)*8
    7. MyApp->plugins->setup
    8. MyApp->setup_components
    9. MyApp->setup_actions

こういう実行順序みたいです。とは言えここまででも結構ソース読むのは時間が掛かりますねぇ。。。
Devel::CallStackで呼び出し階層のtraceしたんだけどログみたら自分でソース読んだ方が早いという結論に至りました。


次回(まだあるの？)はsetup内で呼び出されていた各種setup処理の詳細を見ていきます。

*1:ほとんど全てって噂ですがｗ

*2:異訳だったらスンマヘンorz...

*3:継承ツリーをdumpするCPANモジュールってありそうだけど、探したけど見つからなかった。

*4:ところでsetup_homeの呼び出しが再度あるのが非常に無駄っぽく感じるのは僕だけ？お尻にif ($flags->{home}); ってつけるだけで良いと思うんだけど…

*5:これもsetup処理の一環だった、また漏れてるorz...

*6:bootstrapで思いっきりセットされてた罠orz...

*7:ここの処理も初期化処理に加えるの忘れてた

*8:正確にはflagとして指定した文字列がfooならsetup_fooがあれば実行される