Как я могу легко сгенерировать функцию 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;
}