File Coverage

blib/lib/Import/Export.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	22	22	100.0
condition			n/a
subroutine	9	9	100.0
pod	1	1	100.0
total	72	72	100.0

package Import::Export;

use Carp;
use namespace::clean ();

our $VERSION = '1.00';

our %EX;

our %EXTYPE = (
	'&' => \&_export_code,
	'$' => \&_export_scalar,
	'@' => \&_export_array,
	'%' => \&_export_hash,
	'*' => \&_export_glob,
);

sub import {
	my ($pkg, $options, $caller) = (shift, {}, caller());
	return unless my @export = @_;
	Carp::croak('define your %EX export hash')
		unless (%EX) = %{"${pkg}::EX"};

	$options = pop @export if ref $export[-1];
	$caller = $options->{-caller} if exists $options->{-caller};
	my @exported = export($pkg, $caller, @export);

	$options->{clean} and "$options->{clean}" eq "import"
		? namespace::clean->clean_subroutines( # sub import { p->import(@export, { clean => 'import' }) }
			$caller,
			@exported
		)
		: namespace::clean->import(  # use p @export, { clean => 1 }
			-cleanee => $caller,
			@exported
		);
}

sub export {
	my ($pkg, $caller, @exported) = (shift, shift);
	while (my $ex = shift) {
		my $type;
		if ( ! $EX{$ex} ) {
		 	my @export = grep {
				grep { $_ =~ m{\Q$ex\E} } @{ $EX{$_} }
			} keys %EX;
			scalar @export
				? return export($pkg, $caller, (@export, @_))
				: Carp::croak "$ex is not exported";
		}

		$type = ($ex =~ s/^(\W)//) ? $1 : "&";
		$caller->can($ex) and next;

		my $exporting = $EXTYPE{$type} or Carp::croak("Cant export symbol $type");
		*{"${caller}::${ex}"} = $exporting->($pkg, $ex);
		push @exported, $ex;
	}
	return @exported;
}

sub _export_code { \&{"$_[0]::$_[1]"} }
sub _export_scalar { \${"$_[0]::$_[1]"} }
sub _export_array { \@{"$_[0]::$_[1]"} }
sub _export_hash { \%{"$_[0]::$_[1]"} }
sub _export_glob { *{"$_[0]::$_[1]"} }

1;

__END__