Class::Std

Perl

個人で開発している場合は、Class::Accessor や Class::MethodMaker で十分だと思うが、チームで開発する場合は、積極的に Class::Std を使っていこうと思う。

基本的な概念

package HOGE;

use strict;
use warnings;

use Class::Std;

{
    # Attributes
    my %name_of :ATTR( :name<name> );
    my %age_of  :ATTR( :name<age> );
}

1;

Class::Std を使う場合、無名 Hash のリファレンスではなく、無名 Scalar のリファレンスが bless される。

Attribute にアクセスする場合、従来の Hash リファレンスを bless する形式では、Class の利用者が自由に Attribute にアクセスできたり、勝手に新しい Attribute を追加できてしまうので、情報の隠蔽ができない。

my $obj = HOGE->new;
$obj{'fuga'} = q{aaaa};

無名 Scalar のリファレンスを bless した場合、package 内で my 宣言された Hash を Attribute として利用する。
class 内でのデータへのアクセスは、ident を使用する。

    sub say_name {
        my ($self) = @_;
        print $name_of{ident $self};
    }

ident は、Class::Std を use した時点で Export されている。
ident によって $self はシリアライズされ、Hash へのアクセス時のユニークキーとなる。
class 外から Attribute は、method を経由する以外にアクセスができないので、情報の隠蔽ができる。

ATTR について

ATTR を使うと、new での Attribute 初期化や、DESTORY での Attribute 削除を記述する必要がない。
また、下記のように記述する事で、setter や getter も定義される。

{
    # Attributes
    my %name_of :ATTR( :name<name> );
    my %age_of  :ATTR( :name<age> );
}

アクセス方法は、下記の通り。

my $obj = HOGE->new( {name => 'cooldaemon', age => 28} );
$obj->set_age( 29 );
print $obj->get_age;

:name を使った Attribute は、new を呼び出す際に初期値を設定しないと実行時にエラーとなる。
そこで、下記のように個別に定義する事も可能。

{
    # Attributes
    my %name_of :ATTR( :name<name> :default('cooldaemon') );
    my %age_of  :ATTR( :name<age> :default(29) );
}

:default で初期値の設定を行った場合は、エラーとならない。
（複数の設定を連続して記述する事が可能）

getter、setter、new 呼び出し時の引数をそれぞれ個別に定義も可能。

getter だけ定義
    my %age_of :ATTR( :get<age> );

:get を使用する。
が getter の名前を指定する場所であり、上記例では としているので、get_age という getter が定義されている事となる。

setter だけ定義
    my %age_of :ATTR( :set<age> );
new の時の引数だけ定義
    my %age_of :ATTR( :init_arg<age> );

こうすると、下記のように利用できる。

my $obj = HOGE->new( {age => 18} );


:ATTR( :name ) は、:ATTR( :init_arg :get :set ) と同じ。

ATTRS について

    my %name_of :ATTR;
    my %age_of  :ATTR;

上記は、下記に置き換える事が可能。

    my (
        %name_of,
        %age_of,
    ) :ATTRS;

_DUMP について

_DUMP を呼ぶと、現在の ATTR の状態を Data::Dumper っぽい文字列を返す。
method 名に '_' が付いているが、PRIVATE 宣言されているわけではない。

my $obj = MtClass->new;
warn $obj->_DUMP;

上記のような感じで、下記のような現在の Attribute の値を表示する事ができる。

{
  'MyClass' => {
                 'age' => 29
               },
  'MyClassBase' => {
                     'name' => 'cooldaemon'
                   },
  'MyClassBase2' => {
                      'sex' => 'man'
                    }
};

BUILD、DEMOLISH、START について

無名 Scalar のリファレンスを bless する手法を用いる場合、new では Attribute の初期化を行い、 DESTROY では Attribute を delete する必要がある。
この処理は、Class::Std に任せてしまうのが楽だが、new や DESTROY で Attribute 関連以外の処理を入れたい場合や、Attribute 関連の処理の挙動を変更したい場合もある。
そこで、利用するのが、BUILD、DEMOLISH、START。

