Perl でオブジェクト指向 C++風

Perl でオブジェクト指向っぽいコードを書こうとすると、一つの「パッケージ」の中に複数の「クラス」が存在するとき、「パッケージ」でインポートしたはずの関数などが、「クラス」内で使えないことが不満だった。かといってすべて「パッケージ」にするのはちょっとしたシミュレーションを作るときなどに不便である。BEGIN や import、eval、Exporter などを組み合わせてなんとかできないかと試したところ、そこそこ満足できる解を見つけた。

最初に断っておくが、私は「プロ」プログラマではないため、Perl も C++ もオブジェクト指向も、知識が不十分の半可通である。また、タイトルではわかりやすさを重視して「C++風」と書いたが、単に最初に書いたように「クラス」内でいちいち use せずに「パッケージ」で一活して use したいというだけの話である。

■

失敗例

どういうことがやりたいかを説明するために、まず失敗例を書こう。

#!/usr/bin/perl

use strict;
use warnings;
use utf8;

use Math::Trig; # for pi
use Storable qw(dclone);

our $DEBUG = 0;

{
  package Simple;

  our $template = {};

  sub new {
    my $class = shift;
    my $obj = dclone($template);
    bless $obj, $class;
    return $obj;
  }
}


{
  package A;
  use base qw(Simple);

  our $template = {data => 0.0};

  sub method_1 {
    my $self = shift;
    my ($arg1) = @_;
    $self->{data} = $self->{data} + pi / $arg1;
    return $self->{data};
  }
}

{
  package B;
  use base qw(Simple);

  our $template = {data => 1.0};

  sub method_1 {
    my $self = shift;
    my ($arg1) = @_;
    $self->{data} = $self->{data} + pi / $arg1;
    return $self->{data};
  }
}

MAIN: {
  my $a = A->new();
  my $b = B->new();

  print $a->method_1(7.0) . "\n";
  print $b->method_1(7.0) . "\n";
}

以上を実行するとエラーが出る。

$ perl example_oo_0.pl
Bareword "pi" not allowed while "strict subs" in use at /cygdrive/c/home/tahi/doc/blog/archive/example_oo_0.pl line 35.
BEGIN not safe after errors--compilation aborted at /cygdrive/c/home/tahi/doc/blog/archive/example_oo_0.pl line 42.

「クラス」A の中でも pi を使いたいが、Perl のパッケージシステムはそのようなことをするためには、「クラス」ごとに use を指定する必要があるようだ。

(一応断っておくと、変数ではそのような意図がうまく機能するものがあり、上のコードの $DEBUG は「クラス」 A 内からも参照できる。)

いろいろ試した結果、package は一度閉じたあともう一度開いたときに、前開いたときに use したものを覚えていることがわかった。この性質を使い、やっていることはキタナイがコードはそれなりに美しく書けて、意図を実現したのが次のコードである。(なお、リンク先のコードでは、もう少しコメントを増やしたり、コンストラクタの例を足したりしている。)

#!/usr/bin/perl

use strict;
use warnings;
use utf8;

BEGIN {
  my @mypackage = qw(
                    Main
                    Main::_Simple
                    Main::_A
                    Main::_B
                 );
  foreach my $p (@mypackage) {
    eval <<"EOM"; # eval the string til "End Of Macro".
    {
      package $p;
      use Math::Trig; # for pi
      use Storable qw(dclone);
    }
EOM
    die $@ if $@; # check error of eval.
  }
}

package Main;

our $DEBUG = 0;

{
  package Main::_Simple;

  my %template = ("Main::_Simple" => {});

  sub extend_template {
    my $class = shift;
    my @hash = @_;
    if (exists $template{$class}) {
      $template{$class} = {%{$template{$class}}, @hash} if @hash;
    } else {
      $template{$class} = 
        {(map {
                $_->extend_template() if ! exists $template{$_};
                %{$template{$_}};
              } (eval '@{' . $class . '::ISA}')),
         @hash
        };
    }
    return $template{$class};
  }

  sub get_template {
    my $class = shift;
    return $class->extend_template();
  }

  sub new {
    my $class = shift;
    my $obj = dclone($class->get_template());
    bless $obj, $class;
    return $obj;
  }
}


