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 21, 2015 06:53
Subject:
Re: Proposal: Add {-as => 'new_name'} feature to Exporter.pm
Message ID:
CAJFr3ktZrvGbESOgbbQyRWLfs-Vh6A31KGJej6MhZ58V_7k3ig@mail.gmail.com
From 452903cd8ffb4182b5dcdc949199a8e7fdbee35e Mon Sep 17 00:00:00 2001
From: Chad Granum <exodist7@gmail.com>
Date: Sun, 20 Dec 2015 22:38:13 -0800
Subject: [PATCH 2/2] Exporter: Ability to specify symbol specific behavior

This commit adds Exporter::ImportSpecs. An importer can use this module
to enable a feature of any Exporter.pm based exporter that allows the
importer to define special import behavior.

For this initial phase the only behavior added is the ability to rename
symbols on import. It would be easy to add other behaviors in the future
if any is deemed necessary.
---
 dist/Exporter/lib/Exporter.pm             |  20 +++++-
 dist/Exporter/lib/Exporter/Heavy.pm       |  44 ++++++++++++-
 dist/Exporter/lib/Exporter/ImportSpecs.pm | 100 ++++++++++++++++++++++++++++++
 dist/Exporter/t/Exporter.t                |  43 ++++++++++++-
 4 files changed, 202 insertions(+), 5 deletions(-)
 create mode 100644 dist/Exporter/lib/Exporter/ImportSpecs.pm

diff --git a/dist/Exporter/lib/Exporter.pm b/dist/Exporter/lib/Exporter.pm
index 0b3db21..45f0311 100644
--- a/dist/Exporter/lib/Exporter.pm
+++ b/dist/Exporter/lib/Exporter.pm
@@ -9,7 +9,8 @@ require 5.006;
 our $Debug = 0;
 our $ExportLevel = 0;
 our $Verbose ||= 0;
-our $VERSION = '5.72';
+our $VERSION = '5.73';
+our %SPEC_WHITELIST;
 our (%Cache);
 
 sub as_heavy {
@@ -449,6 +450,22 @@ If you are writing a package that C<AUTOLOAD>s, consider forcing
 an C<AUTOLOAD> for any constants explicitly imported by other packages
 or which are usually used when your package is C<use>d.
 
+=head2 IMPORT SPECIFICATIONS
+
+As of version 5.73 there is a new module called L<Exporter::ImportSpecs>.
+Using L<Exporter::ImportSpecs> in an importing package allows you to use
+advanced features when you import symbols.
+
+=head3 RENAMING IMPORTS
+
+    use Exporter::ImportSpecs;
+    use Some::Exporter some_sub => { -as => 'new_name' };
+
+    new_name(); # sub 'some_sub' is now present as 'new_name'.
+
+This syntax is consistent with newer exporting tools such as L<Sub::Exporter>
+and L<Exporter::Declare>.
+
 =head1 Good Practices
 
 =head2 Declaring C<@EXPORT_OK> and Friends
@@ -579,6 +596,7 @@ a sample list of such modules.
     Exporter::Tidy
     Sub::Exporter / Sub::Installer
     Perl6::Export / Perl6::Export::Attrs
+    Exporter::Declare
 
 =head1 LICENSE
 
diff --git a/dist/Exporter/lib/Exporter/Heavy.pm b/dist/Exporter/lib/Exporter/Heavy.pm
index 10c9b8d..4ea3062 100644
--- a/dist/Exporter/lib/Exporter/Heavy.pm
+++ b/dist/Exporter/lib/Exporter/Heavy.pm
@@ -36,6 +36,11 @@ sub _rebuild_cache {
     }
 }
 