実行される順番

オブジェクト生成時は、「BUILD → Attributeの初期化 → START 」の順。
オブジェクト破壊時は、「DEMOLISH → Attributeの削除」の順。

継承した場合は、継承元の親クラスから順番に再帰的に実行される。

例えば・・・

package MyClassBase;

use strict;
use warnings;

use Class::Std;

{
    # Attributes
    my %name_of : ATTR( :name<name> );

    # Methods
    sub BUILD {
	my ($self, $ident, $arg_ref) = @_;
	print "MyBaseClass BUILD?n";
    }

    sub DEMOLISH {
	my ($self, $ident) = @_;
	print "MyBaseClass DEMOLISH?n";
    }

    sub START {
	my ($self, $ident, $args_ref) = @_;
	print "MyBaseClass START?n";
    }
}

1;
package MyClassBase2;

use strict;
use warnings;

use Class::Std;

{
    # Attributes
    my %sex_of : ATTR( :name<sex> );

    # Methods
    sub BUILD {
	my ($self, $ident, $arg_ref) = @_;
	print "MyBaseClass2 BUILD?n";
    }

    sub DEMOLISH {
	my ($self, $ident) = @_;
	print "MyBaseClass2 DEMOLISH?n";
    }

    sub START {
	my ($self, $ident, $args_ref) = @_;
	print "MyBaseClass2 START?n";
    }
}

1;
package MyClass;

use strict;
use warnings;

use base qw(MyClassBase MyClassBase2);

use Class::Std;

{
    # Attributes
    my %age_of : ATTR( :name<age> );

    # Methods
    sub BUILD {
	my ($self, $ident, $arg_ref) = @_;
	print "MyClass BUILD?n";
    }

    sub DEMOLISH {
	my ($self, $ident) = @_;
	print "MyClass DEMOLISH?n";
    }

    sub START {
	my ($self, $ident, $args_ref) = @_;
        print "MyClass START?n";
    }
}

1;
use strict;
use warnings;

use MyClass;

my $obj = MyClass->new({
    name => q{cooldaemon},
    sex  => q{man},
    age  => 29,
});

これで、下記のような出力結果となる。

MyBaseClass BUILD
MyBaseClass2 BUILD
MyClass BUILD

MyBaseClass START
MyBaseClass2 START
MyClass START

MyClass DEMOLISH
MyBaseClass DEMOLISH
MyBaseClass2 DEMOLISH

上記で利用した class の親子関係は下記の通りだったが・・・

MyClassBase MyClassBase2
         |   |
        MyClass

下記のような親子関係を作ると・・・

MyClassBase MyClassBase2
         |   |       |
        MyClass    MyClass2
             |       |
           MyClassChild

下記のような出力結果となる。

MyBaseClass BUILD
MyBaseClass2 BUILD
MyClass BUILD
MyClass2 BUILD
MyClassChild BUILD

MyBaseClass START
MyBaseClass2 START
MyClass START
MyClass2 START
MyClassChild START

MyClassChild DEMOLISH
MyClass DEMOLISH
MyClass2 DEMOLISH
MyBaseClass DEMOLISH
MyBaseClass2 DEMOLISH
BUILD

パラメータは「my ($self, $ident, $arg_ref) = @_;」のように受け取る。
$ident には、「ident $self」の結果が入っているので、「$name_of{ident $self}」と書く所を「$name_of{$ident}」と書ける（個人的には「sub _ident { ident shift }」とか定義しとけば良い気がする。気が向いたら作者様にメールを・・・）。
$arg_ref には、new に引数として渡したパラメータが入っている。

Attributeの初期化処理の前に実行されるが、BUILD 内で初期化された Attribute は、Attributeの初期化処理の段階では無視される。（BUILD の設定値が最優先）
Attributeの初期化処理は、内部で、下記のような感じになっている。

$name_of{$ident} = $args->{name} if defined $args->{name};

例えば

package MyClassBase;

