How can I easily generate a Perl function depending on name of the importing class ?

Question

I want to export a function which depends on name of class where is exported into. I thought that it should be easy with Sub::Exporter but unfortunately the into key is not passed to generators. I have ended up with those ugly example code:

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;

Is there better way how to do it without sacrifice all this rich Sub::Exporter abilities?

Edit: Added Sub::Exporter abilities requirement to question.

Answer 1

You aren't clear how you want to determine the name. If I understand you correctly, this does what you want.

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