sample code snippet to explain circular dependeded attributes

era_role.pl

#!/usr/local/bin/perl
# sample code snippet to explain circular dependeded attributes (with role)
# see http://blog.eorzea.asia/2009/10/post_72.html

use strict;
use warnings;
use utf8;

{
    package MyApp::HasChristianEra;

    use Moose::Role;

    use namespace::clean;

    requires qw(
        Delta
        imperial_era
    );

    has 'christian_era' => (    # 西暦X年
        is          => 'rw',
        isa         => 'Int',
        lazy_build  => 1,
        trigger     => sub {
            $_[0]->_clear_imperial_era;
        },
        clearer     => '_clear_christian_era',
    );

    sub _build_imperial_era {
        return $_[0]->christian_era - $_[0]->Delta;
    }

    sub _build_christian_era {
        return $_[0]->imperial_era + $_[0]->Delta;
    }

    1;
}
{
    package MyApp::Syouwa;      # ヘボン式でなくて日本式（決めの問題）

    use Moose;
    # use MooseX::Aliases;
    use MooseX::Types;
    use MooseX::Types::Moose qw(Int);
    use MooseX::ClassAttribute;

    use namespace::clean -except => [qw(meta)];

    # 1ファイルに書く場合use MyApp::Typesが使えないので、便宜的に匿名制約にする
    my $showa_constraint
        = subtype Int,
            where {
                1 <= $_ && $_ <= 64
            };

    # deltaをアトリビュートとして持つなら、ロール側に定義しておいて、
    # クラスにはbuild_deltaというビルダーメソッドを要求するのが良いでしょう。
    class_has 'Delta' => (      # 差分
        is          => 'ro',
        isa         => 'Int',
        init_arg    => undef,
        default     => 1925,
    );

    # isaの制約は元号によって異なります。
    # しかしその制約はロールを消費する側のクラスでしか決められないはず。
    # 従って、元号アトリビュートはロール側でなくクラス側で持つようにします。
    # もしisa => Intだけで良いのなら、ロール側で持てます。
    # その場合のロール名はMyApp::ImperialEraLikeなどなるでしょう。
    # また、エイリアスも元号によって異なるので、traits => [('Aliased')]せずに
    # alias syouwa_era => 'imperial_era';と書かなくてはなりません。
    has 'imperial_era' => (     # 元号
        # traits      => [qw(
        #     Aliased
        # )],
        is          => 'rw',
        isa         => $showa_constraint,
        # alias       => 'syouwa_era',
        lazy_build  => 1,
        trigger     => sub {
            $_[0]->_clear_christian_era;
        },
        clearer     => '_clear_imperial_era',
    );

    {
        no warnings 'once';
        *syouwa_era = \&imperial_era;
    }

    with qw(
        MyApp::HasChristianEra
    );

    sub build_delta {
        return 1925;
    }

    __PACKAGE__->meta->make_immutable;
}

# 以下のテストはサブクラス版と同じ

{
    use Encode;
    use Test::Exception;
    use Test::More;

    my $syouwa = MyApp::Syouwa->new;

    diag encode_utf8('昭和元年');
    $syouwa->syouwa_era(1);
    is $syouwa->christian_era, 1926
        => encode_utf8('西暦1921年');

    diag encode_utf8('西暦1945年');
    $syouwa->christian_era(1945);
    is $syouwa->syouwa_era, 20
        => encode_utf8('昭和20年');

    diag encode_utf8('昭和0年');
    throws_ok {
        $syouwa->syouwa_era(0);
    } qr{Attribute \(imperial_era\) does not pass the type constraint}
        => encode_utf8('西暦1920年でなく、死ぬ');

    diag encode_utf8('昭和65年');
    throws_ok {
        $syouwa->syouwa_era(65);
    } qr{Attribute \(imperial_era\) does not pass the type constraint}
        => encode_utf8('西暦1990年でなく、死ぬ');

    done_testing;
}

era_subclass.pl

#!/usr/local/bin/perl
# sample code snippet to explain circular dependeded attributes (in subclass)
# see http://blog.eorzea.asia/2009/10/post_72.html

use strict;
use warnings;
use utf8;

{
    package MyApp::ImperialEra;

    use Moose;
    use MooseX::ClassAttribute;
    # use MooseX::Aliases;

    use namespace::clean -except => [qw(meta)];

    class_has 'Delta' => (      # 差分
        is          => 'ro',
        isa         => 'Int',
        # builder     => '_build_Delta',    # builderを使うのはいまいち
    );

    # sub _build_Delta {        # いまいち
    #     # confess 'This is abstract method';  # abstract methodには出来ない
    # }

    has 'imperial_era' => (     # 元号
        # ここにtraits => [qw(Aliased)]はできるが、
        # サブクラスでhas '+imperial_era' => (alias => 'syouwa');は不可
        is          => 'rw',
        isa         => 'Int',
        lazy_build  => 1,
        trigger     => sub {
            $_[0]->clear_christian_era;
        },
    );

    has 'christian_era' => (    # 西暦X年
        is          => 'rw',
        isa         => 'Int',
        lazy_build  => 1,
        trigger     => sub {
            $_[0]->clear_imperial_era;
        },
    );

    sub delta {
        confess 'This is abstract method';
    }

    sub _build_imperial_era {
        return $_[0]->christian_era - $_[0]->Delta;
    }

    sub _build_christian_era {
        return $_[0]->imperial_era + $_[0]->Delta;
    }

    __PACKAGE__->meta->make_immutable;
}
{
    package MyApp::Syouwa;      # ヘボン式でなくて日本式（決めの問題）

    use Moose;
    # use MooseX::Aliases;
    use MooseX::ClassAttribute;
    use MooseX::Types;
    use MooseX::Types::Moose qw(Int);

    use namespace::clean -except => [qw(meta)];

    extends qw(
        MyApp::ImperialEra
    );

    # class_has '+Delta';       # サブクラスでも定義しておかないと駄目

    # sub _build_Delta {        # だったらbuilderを分ける旨味が削がれるので
    #     1925;
    # }

    class_has '+Delta' => (     # ベタにdefaultを設定してしまった方が楽
        default         => 1925,
    );

    # 1ファイルに書く場合use MyApp::Typesが使えないので、便宜的に匿名制約にする
    my $showa_constraint
        = subtype Int,
            where {
                1 <= $_ && $_ <= 64
            };

    has '+imperial_era' => (
        isa         => $showa_constraint,
    );

    # alias syouwa_era => 'imperial_era';
    {
        no warnings 'once';
        *syouwa_era = \&imperial_era;
    }

    __PACKAGE__->meta->make_immutable;
}

# 以下のテストはロール版と同じ

{
    use Encode;
    use Test::Exception;
    use Test::More;

    my $syouwa = MyApp::Syouwa->new;

    diag encode_utf8('昭和元年');
    $syouwa->syouwa_era(1);
    is $syouwa->christian_era, 1926
        => encode_utf8('西暦1921年');

    diag encode_utf8('西暦1945年');
    $syouwa->christian_era(1945);
    is $syouwa->syouwa_era, 20
        => encode_utf8('昭和20年');

    diag encode_utf8('昭和0年');
    throws_ok {
        $syouwa->syouwa_era(0);
    } qr{Attribute \(imperial_era\) does not pass the type constraint}
        => encode_utf8('西暦1920年でなく、死ぬ');

    diag encode_utf8('昭和65年');
    throws_ok {
        $syouwa->syouwa_era(65);
    } qr{Attribute \(imperial_era\) does not pass the type constraint}
        => encode_utf8('西暦1990年でなく、死ぬ');

    done_testing;
}