adiary開発日誌

軽量なExporter。

• 動作するのは @EXPORT と @EXPORT_OK
• タグによる条件指定など複雑なエクスポートはできない

通常の使用には十分です。ただ標準の Exporter も、EXPORT変数に$や&などを付けず名前だけ使用すれば十分高速なのでボツになりました（苦笑）*1

perl の Export の原理を学ぶには良い題材だと思います。

ソースコード

WTFPL（もしくはPDS扱い）でお願いします。

package Satsuki::Exporter;
use strict;
our $VERSION = '1.00';

sub import {
	no strict 'refs';

	my $spkg = shift;
	my $dpkg = (caller(0))[0];
	if ($spkg eq __PACKAGE__) {
		foreach(@_) {
			*{"$dpkg\::$_"} = *{"$spkg\::$_"}{CODE};
		}
		return;
	}

	my %exp = map { $_ => 1 } @{"$spkg\::EXPORT"};
	my %ok  = map { $_ => 1 } @{"$spkg\::EXPORT_OK"};

	foreach(@_) {
		if (exists $exp{$_} || exists $ok{$_}) { next; }
		&die("'$_' is not found");
	}

	my @ary = @_ || keys(%exp);
	foreach(@ary) {
		my $type;
		my $x = substr($_,0,1);
		   if ($x eq '$') { $type='SCALAR'; }
		elsif ($x eq '@') { $type='ARRAY'; }
		elsif ($x eq '%') { $type='HASH'; }
		elsif ($x eq '&') { $type='CODE'; }
		else {
			if ($x eq '*') { $_ = substr($_,1); }
			*{"$dpkg\::$_"} = *{"$spkg\::$_"};
			next;
		}
		$_ = substr($_,1);
		*{"$dpkg\::$_"} = *{"$spkg\::$_"}{$type};
	}
}

sub die {
	my $str = shift;
	my @c = caller(1);
	die "[Exporter] $str from $c[1] line $c[2]"
}

参考

Perlの型グロブと名前空間アクセスの応用