Exporter代わり

ある関数を書いたんだけど即必要なくなってしまったのでここに晒す。
まぁ今時Exporterなんて使うよりクラスにして
インスタンスからアクセスしろよって感じかもしれないけど
たまに($selfを取らない)ユーティリティサブルーチンを詰め込んだパッケージを作るときなんかは有効かもしれない。

package Foo;

use strict;
use warnings;

our $scalar = 'scara-';
our @array  = qw(are-);

sub puts {
    print @_, "\n";
}


sub import {
    shift;    # this package name
    my $exported_pkg = caller;
    my %sigil2ref = (
        '$' => 'SCALAR',
        '@' => 'ARRAY',
        '%' => 'HASH',
        '&' => 'CODE',
        '+' => 'IO',
    );

    for my $symbol (@{[ @_ ]}) {
        my $refname;
        my $sigil = substr $symbol, 0, 1;
        if (exists $sigil2ref{$sigil}) {
            # e.g.: $symbol, @array, &subname, ...
            $refname = $sigil2ref{$sigil};
            $symbol = substr $symbol, 1;
        } else {
            # e.g.: symbol, foo, bar
            $refname = 'GLOB';    # import all symbols.
        }

        # print "exporting $symbol to ${exported_pkg}::$symbol\n";
        no strict 'refs';
        *{"${exported_pkg}::$symbol"} = *{$symbol}{$refname};
    }
}


1;

使う側

package main;

use strict;
use warnings;

use Foo qw($scalar @array &puts);


puts $scalar;    # scara-
puts @array;    # are-

use Foo qw(*glob);
とかやればglobのシンボルを全てエクスポートする。

で、何故これが不必要になったかというと、
シンボルを選んでエクスポートするよりも、
パッケージ内の全てのサブルーチンをエクスポートした方がいいなと思ったのでそうしてみた。
こんな感じ。(引用元)

package HWW::UtilSub;

use strict;
use warnings;
use utf8;

use base qw(Exporter);

# export all subroutine.
our @EXPORT = do {
    no strict 'refs';
    grep { *$_{CODE} } keys %HWW::UtilSub::;
};

これでHWW::UtilSub内の全てのサブルーチンをエクスポートできる。

追記：
忘れてた。
あと上の関連元にもあるExporterに(たぶん)関連するサブルーチンでaliasってのを作った。

sub alias {
    my $pkg = caller;
    my ($type, $to, $from) = @_;
    no strict 'refs';
    if (defined *{$from}{$type}) {
        *{"${pkg}::$to"} = *{$from}{$type};
        debug("imported $from of $type to ${pkg}::$to");
    } else {
        warning("not found reference $from of $type");
    }
}

使い方

alias 'CODE', 'foo' => 'bar';
alias 'CODE', 'THISPKG::baz' => 'THATPKG::baz';

これでfooとbarは同じになって、
THISPKG::bazとTHATPKG::bazは同じになる。(というかエクスポートされる)
間違ってたので追記２を参照。

CODEだとサブルーチンのシンボルのみをエクスポートし、
他にも

SCALAR スカラー
ARRAY 配列
HASH ハッシュ
IO ファイルハンドル
GLOB 上記のシンボル全て

とかが指定できる。

追記２：
間違えた。

alias 'CODE', 'THISPKG::baz' => 'THATPKG::baz';

はエクスポートされない。
何故かって言うと、

alias 'CODE', __PACKAGE__.'foo' => 'bar';

とかわざわざ書くのめんどいんで、２番目の引数のシンボルの頭には__PACKAGE__を付けるようにしたんだった。
なので

alias 'CODE', 'THISPKG::baz' => 'THATPKG::baz';

__PACKAGE__::THISPKG::bazをTHATPKG::bazとしてエクスポートするので、THISPKG::bazはTHATPKG::bazと同じにはならない。

解決法としてはを絶対パッケージで指定(::を含むなど)されたら__PACKAGE__を付けないようにするとかすればいいけど、もうこのサブルーチンは使ってないし、めんどいのでやめ。