registry-test.t

gistfile1.pl

#!/usr/bin/perl
# intro for MT::Component::registry()
use strict;
use warnings;
use lib qw( lib extlib ../lib ../extlib);
use utf8;
use MT;
use MT::Component;
use Test::More;

# componentオブジェクトを作成してMTに登録
# ( 通常、この部分はMTの初期化時に隠蔽して実行されるので意識する
# 必要はありません )

my $c1 = MT::Component->new;
my $c2 = MT::Component->new;
push @MT::Components, ( $c1, $c2 );
$MT::Component{c1} = $c1;
$MT::Component{c2} = $c2;

=head1 registry メソッドは Setter/Getter です

Component オブジェクトの registry メソッドを使う事で、その component のもつ
registry の値を追加したり取得したりできます。

=head2 Setter

引数にハッシュリファレンスを含めると、その呼び出しは Setter となります。
任意の数のスカラの後に続けてハッシュリファレンスを渡すと、そのスカラ列を
registry のパスと認識し指定されたパスに、ハッシュリファレンスで渡された
内容を書き込みます。

 $component->registry( 'path' => 'to' => 'set' =>  {
     things => 'you',
     wanna => 'set',
 });

=cut

$c1->registry( this => is => { a => 'pen' } );
is_deeply(
    $c1->{registry},
    {
        this => {
            is => {
                a => 'pen',
                plugin => $c1,
            }
        }
    },
    'Set value.',
);

=head2 Getter

また、registry メソッドにスカラ値のみからなる引数リストを渡すと、その
呼び出しは Getter となります。ハッシュツリーを、渡された値の順に一階層ずつ
おりていき、見つかった値を返します。

 $component->registry( 'path' => 'to' => 'get' );

=cut

is(
    $c1->registry( this => is => 'a' ),
    'pen',
    'Get value.',
);

=head1 特殊な Getter の呼び出し方

=head2 MT::registry()

MTクラスのクラスメソッドとして MT->registry()  を呼び出すと、MT の
インスタンスに登録されたすべてのcomponents から、マージされたハッシュを
取り出す事が出来ます。

=cut

$c1->registry( foo => { bar => 1 } );
$c2->registry( foo => { buz => 1 } );
is_deeply(
    MT->registry('foo'),
    {
        bar => 1,
        buz => 1,
    },
    'Get merged value.',
);

=head2 MT::Component::registry()

また、MT::Component クラスのクラスメソッドとして呼び出された場合、MT の
インスタンスに登録されたすべての components から registry 値を取り出し、
配列リファレンスとして受け取る事が出来ます。

=cut

is_deeply(
    MT::Component->registry('foo'),
    [
        { 'bar' => 1 },
        { 'buz' => 1 },
    ],
    'Get multiple values from components as arrayref.',
);

=head1 自動ローカライズ

registry では、B<label>という文字列で終わるキーを持つ値に対して、自動的に
translateが行われます。

これは、単純に文字列が置き換わるという意味ではありません。registry メソッドで
値を取り出したあと、***label キーの値は CODEREF に置き換わります。
実際にtranslateされた文字列を取り出す場合には、この CODEREF を実行する必要が
あります。

 my $hash = $component->registry( foo => 'bar' );
 my $label = $hash->{label};
 print $label->();

殆どの場合、label の値はテンプレートに渡されるかと思います。
テンプレートタグ mt:var ではサブルーチンの自動展開が行われますので、
基本的には、translate 途中のサブルーチンの存在を意識する必要は有りません。
ただし、テンプレートに値を渡す前に、label の値に基づいて perl でソートを
行いたい等の場合には手動で CODEREF を実行する必要があります。

=cut

$c1->registry({
    entry_label => 'Entry',
    foo => {
        page_label => 'Page',
    },
});

MT->new; # required for load Core translate lexicons.
MT->set_language('ja');
is(
    $c1->registry('entry_label'),
    'ブログ記事',
    'Get translated value',
);

my $page_label = $c1->registry('foo')->{page_label};
is(
    ref $page_label,
    'CODE',
    'In deep hash, it is closure.',
);
is(
    $page_label->(),
    'ウェブページ',
    'And we can get translated value from it.',
);

=head1 registry の「接ぎ木」

