Perlが初めての人に教えてあげたいちょっとしたこと

実際のタイトルは「Perlのオブジェクト指向がムズカシイだって？んなバカな。だったらPHPで再現してやんよ！」でございます。

ヘイヘイヘイ。そこの君。Perlのオブジェクト指向が難しいだなんていったい誰が言ったんだい？

Perlのオブジェクト指向ほど、シンプル且つ柔軟なものはないよ！

単なるパッケージ(名前空間)とリファレンス(データ)をblessという関数で紐付けただけのもなんだから。

第一引数に必ず$selfが来るっていうのも結局の話たんなる関数呼び出しとなんら変わらないのだから。

package Foo;

sub new {
    my $class = shift;
    return bless { @_ } , ref $class || $class;
}

sub plus {
    my $self = shift;
    my $int  = shift;
    return $self->{foo} + $int;
}

my $obj = Foo->new( foo => 5 );
print $obj->plus(10);

とどのつまり

my $obj = Foo::new('Foo', foo => 5);
print Foo::plus($obj,10);

って感じで第一引数にオブジェクトやらパッケージ名やらを渡しただけの単なる関数呼び出しに過ぎないのさ！

・・・何々？継承はどうするのかだって？

いい質問だ。

Perlでは継承もものっそい単純な仕組みなんだ。

そのパッケージにその関数が存在しなかったら次のパッケージを見に行く。というのを定義するだけで実現できるんだ！

package Foo;

sub new {
    my $class = shift;
    return bless { @_ } , ref $class || $class;
}

sub plus {
    my $self = shift;
    my $int  = shift;
    return $self->{foo} + $int;
}

package Bar;
our @ISA =('Foo');

my $obj = Bar->new( foo => 5 );
print $obj->plus(10);

この@ISAという配列にFooというパッケージ名を突っ込んでおくだけ。

こうすればplus関数を呼び出した際にBarにplusがあるかどうかを確認し、なければ@ISAに登録されているFooにplusがあるかどうかを確認する。

Perlの継承とはたったコレだけのものなんだ！凄いよね！簡単簡単！

他の言語ではこれらの処理ってのは基本的に言語仕様として隠蔽されている。

blessなんてものはPHPとかなら「new Foo」で勝手にやってくれるし、$selfだってPHPなら$this、Rubyならselfといったように予め用意されている。

Perlの場合はそれらを全部自分で用意するからややこしいように思われてるけどClass::Accessorや今だとMooseなんかを使えば楽に書けるようになるしな〜んにも難しいことなんか無いんだよ！

え？それでもよくわからないし、ムズカシイだって？

そこまで言うなら僕がPHPでPerlのオブジェクトシステムを再実装してみるよ！いかに簡単であるかってことを証明するぜ！

<?php

class Poop {
    
    function ref ($obj) {
        if ( strpos($obj,':') ) return array_shift(split(':',$obj));
        return $obj;
    }
    
    function & call ($obj,$method,$args=array()) {
        return Poop::_call($obj,Poop::ref($obj),$method,$args);
    }
    
    function & _call ($obj,$class,$method,$args=array()) {
        $original_method = $method;
        $call = Poop::_isa_call($class,$method,Poop::base($class));
        if ( is_null($call) ) {
            $class = Poop::ref($obj);
            trigger_error("Can't locate object method \"$method\" via class \"$class\"",E_USER_ERROR);
        }
        list($class,$method) = $call;
        
        $param = array($obj);
        if ( $method === 'AUTOLOAD' ) $param []= $original_method;
        if ( count($args) )           $param = array_merge($param,$args);
        $ret = call_user_func_array(array($class,$method),$param);
        return $ret;
    }
    
    function _isa_call ($class,$method,$isa=array()) {
        if ( is_callable(array($class,$method)) ) return array($class,$method);
        if ( is_callable(array($class,'AUTOLOAD')) ) return array($class,'AUTOLOAD');
        if ( !count($isa) ) return null;
        foreach ( $isa as $item ) {
            $ret = Poop::_isa_call($item,$method,Poop::base($item));
            if ( !is_null($ret) ) return $ret;
        }
        return null;
    }
    
    function create ($class) {
        static $ch;
        if ( !$ch ) $ch = array_merge(range('A','Z'),range('a','z'),range('0','9'));
        $address = '';
        for ( $i = 0; $i < 32; $i++ ) {
            $address .= $ch[array_rand($ch)];
        }
        return $class.':'.$address;
    }
    
    function super ($obj,$method,$args=null) {
        $class = Poop::ref($obj);
        $isa   = Poop::base($class);
        if ( !count($isa) ) {
            trigger_error("Can't locate object method \"$method\" via class \"$class\"",E_USER_ERROR);
        }
        return Poop::_call($obj,array_shift($isa),$method,$args);
    }
    
    function bless ($data,$class) {
        $address = Poop::create($class);
        $member  =& Poop::member($address);
        $member  = $data;
        return $address;
    }
    
    function & member ($address,$member=null) {
        static $_object_data = array();
        if ( empty($_object_data[$address]) ) $_object_data[$address] = array();
        if ( is_null($member) ) {
            return $_object_data[$address];
        }
        if ( empty($_object_data[$address][$member]) ) {
            $null = null;
            return $null;
        }
        return $_object_data[$address][$member];
    }
    
    function & base ($target,$base=null) {
        static $_isa = array();
        if ( empty($_isa[$target]) ) $_isa[$target] = array();
        if ( !is_null($base) ) {
            $_isa[$target] = array_merge($_isa[$target],(array)$base);
        }
        return $_isa[$target];
    }
}

その名もPoop。

Poopといっても疲れたとかそっち系の意味でなくてPerl Object Oriented Programmingの略ね。

class宣言してるけどこれはあくまで名前空間としての役割が必要だったから使ってるだけでPHP本来のオブジェクトシステムは一切使ってないのでそこんとこヨロシク。

Perlで書いたさっきの処理をこのPoopを使って実装してみるよ！

<?php

require_once 'Poop.class.php';

class Foo {
    function new_ ($class,$args=array()) {
        return Poop::bless( $args , Poop::ref($class) );
    }
    
    function plus ($self,$int) {
        return Poop::member($self,'foo') + $int;
    }
}

class Bar {}
Poop::base('Bar',array('Foo'));

$obj = Poop::call('Bar','new_',array( array( 'foo' => 5 ) ));
print Poop::call($obj ,'plus',array(10));

うわー自分でbless！引数に$selfが！継承も再現！SUPERやAUTOLOADまで実現！PHPなのにMixinもお手の物！おー、まさにPerl！

# ちなみにnew_にしているのはnewだと構文エラーになるからデツ・・・。

たったの100行未満のプログラムでPerlのオブジェクトシステムが実装。# 細かいことを言えば全然機能が足りてませんが・・・＞＜

ほら？ね？ね？簡単でしょ？

だからほら、PerlやろうよPerl。もしくはPoop使おうよPoop。

このPerlの柔軟なオブジェクトシステムをPHPでも使えるなんて！

ってことでPerlのオブジェクト指向は簡単だよってお話でした。（ぉ）