UNIVERSAL::can なんてあるのね
UNIVERSAL::can はなにをするもんかというと、それを use したクラスに can というメソッドを定義すれば、そのクラスのインスタンスに対して $instance->can('hoge') ってやると、そのクラスに定義した can が使われるというものだそうで、これを上手く上記の問題に照らし合わせると。。。
B というクラスで、
sub can { $_[1] eq 'foo' ? undef : UNIVERSAL::can($_[0], $_[1]) }という風に can を定義しておけば、やりたいことができるんじゃないかと。
テストコードの全容は下記のような感じです。これを実行すると $b->can('foo') は false なので sub foo { warn "foo" } は実行されず、$b->can('bar') はコードリファレンスが返されるので sub bar { warn "bar" } が実行されます。
#!/usr/local/bin/perl use strict; package a; sub new { bless {}, shift } sub foo { warn "foo" } sub bar { warn "bar" } package b; use base qw(a); use UNIVERSAL::can; sub can { $_[1] eq 'foo' ? undef : UNIVERSAL::can($_[0], $_[1]) } package main; my $b = b->new; $b->can('foo') && $b->can('foo')->(); $b->can('bar') && $b->can('bar')->();これ他にやりかたあるんだろうか…。ちなみに、普通の can は perldoc UNIVERSAL とやると説明が書いてあるというのも初めて知りました。。。
追記
コメントにありますが、当初やりたかったことは B のクラスに sub can {} を定義してやれば $b->can() って呼んでやるのであれば解決するという結論になりました。UNIVERSAL::can() を使う場合には UNIVERSAL::can モジュールを use してやる必要があるようです。