develooper Front page | perl.perl5.porters | Postings from December 2015

Re: Proposal: Add {-as => 'new_name'} feature to Exporter.pm

Thread Previous | Thread Next
From:
Chad Granum
Date:
December 17, 2015 22:55
Subject:
Re: Proposal: Add {-as => 'new_name'} feature to Exporter.pm
Message ID:
CAJFr3ktjrP=q2OdFXDFbij5TFfDxLB4bJmmXpAW_j1A8ATtwuQ@mail.gmail.com
From 69867dbf2e11c0840bc5d2da6f76eac1cb5d84ed Mon Sep 17 00:00:00 2001
From: Chad Granum <exodist7@gmail.com>
Date: Thu, 17 Dec 2015 14:53:13 -0800
Subject: [PATCH] fix

---
 lib/Exporter/Heavy.pm | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

diff --git a/lib/Exporter/Heavy.pm b/lib/Exporter/Heavy.pm
index 21b67c1..772bbae 100755
--- a/lib/Exporter/Heavy.pm
+++ b/lib/Exporter/Heavy.pm
@@ -67,12 +67,22 @@ sub heavy_export {
     my($exports, $export_cache) = (\@{"${pkg}::EXPORT"},
                                    $Exporter::Cache{$pkg} ||= {});
 
+    my %rename;
     if (@imports) {
 	if (!%$export_cache) {
 	    _rebuild_cache ($pkg, $exports, $export_cache);
 	    $cache_is_current = 1;
 	}
 
+        my @args = @imports;
+        @imports = ();
+        while (my $arg = shift @args) {
+            push @imports => $arg;
+            next unless @args && ref($args[0]) eq 'HASH';
+            my $spec = shift @args;
+            $rename{$arg} = $spec->{'-as'} if $spec->{'-as'};
+        }
+
 	if (grep m{^[/!:]}, @imports) {
 	    my $tagsref = \%{"${pkg}::EXPORT_TAGS"};
 	    my $tagdata;
@@ -195,12 +205,13 @@ sub heavy_export {
 		join(", ",sort @imports) if $Exporter::Verbose;
 
     foreach $sym (@imports) {
+        my $name = $rename{$sym} || $sym;
 	# shortcut for the common case of no type character
-	(*{"${callpkg}::$sym"} = \&{"${pkg}::$sym"}, next)
+	(*{"${callpkg}::$name"} = \&{"${pkg}::$sym"}, next)
 	    unless $sym =~ s/^(\W)//;
 	$type = $1;
 	no warnings 'once';
-	*{"${callpkg}::$sym"} =
+	*{"${callpkg}::$name"} =
 	    $type eq '&' ? \&{"${pkg}::$sym"} :
 	    $type eq '$' ? \${"${pkg}::$sym"} :
 	    $type eq '@' ? \@{"${pkg}::$sym"} :
-- 
1.9.1


Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About