+# More may be added later?
+my %VALID_SPEC_KEYS = (
+    '-as' => 1,
+);
+
 sub heavy_export {
 
     # Save the old __WARN__ handler in case it was defined
@@ -67,6 +72,33 @@ sub heavy_export {
     my($exports, $export_cache) = (\@{"${pkg}::EXPORT"},
                                    $Exporter::Cache{$pkg} ||= {});
 
+    # Pre-Filter import list to grab any arg => { ... } specifications, but
+    # only if they are whitelisted.
+    my %import_specs;
+    if (@imports && $Exporter::SPEC_WHITELIST{$callpkg}) {
+        my @original_args = @imports;
+        @imports = ();
+        while (my $arg = shift @original_args) {
+            push @imports => $arg;
+            next unless @original_args && ref($original_args[0]) eq 'HASH';
+            my $spec = shift @original_args;
+
+            # Warn if an invalid key is seen.
+            for my $key (keys %$spec) {
+                next if $VALID_SPEC_KEYS{$key};
+                warn qq["$key" is not a valid Exporter::ImportSpecs key];
+            }
+
+            # If a specification has already been given we will merge them.
+            if ($import_specs{$arg}) {
+                $import_specs{$arg} = { %{$import_specs{$arg}}, %$spec };
+            }
+            else {
+                $import_specs{$arg} = $spec;
+            }
+        }
+    }
+
     if (@imports) {
         if (!%$export_cache) {
             _rebuild_cache ($pkg, $exports, $export_cache);
@@ -195,12 +227,18 @@ sub heavy_export {
                 join(", ",sort @imports) if $Exporter::Verbose;
 
     foreach $sym (@imports) {
+        my $spec = $import_specs{$sym};
+
+        my $type = $1 if $sym =~ s/^(\W)//;
+        my $name = $spec->{'-as'} || $sym;
+
         # shortcut for the common case of no type character
-        (*{"${callpkg}::$sym"} = \&{"${pkg}::$sym"}, next)
-            unless $sym =~ s/^(\W)//;
+        (*{"${callpkg}::$name"} = \&{"${pkg}::$sym"}, next)
+            unless $type;
+
         $type = $1;
         no warnings 'once';
-        *{"${callpkg}::$sym"} =
+        *{"${callpkg}::$name"} =
             $type eq '&' ? \&{"${pkg}::$sym"} :
             $type eq '$' ? \${"${pkg}::$sym"} :
             $type eq '@' ? \@{"${pkg}::$sym"} :
diff --git a/dist/Exporter/lib/Exporter/ImportSpecs.pm b/dist/Exporter/lib/Exporter/ImportSpecs.pm
new file mode 100644
index 0000000..b626973
--- /dev/null
+++ b/dist/Exporter/lib/Exporter/ImportSpecs.pm
@@ -0,0 +1,100 @@
+package Exporter::ImportSpecs;
+use strict;
+use warnings;
+
+# Keep version in sync with Exporter itself.
+our $VERSION = '5.73';
+
+sub import {
+    my $class = shift;
+    my $dest = caller;
+    $class->apply_to($dest);
+}
+
+sub apply_to {
+    my $class = shift;
+    my ($dest) = @_;
+    $Exporter::SPEC_WHITELIST{$dest}++;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Exporter::ImportSpecs - Turn on import specification for a specific importer.
+
+=head1 SYNOPSIS
+
+    use Exporter::ImportSpecs;
+
+    use Some::Exporter sub1 => { ... }, sub2 => { ... }, qw/other import symbols/;
+
+=head1 DESCRIPTION
+
+Using this module turns on additional import features for the class that uses
+it. This gives you the C<< import => { ... } >> syntax to pass in extra
+import-specific options. These options will only work with exporters that use
+L<Exporter.pm>.
+
+=head1 WHAT IS A SPECIFICATION?
+
+A specification is a hashref following a symbol name.
+
+    use Some::Thing 'foo' => { ... };
+
+Different keys in the hashref have different effects. See the
+L</SPECIFICATION OPTIONS> sections for valid keys. A warning will be issued for
+any invalid keys.
+
+=head1 WHAT IF SPECIFICATIONS ARE GIVEN MULTIPLE TIMES?
+
+Example:
+
+    use Some::Thing
+        'foo' => { key1 => 'foo', key2 => 'bar' },
+        'foo' => { key1 => 'fuu', key3 => 'baz' };
+
+When multiple specs are combined they are merged, if a key is specified in
+multiple hashrefs then the last one wins. The example above becomes:
+
+    use Some::Thing
+        'foo' => { key1 => 'fuu', key2 => 'bar', key3 => 'baz' };
+
+=head1 SPECIFICATION OPTIONS
+
+=head2 SYMBOL RENAMING
+
+B<Note:> Added in version 5.73.
+
+This feature allows you to import symbols with custom names instead of their
+original names. Add the C<'-as'> key tot he specification hash with a new
+symbol name as the value.
+
+    use Exporter::ImportSpecs;
+    use Some::Exporter some_sub => { -as => 'new_name' };
+
+    new_name(); # sub 'some_sub' is now present as 'new_name'.
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item Exporter::ImportSpecs->apply_to($package)
+
+This is a way to enable the features for a package other than the one importing
+L<Exporter::ImportSpecs>. This is useful if you plan to use the advanced
+features by proxy, like you would with Import::Into and similar tools.
+
+=back
+
+=head1 LICENSE
+
+This library is free software.  You can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=cut
+
+
+
diff --git a/dist/Exporter/t/Exporter.t b/dist/Exporter/t/Exporter.t
index d6ac63f..fb311b9 100644
--- a/dist/Exporter/t/Exporter.t
+++ b/dist/Exporter/t/Exporter.t
@@ -18,7 +18,7 @@ sub ok ($;$) {
 
 BEGIN {
     $test = 1;
-    print "1..31\n";
+    print "1..39\n";
     require Exporter;
     ok( 1, 'Exporter compiled' );
 }
@@ -33,6 +33,9 @@ BEGIN {
                           );
 }
 
+require Exporter::ImportSpecs;
+ok($Exporter::VERSION == $Exporter::ImportSpecs::VERSION, "Exporter and ImportSpec have the same version");
+
 
 package Testing;
 require Exporter;
@@ -243,3 +246,41 @@ sub TIESCALAR{bless[]}
  }
 }
 ::ok(1, 'import with tied $_');
+
+package main::TestRename;
+
+BEGIN {
+    $INC{'main/TestRename/Foo.pm'} = 1;
+    package main::TestRename::Foo;
+
+    our @EXPORT = qw/foo/;
+    use base 'Exporter';
+
+    sub foo { 'foo' }
+}
+
+my $fail = eval { main::TestRename::Foo->import('foo' => {-as => 'bar'}); 1 };
+my $error = $@;
+::ok(!$fail, "exception was thrown, rename feature is not enabled");
+::ok(
+    $error =~ m/^"HASH\(.*\)" is not exported by the main::TestRename::Foo module/,
+    "Exception is what it has always been before ImportSpecs existed"
+);
+
+Exporter::ImportSpecs->import;
+main::TestRename::Foo->import('foo' => {-as => 'bar'});
+
+::ok(__PACKAGE__->can('bar'), "imported foo as bar");
+::ok(!__PACKAGE__->can('foo'), "Did not import 'foo'");
+::ok(bar() eq 'foo', "bar does what we expect");
+
+main::TestRename::Foo->import('foo' => {-as => 'baz'}, 'foo' => {-as => 'boo'});
+::ok(__PACKAGE__->can('boo'), "Later specification won");
+
+my $warning;
+{
+    local $SIG{__WARN__} = sub { $warning = shift };
+    main::TestRename::Foo->import('foo' => {invalid => 1});
+}
+::ok($warning =~ m/^"invalid" is not a valid Exporter::ImportSpecs key/, "Warned for invalid key");
+
-- 
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