어떻게 가져 오기 클래스의 이름에 따라 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 능력 요구 사항이 의문을 제기 할 수 있습니다.

편집 2 : 사용 예제가 추가되었습니다.

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