use strict;
use warnings;

use Class::Std;

{
    # Attributes
    my %name_of : ATTR( :name<name> );

    # Methods
    sub BUILD {
        my ($self, $ident, $arg_ref) = @_;
        $name_of{$ident} = q{cooldaemon};
    }
}

1;

このように記述すると、new 呼び出し時に、どのような値を設定しても、必ず name の値は 'cooldaemon' となる。
また、「$name_of{$ident} = q{cooldaemon};」の箇所を「$name_of{$ident} = q{};」と変更すると、必ず空文字列となる。

BUILD の使いどころは、Params::Validate と組み合わせて Attribute の初期化値のパラメータチェックとかかな？

START

BUILD は Attribute の初期化処理の前であるのに対し、START は Attribute の初期化処理の後で呼ばれる。
初期化処理後であるでの、Attribute に既に値が入った状態となっている。
引数は、BUILD と同じ形式。

DEMOLISH

Attribute の削除(DESTORY)の寸前に呼ばれる。
使いどころは、オブジェクトを破棄する為の処理等。(例えば、DB の disconnect とか )
引数は、BUILD と同じ形式。

AUTOMETHOD について

Class で定義されていない method が呼ばれた場合、AUTOMETHOD が呼ばれる。
AUTOMETHOD が無名サブルーチンを返すと、その無名サブルーチンが呼ばれた事となる。

下記のような Class を定義した場合・・・

package Automethod;

use Class::Std;
{
    my %entries_of : ATTR;

    sub AUTOMETHOD {
	my ($self, $ident, $value) = @_;
	my $method_name = $_;

	my ($mode, $name) = $method_name =~ m/?A ([gs]et|say)_(.*) ?z/xms
	    or return sub{};

	return
	      $mode eq 'get' ? sub{ $entries_of{$ident}->{$name} }
	    : $mode eq 'set' ? sub{ $entries_of{$ident}->{$name} = $value }
	    : $mode eq 'say' ? sub{ print $entries_of{$ident}->{$name}, "?n" }
	    :                  sub{}
	    ;
    }
}

1;

下記のように使える。

use Automethod;

my $obj = Automethod->new;
$obj->set_name( 'cooldaemon' );
print $obj->get_name(), "?n";
$obj->say_name();

$obj->set_age( 29 );
print $obj->get_age(), "?n";
$obj->say_age();

出力は下記の通り。

cooldaemon
cooldaemon
29
29

:PRIVATE について

method の定義に付加する事で、Class 外からのアクセスを禁止する。

下記のような Class を定義した場合・・・

package Private;

use Class::Std;
{
    my %name_of : ATTR( :name<name> );

   sub _print_name : PRIVATE {
	my ($self) = @_;
	print $name_of{ident $self}, "?n";
    }

    sub say_name {
	my ($self) = @_;
	$self->_print_name;
    }
}

1;

下記のように使うと・・・

use Private;
my $obj = Private->new({ name => 'cooldaemon' });
$obj->say_name;
$obj->_print_name;

下記の出力となる。

cooldaemon
Can't call private method Private::_print_name() from class main at private.pl line 5

「say_name」で 'cooldaemon' が表示されているが「_print_name」で例外が発生している。

:PRIVATE は、派生先の Class からも呼ぶ事を禁止する。

package PrivateChild;

use base qw(Private);

use Class::Std;
{
    sub say_name_child {
	my ($self) = @_;
	$self->_print_name;
    }
}

1;

上記の Class の Method 「say_name_child」を呼ぶと 「$self->_print_name」で例外が発生する。

:RESTRICTED について

:PRIVATE 同様に Class 外からのアクセスを禁止するが、:PRIVATE とは異なり、派生クラスからのアクセスは許可する。

下記のような使い方をすると・・・

package Restricted;

use Class::Std;
{
    my %name_of : ATTR( :name<name> );

   sub _print_name : RESTRICTED {
	my ($self) = @_;
	print $name_of{ident $self}, "?n";
    }

    sub say_name {
	my ($self) = @_;
	$self->_print_name;
    }
}

