ほんとのスーパークラス

↓のような感じで他のパッケージにメソッドを生やすってのはよく有る手法なんですが

sub import {
    my $class = shift;
    my $pkg = caller;
    no strict 'refs';
    *{"$pkg\::method"} = \&method;
}

id:hirataraさんの↓で述べられてありますが
http://d.hatena.ne.jp/hiratara/20051205/1133788250

つまり、SUPERで呼ばれるのはどれかと言う話。
昔からよく、SUPERはメッセージを送るオブジェクトに対するスーパークラスだと勘違いしてしまうのだが、
あくまでも現在のパッケージのスーパークラスなんだよねー。

ってのがたまに困る訳です。要はプラグインに定義されたメソッドから呼び出し元のスーパークラスに辿り着けない。しかし辿り着きたい!!
どうしよう!?$pkgの@ISAから親御さんを探そうか、めんどくさい。いや待てCPANにあるんじゃないか?

と思ったらあった。泣ける。
http://search.cpan.org/~chromatic/SUPER/

早速やってみた
こういう構造

.
|-- Foo
|   |-- Base.pm - Fooのスーパークラス
|   `-- Plugin.pm - プラグインでメソッドを生やす
`-- Foo.pm - Foo::Baseのサブクラス

やりたいこと
Foo::Pluginから呼び出し元(Foo)のスーパークラスのメソッドを呼びたい。

コードの内容は以下の通り。
Foo.pm(Foo::Baseを継承してるだけ)

package Foo;

use strict;
use warnings;

use base qw(Foo::Base);
use Foo::Plugin;
1;

Foo/Base.pm(helloメソッドを持ってる)

package Foo::Base;

use strict;
use warnings;

use Perl6::Say;

sub new { return bless {}, shift }

sub hello {
    my $self = shift;
    say "Foo::Base::hello";
}

1;

Foo/Plugin.pm(helloメソッドを提供する)

package Foo::Plugin;

use strict;
use warnings;
use SUPER;
use Perl6::Say;

sub import {
    my $class = shift;
    my $pkg = caller;
    no strict 'refs';
    *{"$pkg\::hello"} = \&hello;
}

sub hello {
    my $self = shift;
    say "Foo::Plugin::hello";
#    $self->SUPER::hello();
    my $super = $self->super('hello');
    $self->$super(@_);
}

1;

で、これが従来(?)の$self->SUPER::hello();だと

Can't locate object method "hello" via package "Foo::Plugin" at Foo/Plugin.pm line 18.

と怒られますと。そこをsuperメソッドに差し替えると大丈夫。

呼び出し側スクリプト

use strict;
use warnings;

use Foo;
use Perl6::Say;

say "## Class Method";
Foo->hello();

say "## Object Method";
my $foo = Foo->new();
$foo->hello();


動かしてみた!

## Class Method
Foo::Plugin::hello
Foo::Base::hello
## Object Method
Foo::Plugin::hello
Foo::Base::hello

うまく行きました。Foo::Pluginの親じゃなくて呼び出し元(Foo)のスーパークラスのメソッドが呼び出されFoo::Base::helloと出力されております。

という訳で困ったらuse SUPERRRRRRRRR!!