インポートするクラスの名前に応じて、Perl関数を簡単に生成する方法はありますか？

Question

輸出先のクラス名に依存する関数をエクスポートしたい。 Sub::Exporterで簡単にできるはずだと思いましたが、残念ながらintoのキーはジェネレータに渡されません。

use strict; 
use warnings; 

package MyLog; 

use Log::Log4perl qw(:easy get_logger); 

use Sub::Exporter -setup => { 
    exports => [ 
     log  => \&gen_log, 
     audit_log => \&gen_log, 
    ], 
    groups  => [ default => [qw(log audit_log)] ], 
    collectors => ['category'], 
    installer => \&installer, # tunnel `into` value into generators 
}; 

if (not Log::Log4perl->initialized()) { 

    #easy init if not initialised 
    Log::Log4perl->easy_init($ERROR); 
} 

sub gen_log { 
    my ($class, $name, $arg, $global) = @_; 

    my $category = $arg->{category}; 
    $category = $global->{category}{$name} unless defined $category; 

    return sub { # return generator 
     my $into = shift; # class name passed by `installer` 

    $category = $name eq 'audit_log' ? "audit_log.$into" : $into 
     if !defined $category; # set default category 

     # lazy logger 
     my $logger; 
     return sub { 
      $logger or $logger = get_logger($category); 
     }; 
    }; 
} 

sub installer { 
    my ($args, $todo) = @_; 

    # each even value is still generator thus generate final function 
    my $i; 
    1 & $i++ and $_ = $_->($args->{into}) for @$todo; 

    Sub::Exporter::default_installer(@_); 
} 

1; 

はすべてこの豊かなSub::Exporter能力犠牲にすることなく、それを行うにはどのように良い方法はあります：私はそれらの醜いコード例になってしまったのか？例えば

私はそれらのいずれかを使用したいと思います：

use MyLog category => { log => 'foo', audit_log => 'bar' }; 

use MyLog -default => { -prefix => 'my_' }; 

use MyLog 
    audit_log => { -as => 'audit' }, 
    log  => { -as => 'my_log', category => 'my.log' }; 

編集：質問へ追加しましたSub::Exporter能力要件。

Edit2：使用例を追加しました。

Answer 1

名前の決定方法が明確ではありません。私があなたを正しく理解するなら、これはあなたが望むことをします。

my %sub_for = (
    foo => \&foo, 
    #... 
); 

sub install_as { 
    my ($package, $exported_name, $sub) = @_; 
    no strict 'refs'; 
    *{"$package\::$exported_name"} = $sub; 
    return; 
} 

sub get_name_for { 
    my ($package, $name) = @_; 
    #... your code here 
} 

sub import { 
    my $class = shift; 
    my $package = caller; 
    for my $internal_name (@_) { 
     install_as($package, get_name_for($package, $internal_name), $get_sub_for{$name}); 
    } 
    return; 
}