Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Poor man's Exporter.

by shotgunefx (Parson)
on Mar 28, 2002 at 03:16 UTC ( [id://154883] : CUFP . print w/replies, xml ) Need Help??

Exporting is bad 'mkay. This came out of a discussion here. I use Exporter to manage my exports. This is not intended to replace it but merely for illustrative purposes for anyone who is thinking about rolling their own import. Doesn't support :tags (easily done though) , but does support @EXPORT, @EXPORT_OK, @EXPORT_FAIL and $VERSION checking.
Update Fixed bug. Wasn't removing the modulename from @_, which meant it tried to import a var with the name specified in use.
our @EXPORT = qw (@array $VAR ); our @EXPORT_OK = qw($OK_ONLY); our @EXPORT_FAIL = qw ($DONTDOIT); sub import { no strict 'refs'; my $used_name = shift ; # Remove the Module name. my ($Version) = grep { m/^\d[\d.]*$/} @_; my @ex = grep { !m/^(\d[\d\.]+)$/} @_; die "Insufficient or missing \$VERSION: $VERSION, $Version require +d." if $Version && $VERSION <= $Version; push @ex, @EXPORT ; my %EXP = map {($_,'mKay')} @EXPORT,@EXPORT_OK; $EXP{$_} = 'Bad' for @EXPORT_FAIL; my $that_pack = caller(); foreach (@ex){ next if m/^\d[\d\.]+$/; die "Denied. Can't export $_" if $EXP{$_} eq 'Bad'; die "Can't export unknown symbol $_" unless $EXP{$_} eq 'mKay' +; m/^([\@\$\*\&\%]?)(\w+)/; my ($t,$v) = ($1,$2); $t = '&' unless $t; *{$that_pack.'::'.$v} = $t eq '@' && \@{$v} || $t eq '%' && \% +{$v} || $t eq '&' && \&{$v} || $t eq '$' && \${$v} || $t eq '*' && \*{$v} || \*{$_}; } }