まだ重たいCMSをお使いですか?
毎秒1000リクエスト を捌く超高速CMS「adiary

2013/08/02(金)perlでExporterを実装してみた

軽量なExporter。

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

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

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

*1 : 律儀に名前以外の型まで与えると Exporter::Heavy がロードされて動作が重くなる。

ソースコード

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の型グロブと名前空間アクセスの応用