importメソッドが勝手に生やされて困る場合の対応

また、バージョンあげちゃいました。ので、下記の実装は最新版(0.06)とは若干異なっておりますが、大体同じ感じです。

久々にUtil::Anyのバージョン上げました。
http://search.cpan.org/~ktat/Util-Any-0.05/lib/Util/Any.pm

Util::Anyを継承したモジュール内でPerl6::Export::Attrsを使うと動かなくなるという報告が来たためです。
Perl6::Export::Attrs は、attributeで関数のexportが簡単にできるものです。Util::Anyを継承しつつ、そのモジュール内に、ユーティリティ関数を実装するのに使ったら、こけちゃったってことのようです。
これは、Perl6::Export::Attrs が、呼び出し元にimportメソッドを作成しちゃうせいです。

コードは、以下のような感じですね。

use MyUtil;

use base qw/Util::Any/;
use Perl6::Export::Attrs;

このモジュールを下記のようにして使うと、

use MyUtil qw/list/;

"MyUtil does not export 'list'"というエラーがでてしまったというわけです。
Util::Anyは自身のimportメソッドが呼ばれることを期待しているのですが、継承するモジュールがimportを備えてあると、Util::Anyのimportが呼ばれないので、困ったことになります。

こういう場合は、importメソッドを自分で実装すれば回避できます。

package MyUtil;

use strict;
use base qw/Util::Any/;
use Clone qw/clone/;

BEGIN {
 # () をつけて、Perl6::Export::Attrs の importを呼ばないようにする
 use Perl6::Export::Attrs ();
 no strict 'refs';
 *{__PACKAGE__ . '::MODIFY_CODE_ATTRIBUTES'} = \&Perl6::Export::Attrs::_generic_MCA;
}

our $Utils = clone $Util::Any::Utils;
$Utils->{list} = [
                ['List::Util', '', [qw(first min)]],
               ];

sub import {
 my $pkg = shift;
 my $caller = (caller)[0];

 no strict 'refs';
 # 呼び出しもとから、importメソッドを呼ぶ
 eval "package $caller; $pkg" . '->Util::Any::import(@_);';
 # Util::Any で定義している名前は省く
 my @arg = grep !exists $Utils->{$_}, @_;
 if ((@_ and @arg) or !@_) {
   # 呼び出しもとから、importメソッドを呼ぶ
   eval "package $caller; $pkg" . '->Perl6::Export::Attrs::_generic_import(@arg)';
 }
 return;
}

sub foo :Export(:DEFAULT) {
 return "foo!";
}

1;

って、感じです。上のコードを見てのとおり、実際はimportメソッドだけじゃなくって、
MODIFY_CODE_ATTRIBUTESももらう必要があったりするし、Perl6::Export::Attrsのimportに渡す引数を調節しないといけないので、面倒です。

そういうわけで、Util::Anyの0.05では簡単に継承できるようにしました。
下記が通常の継承。

use Util::Any -Base; # or use base qw/Util::Any/;

Perl6::Export::Attrsを使いたい場合の継承。間違えてたので修正

use Util::Any -Perl6ExportAttrs;

下記のような感じになります。

use strict;
use Util::Any -Perl6ExportAttrs;

use Clone qw/clone/;

our $Utils = clone $Util::Any::Utils;
$Utils->{list} = [
                ['List::Util', '', [qw(first min)]],
               ];

これで、簡単。

コードですが、やってることは単純で、-が付いてたら、継承だなってことで、別の処理をさせます。

sub import {
  my $pkg = shift;
  my $caller = (caller)[0];

  return $pkg->_base_import($caller, @_) if @_ and $_[0] =~/^-\w+$/;

_base_importは下記。

sub _base_import {
  my ($pkg, $caller, @flgs) = @_;
  {
    no strict 'refs';
    push @{"${caller}::ISA"}, __PACKAGE__;
  }

  while (my $flg = shift @flgs) {
    if (lc($flg) eq '-perl6exportattrs') {
      eval "use Perl6::Export::Attrs ();";
      no strict 'refs';
      *{$caller . '::MODIFY_CODE_ATTRIBUTES'} = \&Perl6::Export::Attrs::_generic_MCA;
      *{$caller . '::_use_perl6_export_attrs'} = sub { 1 };
    }
  }
}

呼び出し元のISAに突っ込んだり、MODIFY_CODE_ATTRIBUTEを定義したりします。
また、呼び出し元に、_use_perl6_export_attrs というメソッドを定義していますが、これは、importメソッド内で、
Perl6::Export::Attrsのimportを呼ぶべきかどうかの判断に使うためのメソッドです。

  if ($pkg->_use_perl6_export_attrs) {
    no strict 'refs';
    no warnings;
    my $pkg_utils = ${$pkg . '::Utils'};
    my @arg = defined $pkg_utils ? (grep !exists $pkg_utils->{$_}, @_)
                                 : (grep !exists $Utils->{$_}, @_);
    if ((@_ and @arg) or !@_) {
      eval "package $caller; $pkg" . '->Perl6::Export::Attrs::_generic_import(@arg);';
    }
  }

と、まぁ、こんな感じで、importメソッドが勝手に生やされて困る場合の回避策でした。
他にも、importメソッド生やされちゃうモジュールがあったら、同じように処理しようかなぁと思います。