Perl のオブジェクト指向プログラム

man perlobj で Perl オブジエクトの man ページを見ると、Perl のオブジェクト指向プログラムは次の簡潔な３点で実装されています。

1. オブジェクトは bless された単なるリファレンスである。ただし、このリファレンスは自分がどのクラスに属するかを知っている。
2. クラスは単なるパッケージである。たたし、このパッケージはオブジェクトを扱うメソッドを提供している。
3. メソッドは単なるサブルーチンである。ただし、その最初の引数はオブジェクトのリファレンスである。(または、パッケージ名や、クラスメソッドの場合もある。)

たったこれだけの工夫でオブジェクト指向プログラムの利点を利用した様々なプログラムを記述できるのですから驚きです。

Perl の場合はコンストラクターの new メソッドも特別なサブルーチンではありません。名前だって foo のように変えても良いのです。？？？？

連想配列を引数としてとるコンストラクター

前置きはこれくらいにして、コンストラクターが連想配列を引数として受取り、オブジェクトを初期化できるようなプログラムを作ってみましょう。次のようなクラスを作成し、Aclass.pmという名前で保存します。

package Aclass;
sub new {
    my ($class, $initializer) = @_;
    my $self = {};
    bless $self;
    $self->initialize( $initializer );
    return $self;
}

sub initialize {
    my ($self, $initializer) = @_;
    foreach ( keys( %$initializer ) ) {
        $self->{$_} = $initializer->{$_};
    }
}

sub display {
    my $self = shift;
    my @keys = @_ ? @_ : sort keys %$self;
    foreach $key (@keys) {
    print "\t$key => $self->{$key}\n";
    }
}
1;

次にこれをテストするために次のソースを test_aclass.pl という名前で保存します。

#!/usr/bin/perl
use Aclass;
$object = new Aclass( {'ATTRIBUTE_1' => 'hello',
                       'ATTRIBUTE_2' => 'world'} );
$object->display();

これで準備 OK です。次のようにコンソールから入力して試してください。

$ perl test_aclass.pl
        ATTRIBUTE_1 => hello
        ATTRIBUTE_2 => world

コンストラクターに渡した連想配列で、オブジェクトの属性が初期化されました。

年齢計算プログラム

オブジェクトの属性が全てスカラー変数のクラスの場合、Aclass はプロトタイプとして利用することができます。display メソッドは debug 用に使います。オブジェクトの属性の名前と値を全て表示することができます。

そこで、Aclass を利用して、年号表記の生年(月日)から年齢を計算するためのクラス Nengo.pm を次のように作成します。

package Nengo;
sub new {
    my ($class, $initializer) = @_;
    my $self = {};
    $self->{OFFSET} = 0;
    bless $self;
    $self->initialize( $initializer );
    return $self;
}

sub initialize {
    my ($self, $initializer) = @_;
    foreach ( keys( %$initializer ) ) {
        $self->{$_} = $initializer->{$_};
    }
}

sub age {
    my ($self, $year) = @_;
    $ad = $year + $self->{OFFSET};
    $this_year = `date +%Y`;
    chomp($this_year);
    $age = $this_year - $ad;
    print "You were born in $ad, and $age years old this year.\n";
}

sub display {
    my $self = shift;
    my @keys = @_ ? @_ : sort keys %$self;
    foreach $key (@keys) {
    print "\t$key => $self->{$key}\n";
    }
}
1;

次に年齢計算プログラムの本体を age.pl と言う名前で次のように作成します。

#!/usr/bin/perl
use Nengo;
$meiji = new Nengo( { 'OFFSET' => 1867 } );
$taisyo = new Nengo( { 'OFFSET' => 1911 } );
$showa = new Nengo( { 'OFFSET' => 1925 } );
$heisei = new Nengo( { 'OFFSET' => 1988 } );

do {
    print "What year were you born? ";
    $date_of_birth = <STDIN>;
    chomp($date_of_birth);
    ($gengo, $year) = split(/ /,$date_of_birth);
        if ($gengo eq 'm') { $meiji->age($year) }
        elsif ($gengo eq 't') { $taisyo->age($year) }
        elsif ($gengo eq 's') { $showa->age($year) }
        elsif ($gengo eq 'h') { $heisei->age($year) }
}
until ($gengo eq 'exit');

プログラムができたら、コンソールから perl age.pl と入力します。What year were you born? と聞いてきますから、s 29 と年号を表すアルファベット1字とスペースで区切って生まれた年を入力します。結果は生年の西暦と、今年の年齢が表示されます。生年を入力せず、exit と入力するとプログラムが終了します。

$ perl age.pl
What year were you born? s 29
You were born in 1954, and 46 years old this year.
What year were you born? exit

オブジェクト指向プログラムを日曜プログラマーが作ることはあまりないと思います。しかし、このように小さなモジュールを作って遊んでおけば、CPANの膨大なモジュールを利用する際の心理的な垣根が低くなります。モジュールは作るより使う立場に回った方が楽です。

継承

Aclass を少し変えて、引数を $object = new Aclass( Attribute => data, ... );と言うように中括弧を省略できるようにしたものが次の Bclass.pm です。

package Bclass;
sub new {
    my $class = shift;
    my $self = {};
    %$self = @_;
    bless( $self, $class );
    return $self;
}

sub display {
    my $self = shift;
    my @keys = @_ ? @_ : sort keys %$self;
    foreach $key ( @keys ) {
    print "\t$key => $self->{$key}\n";
    }
}
1;

bless 関数が引数を２つとるようになっていますが、これはこのクラスを継承して子クラスを作るための工夫です。この Bclass をテストするために次の test_bclass.pl を作成します。

#!/usr/bin/perl
use Bclass;
$object = new Bclass( TEST=>OK );
$object->display();

コンソールから perl test_bclass.pl と入力してテストすると次のようになります。

$ perl test_bclass.pl 
        TEST => OK

今度はこの Bclass を継承して、年齢計算のためのクラス NengoB.pm を作成します。

package NengoB;
use Bclass;
@ISA = qw( Bclass );
sub age {
    my ($self, $year) = @_;
    $ad = $year + $self->{OFFSET};
    $this_year = `date +%Y`;
    chomp($this_year);
    $age = $this_year - $ad;
    print "You were born in $ad, and $age years old this year.\n";
}
1;

コンストラクターの new メソッドがないのに注目してください。new は親クラスの Bclass から継承します。もうひとつの注目点は、@ISA に 親クラスのリスト(この場合は Bclass )が登録されていることです。親クラスの use 宣言と、@ISA への登録で継承を実装することができます。

それでは新しく作った NegoB クラスのテストをしてみましょう。次の age_B.pl を作成してください。

#!/usr/bin/perl
use NengoB;
$object = NengoB->new( OFFSET=>1925 );
$object->age( 29 );

new メソッドの呼び出し方に注意が必要ですが、Bclass のメソッドを、NengoBのメソッドとして使うことができます。

実行結果は次のようになります。

$ perl age_B.pl 
You were born in 1954, and 46 years old this year.