registry メソッドにはいくつかの魔法がかけられています。これらの魔法は、
巨大なハッシュの遅延ロードやプログラムの起動時に動的に registry の値を
設定するのに役立つような、registry の「接ぎ木」を実現します。

=head2 サブルーチンリファレンスによる接ぎ木

サブルーチンのリファレンスが registry 中に見つかると、registry メソッド
はサブルーチンの戻り値を元の registry に接ぎ木します。これにより、まるで
元から registry のハッシュツリーに値が存在したかのように扱うことが出来ます。
以下のテストで、Getter 呼び出しの際には、サブルーチンの外のキーと、戻り値に
含まれるキーが区別無く並んでいる事に注目してください。
サブルーチンには MT::Component のインスタンスが引数として渡され、戻り値が
registry に接ぎ木されます。

=cut

$c1->registry({
    secret => sub {
        # some costly operation
        return {
            'of_life' => 2 * 3 * 7,
        };
    },
});

is(
    $c1->registry( 'secret' => 'of_life' ),
    42,
    'Fetch from coderef grafts.',
);

=head2 MT コンポーネント形式のサブルーチン名

ダラーサイン($)で始まり、連続したコロン(::)を含む文字列は、MTがサブルーチンの
名称と理解して、サブルーチンリファレンスと同様にハッシュツリーへの接続が
行われます。
注意してほしいのは、ここで指定する値は perl のシンボルテーブル上のサブルーチン名
とは異なる解釈をされるということです。ダラーサインで始まる最初の部分は、
MT::ComponentのIDとなります。そのあとに、perl に理解可能なサブルーチン名が続きます。
指定した関数には MT::Component のインスタンスが引数として渡され、戻り値が
registry に接ぎ木されます。

$ + COMPONENT_ID + :: + FULL::NAME::OF::SUB

=cut

sub my_sub {
    my $component = shift;
    return {
        nelson => "histoire"
    };
}

$c1->registry({ melody => '$c1::main::my_sub' });
is(
    $c1->registry( melody => 'nelson' ),
    'histoire',
    'Fetch from subroutine grafts',
);

=pod

また、パッケージ名を受け取りたい場合には、矢印演算子(->)を使って記述する事も
出来ます。

$ + COMPONENT_ID + :: + PACKAGE::NAME->routine_name

上の例では、I<COMPONENT_ID>を現在のコンポーネントとして設定した上で、メソッド
I<routine_name>がI<PACKAGE::NAME>パッケージのクラスメソッドとして呼び出されま
す。第一引数にはパッケージ名('PACKAGE::NAME')が、第二引数にコンポーネントの
インスタンスが渡されます。

(現在の仕様では、この形式で呼び出すためには、パッケージが require 出来るように
サーチパスに.pmファイルが設置してある必要があります。 パッケージ名として
指定した名前空間が宣言されているだけでは動作しません。下のテストでは、この制限を
回避するために、require済みであるMTパッケージにルーチンを宣言しています。
いけてないですね＞＜)

=cut

package MT;

sub this_is_me {
    my $pkg = shift;
    my $component = shift;
    return {
        my_name => "my name is $pkg",
    }
}

package main;

$c1->registry({ this_is_me => '$c1::MT->this_is_me' });
is(
    $c1->registry( this_is_me => 'my_name' ),
    'my name is MT',
    'Fetch from class method grafts.'
);

=head2 YAML ファイルの接ぎ木

registry メソッドはまた、外部 YAML ファイルを接ぎ木する事も出来ます。
ハッシュツリーに'.yaml'で終わる文字列に、そこから先に yaml ファイルをパース
した内容が展開されます。

MT は、Component の path の値(通常は、その plugin のルートディレクトリ)を始点
として指定されたファイルを検索します。

=cut

# このテストを実行するためには、以下の内容の YAML ファイルを
# registry-test.yaml というファイル名で、このスクリプトと同じディレクトリに
# 設置する必要があります。
#---
#greeting: Hello from registry-test.yaml.
#---

SKIP: {
    skip "No yaml file for test", 1 unless -f 'registry-test.yaml';
    $c1->path('.');
    $c1->registry({ yaml => 'registry-test.yaml' });
    is(
        $c1->registry('yaml' => 'greeting'),
        'Hello from registry-test.yaml.',
        'Fetch from yaml file grafts.',
    );
}

done_testing();