{
  package Main::_A;
  use base qw(Main::_Simple);

  __PACKAGE__->extend_template
    (
     ## 以下に基礎となる structure を書く。

     data => 0.0, # ここに data の説明を書こう！
     data2 => 2.0, # ここに data2 の説明を書こう！
    );

  sub method_1 {
    my $self = shift;
    my ($arg1) = @_;
    $self->{data} = $self->{data} + pi / $arg1;
    return $self->{data};
  }
}

{
  package Main::_B;
  use base qw(Main::_Simple);

  __PACKAGE__->extend_template
    (
     data => 1.0, # ここに data の説明を書こう！
    );

  sub method_1 {
    my $self = shift;
    my ($arg1) = @_;
    $self->{data} = $self->{data} + pi / $arg1;
    return $self->{data};
  }
}

## 下の MAIN: はラベルで、特に必要はない。私のクセ。

MAIN:
{
  my $a = Main::_A->new();
  my $b = Main::_B->new();

  print $a->method_1(7.0) . "\n";
  print $b->method_1(7.0) . "\n";
}

実行結果は次のようになる。

$ perl example_oo.pl
0.448798950512828
1.44879895051283

では、成功したほうのコードを少し解説しよう。

まず、「クラス」の名前が変わっているが、これは重要ではなく、 Main::_Simple, Main::_A, Main::_B を、それぞれ元の Simple, A, B に書き換えてもらっても動く。この名前にした理由は、後に「パッケージ」を別のファイルにするときなどの拡張性を考慮したためである。Perl の「パッケージ」にはよくサブパッケージを作ることが多いので、それと「クラス」を区別するため、アンダースコア "_" を付けた。

(さらにローカルな「クラス」を区別する需要は Perl プログラマには少ないとは思うが、その場合は二重のアンダースコアを使い "SomeModule::__LocalClass" などとすればよいのではないか。)

BEGIN 節の中は、すべての「クラス」を一度開いて、その中でいちいち use をして、「クラス」を閉じるという作業をループでしているだけである。 package は bareword しか取らないので、eval を使う必要がある。

use を書くのは一度で良いので、目的は達成されていると思うが、難点があるとすれば、こういう書き方なので eval 内の use にエディタのハイライトが効かないという点が挙げられる。

もちろん、速度的な問題は考慮していない。(^^;

あと、メイントピックからは外れるが、先の失敗例で $template へ格納されるのは「メンバ変数」たるべき structure を意図している。しかし、our のスコープは記述されたパッケージによるので、クラス A からクラス Simple の new が呼ばれても、そこで読まれる $template は、クラス Simple で our で指定したものにしかならない。……まぁ、この説明ではわからないかもしれないが、とにかく、C++ 風に、SUPER な new が子の「メンバ変数」を初期化できるよう、成功例では HASH テーブルを用いて実装している。

■

関連 ● example_oo_pl.shar。上で「次のコード」と示したサンプルやその他の例をまとめたアーカイブ。(シェルアーカイブ形式。シェルコマンドとして実行するか unshar を使う。) ● 《perltoot - トムによるPerlオブジェクト指向チュートリアル》。基本文書。 ● 《いま Perl で一番イケてるオブジェクト指向プログラミングを学ぶ - bricklife.weblog.》。同じようなことを考えている人はいると思うのだが、私には見つからなかった。本とか読んでないし。このサイトで示されているソースを読めば、そういう例があるのかな？調べていない。 ● 《Perlオブジェクト基礎文法最速マスター - 燈明日記》。仕組みから説明していて、コメント欄にはカプセル化をするためのモジュールも紹介されている。

更新：	2010-12-31--2011-01-01
初公開：	2010年12月31日 09:42:55
最新版：	2011年01月07日 14:22:34