如何根据导入类的名称轻松生成Perl函数?

时间:2009-02-27 17:07:23

标签: perl export generator

我想导出一个函数,该函数取决于导出到的类的名称。我认为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 :添加了用法示例。

1 个答案:

答案 0 :(得分:2)

您不清楚如何确定名称。如果我理解正确,这就是你想要的。

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;
}