如何根据导入类的名称轻松生成 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;
}