Re: メソッド呼び出しで継承する

http://d.hatena.ne.jp/fbis/20070816/1187247587

いろいろ試してみたのですが、結局この程度。

sub UNIVERSAL::base {
    my $class = shift;
    local $" = ' '; # ensure 
    eval qq{
        package $class;
        use base qw(@_);
    };
    Carp::croak $@ if $@;
}

evalするのは変わらないのだけど、既に@ISAに入っているののスキップ処理はbase.pmもやってくれてるので不必要ですよ、と。それだけっす＞＜。

どうせならってことで、もっと凶悪に、インスタンスで呼び出したら、そのインスタンスでのみ継承するようなUNIVERSAL::baseを。

package UNIVERSAL::base;
use strict;
use warnings;

sub UNIVERSAL::base {
    ref($_[0]) ? goto &_ref_base : goto &_class_base;
}

sub _class_base {
    my $class = shift;
    local $" = ' '; # ensure 
    eval qq{
        package $class;
        use base qw(@_);
    };
    if($@) {
        require Carp;
        Carp::croak $@;
    }
}

sub _ref_base {
    require Symbol;
    require Scalar::Util;
    my $obj = shift;
    my $class = ref($obj);
    my $pkg = $class . '::_' . Scalar::Util::refaddr($obj);

    _class_base($pkg, $class, @_); # private package inherits original and ...
    no strict 'refs';
    *{$pkg . '::DESTROY'} = sub {
        my $self = shift;
        bless $self, $class; # rebless to original class.
        Symbol::delete_package($pkg);
    };

    bless $obj, $pkg; # rebless to private package.
}

1;

専用の名前空間作って、そこで元クラスと目的のクラス継承しておき、インスタンスをreblessするっていうかなり強引なことに。

一応、

use UNIVERSAL::base;
use Hoge;

my $obj = Hoge->new();
$obj->base('Foo');

ってやると、Hogeクラス自体はFooを継承してないけど、$obj は isa('Hoge')でありつつ、 Fooも継承してます、ってな具合で。

使い道あるんでしょーか・・・