1;
package RestrictedChild;

use base qw(Restricted);

use Class::Std;
{
    sub say_name_child {
	my ($self) = @_;
	$self->_print_name;
    }
}

1;
use RestrictedChild;

my $obj = RestrictedChild->new({ name => 'cooldaemon' });
$obj->say_name_child;
$obj->_print_name;

下記の出力となる。

cooldaemon
Can't call restricted method Private::_print_name() from class main at private.pl line 5

RestrictedChild の「say_name_child」内では、:PRIVATE と異なり例外が発生しいないので、'cooldaemon' が表示されているが「_print_name」で例外が発生している。

:CUMULATIVE について

:CUMULATIVE

method の定義に付加する事で、オーバーロードした method を再帰的に呼び出す。
例えば、下記のような Class を定義し・・・

package CumulativeBase;

use Class::Std;
{
    sub say :CUMULATIVE {
        print __PACKAGE__, "?n";
        return __PACKAGE__;
    }
}

1;
package CumulativeBase2;

use Class::Std;
{
    sub say :CUMULATIVE {
        print __PACKAGE__, "?n";
        return __PACKAGE__;
    }
}

1;
package Cumulative;

use Class::Std;
use base qw(CumulativeBase CumulativeBase2);
{
    sub say :CUMULATIVE {
        print __PACKAGE__, "?n";
        return __PACKAGE__;
    }
}

1;

下記のような Script を実行すると・・・

use Cumulative;

my @results = Cumulative->new->say;
print "========?n"
for ( @results ) {
    print "$_?n"
}

下記のような出力となる。

Cumulative
CumulativeBase
CumulativeBase2
========
Cumulative
CumulativeBase
CumulativeBase2

戻り値もリスト型にスタックして戻す事ができる点に注意。

ちなみに・・・
Cumulative::say から:CUMULATIVE を削除すると、再帰的に呼ばれない
CumulativeBase::say から:CUMULATIVE を削除すると、CumulativeBase::say のみ呼ばれない
となる。

上記の例では親子関係は下記の通りだったが・・・

CumulativeBase CumulativeBase2
            |    |
          Cumulative

下記のような親子関係を作って say を呼び出してみると・・・

CumulativeBase CumulativeBase2
            |    |         |
          Cumulative     Cumulative2
                 |         |
               CumulativeChild

下記のような出力結果となる。

CumulativeChild
Cumulative
Cumulative2
CumulativeBase
CumulativeBase2
========
CumulativeChild
Cumulative
Cumulative2
CumulativeBase
CumulativeBase2
:CUMULATIVE(BASE FIRST)

:CUMULATIVE(BASE FIRST) は :CUMULATIVE とは逆に BaseClass から順番に method を呼ぶ。

:CUMULATIVE の例で利用した Class の :CUMULATIVE を :CUMULATIVE(BASE FIRST) に置換し
:CUMULATIVE の例で利用した Script を実行すると下記の出力となる。

CumulativeBase
CumulativeBase2
Cumulative
========
CumulativeBase
CumulativeBase2
Cumulative

:CUMULATIVE と :CUMULATIVE(BASE FIRST) を混ぜて使うと、下記のような例外が発生する。

Conflicting definitions for cumulative method 'say'
(specified as :CUMULATIVE in class 'Cumulative'
 but declared :CUMULATIVE(BASE FIRST) in class  'CumulativeBase')

:CUMULATIVE と同じように・・・
Cumulative::say から:CUMULATIVE(BASE FIRST) を削除すると、再帰的に呼ばれない
CumulativeBase::say から:CUMULATIVE(BASE FIRST) を削除すると、CumulativeBase::say のみ呼ばれない
となる。

下記、そのうち書こうと思うので、項目だけメモ。

overload について

:STRINGIFY
:NUMERIFY
:BOOLIFY
:SCALARIFY
:ARRAYIFY
:HASHIFY
:GLOBIFY
:CODIFY