Testing, Bugfixes, and Exporter.pm clone(ish)

4 files changed, 678 insertions, 135 deletions

diff --git a/lib/Importer.pm b/lib/Importer.pm
index 83669e0..44d5696 100644
--- a/lib/Importer.pm
+++ b/lib/Importer.pm
@@ -4,6 +4,8 @@ use warnings;
 
 our $VERSION = 0.002;
 
+our @EXPORT_OK = qw/exporter_import/;
+
 my %SIG_TO_SLOT = (
     '&' => 'CODE',
     '$' => 'SCALAR',
@@ -17,14 +19,30 @@ my %IMPORTED;
 # This will be used to check if an import arg is a version number
 my %NUMERIC = map { $_ => 1 } 0 .. 9;
 
-sub _version_check {
-    my ($mod, $caller, @versions) = @_;
+# If a consumer just wants subs then we can optimize the import. This is used
+# as a lookup table to find non-optimal sigils. Can;t just look for '&' since a
+# sub can be listed without a sigil, so alpha-numerics may also be checked
+# against thi stable, and we want those to be considered optimal.
+my %NON_OPTIMAL = ( '$' => 1, '@' => 1, '%' => 1, '*' => 1 );
 
-    eval <<"    EOT" or die $@;
-#line $caller->[2] "$caller->[1]"
-\$mod->VERSION(\$_) for \@versions;
-1;
-    EOT
+sub exporter_import {
+    my $from = shift;
+
+    my @caller = caller(0);
+
+    return unless @_;
+
+    my $file = _mod_to_file($from);
+    _load_file(\@caller, $file) unless $INC{$file};
+
+    return if _optimal_import($from, $caller[0], @_);
+
+    my $self = __PACKAGE__->new(
+        from   => $from,
+        caller => \@caller,
+    );
+
+    $self->do_import($caller[0], @_);
 }
 
 sub import {
@@ -38,12 +56,16 @@ sub import {
 
     my ($from, @args) = @_;
 
+    my $file = _mod_to_file($from);
+    _load_file(\@caller, $file) unless $INC{$file};
+
+    return if _optimal_import($from, $caller[0], @args);
+
     my $self = $class->new(
         from   => $from,
         caller => \@caller,
     );
 
-    $self->load_from() unless $INC{$self->from_file()};
     $self->do_import($caller[0], @args);
 }
 
@@ -61,12 +83,16 @@ sub import_into {
         @caller = caller(0);
     }
 
+    my $file = _mod_to_file($from);
+    _load_file(\@caller, $file) unless $INC{$file};
+
+    return if _optimal_import($from, $into, @args);
+
     my $self = $class->new(
         from   => $from,
         caller => \@caller,
     );
 
-    $self->load_from() unless $INC{$self->from_file()};
     $self->do_import($into, @args);
 }
 
@@ -168,12 +194,7 @@ sub from { $_[0]->{from} }
 sub from_file {
     my $self = shift;
 
-    unless($self->{from_file}) {
-        my $file = $self->{from};
-        $file =~ s{::}{/}g;
-        $file .= '.pm';
-        return $self->{from_file} = $file;
-    }
+    $self->{from_file} ||= _mod_to_file($self->{from});
 
     return $self->{from_file};
 }
@@ -187,10 +208,7 @@ sub load_from {
 
     my $caller = $self->get_caller;
 
-    eval <<"    EOT" || die $@;
-#line $caller->[2] "$caller->[1]"
-require \$from_file;
-    EOT
+    _load_file($caller, $from_file);
 }
 
 sub get_caller {
@@ -242,17 +260,27 @@ sub reload_menu {
 
     my $from = $self->from;
 
-    my ($export, $export_ok, $export_tags, $export_fail, $generate);
+    my ($export, $export_ok, $export_tags, $export_fail, $generate, $export_gen, $export_anon, $new_style);
     if ($from->can('IMPORTER_MENU')) {
         # Hook, other exporter modules can define this method to be compatible with
         # Importer.pm
 
+        $new_style = 1;
+
         my %got = $from->IMPORTER_MENU($into, $self->get_caller);
         $export      = $got{export}      || [];
         $export_ok   = $got{export_ok}   || [];
         $export_tags = $got{export_tags} || {};
         $export_fail = $got{export_fail} || [];
-        $generate    = $got{generate};
+        $export_anon = $got{export_anon} || {};
+
+        $export_gen = $got{export_gen};
+        $generate   = $got{generate};
+
+        $self->croak("'$from' provides both 'generate' and 'export_gen' in its IMPORTER_MENU (They are exclusive, module must pick 1)")
+            if $export_gen && $generate;
+
+        $export_gen ||= {};
     }
     else {
         no strict 'refs';
@@ -261,18 +289,49 @@ sub reload_menu {
         $export_ok   = \@{"$from\::EXPORT_OK"};
         $export_tags = \%{"$from\::EXPORT_TAGS"};
         $export_fail = \@{"$from\::EXPORT_FAIL"};
+        $export_gen  = \%{"$from\::EXPORT_GEN"};
+        $export_anon = \%{"$from\::EXPORT_ANON"};
     }
 
-    my $exports = { map {
-        my ($sig, $name) = (m/^(\W?)(.*)$/);
+    $generate ||= sub {
+        my $symbol = shift;
+        my ($sig, $name) = ($symbol =~ m/^(\W?)(.*)$/);
+        $sig ||= '&';
+
+        my $do = $export_gen->{"${sig}${name}"};
+        $do ||= $export_gen->{$name} if !$sig || $sig eq '&';
+
+        return undef unless $do;
+
+        $from->$do($into, $symbol);
+    } if $export_gen && keys %$export_gen;
+
+    my $lookup = {};
+    my $exports = {};
+    for my $sym (@$export, @$export_ok, keys %$export_gen, keys %$export_anon) {
+        my ($sig, $name) = ($sym =~ m/^(\W?)(.*)$/);
         $sig ||= '&';
-        my $slot = $SIG_TO_SLOT{$sig} || 'CODE';
+        my $slot = $SIG_TO_SLOT{$sig};
+
+        $lookup->{"${sig}${name}"} = 1;
+        $lookup->{$name} = 1 if $sig eq '&';
+
+        next if $export_gen->{"${sig}${name}"};
+        next if $sig eq '&' && $export_gen->{$name};
 
         no strict 'refs';
         no warnings 'once';
-        ("${sig}${name}" => $slot eq 'SCALAR' ? \${"$from\::$_"} : *{"$from\::$_"}{$slot});
-    } @$export, @$export_ok };
+        $exports->{"${sig}${name}"} = $export_anon->{$sym} || ($slot eq 'SCALAR' ? \${"$from\::$name"} : *{"$from\::$name"}{$slot});
+    }
 
+    my $f_import = $new_style || $from->can('import');
+    $self->croak("'$from' does not provide any exports")
+        unless $new_style
+            || keys %$exports
+            || $from->isa('Exporter')
+            || ($INC{'Exporter.pm'} && $f_import && $f_import == \&Exporter::import);
+
+    # Do not cleanup or normalize the list added to the DEFAULT tag, legacy....
     my $tags = {
         %$export_tags,
         'DEFAULT' => [ @$export ],
@@ -282,12 +341,10 @@ sub reload_menu {
         map {
             my ($sig, $name) = (m/^(\W?)(.*)$/);
             $sig ||= '&';
-            ("${sig}${name}" => 1)
+            ("${sig}${name}" => 1, $sig eq '&' ? ($name => 1) : ())
         } @$export_fail
     } : undef;
 
-    my $lookup = { map { $_ => 1 } @$export, @$export_ok };
-
     $self->{menu_for} = $into;
     return $self->{menu} = {
         lookup   => $lookup,
@@ -311,7 +368,8 @@ sub parse_args {
     my @import;
     my @versions;
 
-    while(my $arg = shift @args) {
+    while(my $full_arg = shift @args) {
+        my $arg = $full_arg;
         my $lead = substr($arg, 0, 1);
         my ($spec, $exc);
 
@@ -366,12 +424,16 @@ sub parse_args {
         }
 
         # Normalize list, always have a sigil
-        @list = map {m/^\W/ ? $_ : "\&$_" } @list;
+        my %seen;
+        @list = grep !$seen{$_}++, map {m/^\W/ ? $_ : "\&$_" } @list;
 
         if ($exc) {
             $exclude{$_} = 1 for @list;
         }
         else {
+            $self->croak("Cannot use '-as' to rename multiple symbols included by: $full_arg")
+                if $spec->{'-as'} && @list > 1;
+
             push @import => [$_, $spec] for @list;
         }
     }
@@ -431,7 +493,7 @@ sub _set_symbols {
     for my $set (@$import) {
         my ($symbol, $spec) = @$set;
 
-        my ($sig, $name) = ($symbol =~ m/^(\W?)(.*)$/);
+        my ($sig, $name) = ($symbol =~ m/^(\W)(.*)$/);
 
         # Find the thing we are actually shoving in a new namespace
         my $ref = $menu->{exports}->{$symbol};
@@ -440,7 +502,7 @@ sub _set_symbols {
         # Exporter.pm supported listing items in @EXPORT that are not actually
         # available for export. So if it is listed (lookup) but nothing is
         # there (!$ref) we simply skip it.
-        croak "$from does not export $symbol" unless $ref || $menu->{lookup}->{$name} || $menu->{lookup}->{$symbol};
+        croak "$from does not export $symbol" unless $ref || $menu->{lookup}->{"${sig}${name}"};
         next unless $ref;
 
         # Figure out the name they actually want it under
@@ -458,6 +520,69 @@ sub _set_symbols {
     }
 }
 
+#########################################################
+## The rest of these are utility functions, not methods!
+
+sub _version_check {
+    my ($mod, $caller, @versions) = @_;
+
+    eval <<"    EOT" or die $@;
+#line $caller->[2] "$caller->[1]"
+\$mod->VERSION(\$_) for \@versions;
+1;
+    EOT
+}
+
+sub _mod_to_file {
+    my $file = shift;
+    $file =~ s{::}{/}g;
+    $file .= '.pm';
+    return $file;
+}
+
+sub _load_file {
+    my ($caller, $file) = @_;
+
+    eval <<"    EOT" || die $@;
+#line $caller->[2] "$caller->[1]"
+require \$file;
+    EOT
+}
+
+sub _optimal_import {
+    my ($from, $into, @args) = @_;
+
+    my %final;
+    no strict 'refs';
+    return 0 if @{"$from\::EXPORT_FAIL"};
+    @args = @{"$from\::EXPORT"} unless @args;
+    my %allowed = map +($_ => 1), @{"$from\::EXPORT"}, @{"$from\::EXPORT_OK"};
+    use strict 'refs';
+
+    for my $arg (@args) {
+        # Get sigil, or first letter of name
+        my $sig = substr($arg, 0, 1);
+
+        # Return if non-sub sigil
+        return 0 if $NON_OPTIMAL{$sig};
+
+        # Strip sigil (if sub)
+        my $name = $arg;
+        substr($name, 0, 1, '') if $sig eq '&';
+
+        # Check if the name is allowed (with or without sigil)
+        return 0 unless $allowed{$name} || $allowed{$arg};
+
+        no strict 'refs';
+        $final{$name} = \&{"$from\::$name"};
+    }
+
+    no strict 'refs';
+    (*{"$into\::$_"} = $final{$_}, push @{$IMPORTED{$into}} => $_) for keys %final;
+
+    return 1;
+}
+
 1;
 
 __END__
diff --git a/lib/Importer/Exporter.pm b/lib/Importer/Exporter.pm
new file mode 100644
index 0000000..db1cb2a
--- /dev/null
+++ b/lib/Importer/Exporter.pm
@@ -0,0 +1,110 @@
+package Importer::Exporter;
+use strict;
+use warnings;
+
+use Importer Importer => (
+    exporter_import => { -as => 'import' },
+    exporter_import => { -as => 'export' },
+);
+
+our @EXPORT_OK = qw/import/;
+
+sub export_fail { shift; @_ }
+
+sub export_to_level {
+    my $from = shift;
+    my ($level) = @_;
+    Importer->import_into($from, $level + 1, @_);
+}
+
+sub require_version {
+    my ($self, $wanted) = @_;
+    my $pkg = ref $self || $self;
+    return ${pkg}->VERSION($wanted);
+}
+
+my $push_tags = sub {
+    my $from = shift;
+    my ($var, @tags) = @_;
+
+    no strict 'refs';
+    my $export      = \%{"$from\::$var"};
+    my $export_tags = \%{"$from\::EXPORT_TAGS"};
+    use strict 'refs';
+
+    my @nontag = ();
+    for my $tag (@tags ? @tags : keys %$export_tags) {
+        my $tag_list = $export_tags->{$tag};
+        $tag_list ? push @$export => @$tag_list : push @nontag => $tag;
+    };
+
+    return unless @nontag && $^W;
+
+    require Carp;
+    Carp::carp(join(", ", @nontag) . " are not tags of $from");
+};
+
+sub export_tags {
+    my $from = shift;
+    $from->$push_tags('EXPORT', @_);
+}
+
+sub export_ok_tags {
+    my $from = shift;
+    $from->$push_tags('EXPORT_OK', @_);
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Importer::Exporter - DO NOT USE THIS
+
+=head1 DESCRIPTION
+
+This is what L<Exporter> would look like if it used L<Importer> to get the job
+done. Works with C<use base 'Importer::Exporter';> as well as
+C<use Importer::Exporter qw/import/>.
+
+=head1 *** EXPERIMENTAL ***
+
+This module is still experimental. Anything can change at any time. Testing is
+currently VERY insufficient.
+
+=head1 SOURCE
+
+The source code repository for symbol can be found at
+F<http://github.com/exodist/Importer>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2015 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut
diff --git a/lib/Importer/Exporter/Heavy.pm b/lib/Importer/Exporter/Heavy.pm
new file mode 100644
index 0000000..1977ccf
--- /dev/null
+++ b/lib/Importer/Exporter/Heavy.pm
@@ -0,0 +1,68 @@
+package Importer::Exporter::Heavy;
+use warnings;
+
+use Importer::Exporter();
+
+*{"heavy_$_"} = Importer::Exporter->can($_) for qw{
+    export_fail
+    export
+    export_to_level
+    require_version
+    export_tags
+    export_ok_tags
+};
+
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Importer::Exporter::Heavy - DO NOT USE THIS
+
+=head1 DESCRIPTION
+
+This is what L<Exporter::Heavy> would look like if it used L<Importer> to get
+the job done.
+
+=head1 *** EXPERIMENTAL ***
+
+This module is still experimental. Anything can change at any time. Testing is
+currently VERY insufficient.
+
+=head1 SOURCE
+
+The source code repository for symbol can be found at
+F<http://github.com/exodist/Importer>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2015 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut
diff --git a/t/units.t b/t/units.t
index 64d5bcf..5e48109 100644
--- a/t/units.t
+++ b/t/units.t
@@ -8,10 +8,15 @@ my $CLASS = 'Importer';
 sub dies(&) {
     my $code = shift;
 
-    local $@;
-    eval { $code->(); 1 } and return undef;
+    my $err;
+    {
+        local $@;
+        eval { $code->(); 1 } and return undef;
+        $err = $@;
+    }
 
-    return $@ || 1;
+    $@ = $err;
+    return $err || 1;
 }
 
 sub warns(&) {
@@ -131,7 +136,7 @@ subtest from_file => sub {
 
 subtest load_from => sub {
     my $one = $CLASS->new(from => 'Some::Fake::Module::AFSGEWGWE::FASDF', caller => ['main', 'fake.pl', 42]);
-    
+
     like(
         dies { $one->load_from },
         qr{Can't locate.*at fake\.pl line 42},
@@ -184,87 +189,283 @@ subtest carp_and_croak => sub {
     );
 };
 
-done_testing;
+subtest menu => sub {
+    my $menu;
 
-__END__
+    no warnings 'redefine';
+    local *Importer::reload_menu = sub {
+        my $self = shift;
+        my ($into) = @_;
+        $self->{menu} = $menu;
+        $self->{menu_for} = $into;
+        return $menu;
+    };
 
-sub menu {
-    my $self = shift;
-    my ($into) = @_;
+    $menu = { a => 1 };
+    my $one = $CLASS->new(from => 'fake');
+    is_deeply($one->menu('fake2'), $menu, "returned menu");
 
-    $self->croak("menu() requires the name of the destination package")
-        unless $into;
+    my $old = $menu;
+    $menu = { b => 2 };
 
-    my $for = $self->{menu_for};
-    delete $self->{menu} if $for && $for ne $into;
-    return $self->{menu} || $self->reload_menu($into);
-}
+    is_deeply($one->menu('fake2'), $old, "cached");
 
-sub reload_menu {
-    my $self = shift;
-    my ($into) = @_;
+    is_deeply($one->menu('fake3'), $menu, "refreshed with different destination");
 
-    $self->croak("reload_menu() requires the name of the destination package")
-        unless $into;
+    my $line;
+    like(
+        dies { $line = __LINE__; $one->menu() },
+        qr/menu\(\) requires the name of the destination package at ${\__FILE__} line $line/,
+        "Need 'into' package"
+    );
+};
 
-    my $from = $self->from;
+subtest reload_menu => sub {
+    my $one = $CLASS->new(from => 'fake');
 
-    my ($export, $export_ok, $export_tags, $export_fail, $generate);
-    if ($from->can('IMPORTER_MENU')) {
-        # Hook, other exporter modules can define this method to be compatible with
-        # Importer.pm
-
-        my %got = $from->IMPORTER_MENU($into, $self->get_caller);
-        $export      = $got{export}      || [];
-        $export_ok   = $got{export_ok}   || [];
-        $export_tags = $got{export_tags} || {};
-        $export_fail = $got{export_fail} || [];
-        $generate    = $got{generate};
-    }
-    else {
-        no strict 'refs';
-        no warnings 'once';
-        $export      = \@{"$from\::EXPORT"};
-        $export_ok   = \@{"$from\::EXPORT_OK"};
-        $export_tags = \%{"$from\::EXPORT_TAGS"};
-        $export_fail = \@{"$from\::EXPORT_FAIL"};
-    }
+    my $line;
+    like(
+        dies { $line = __LINE__; $one->reload_menu() },
+        qr/menu\(\) requires the name of the destination package at ${\__FILE__} line $line/,
+        "Need 'into' package"
+    );
 
-    my $exports = { map {
-        my ($sig, $name) = (m/^(\W?)(.*)$/);
-        $sig ||= '&';
-        my $slot = $SIG_TO_SLOT{$sig} || 'CODE';
+    subtest empty => sub {
+        {
+            no warnings 'once';
+            require Exporter;
+            @Fake::Exporter1::ISA = ('Exporter');
+            *Fake::Exporter2::import = Exporter->can('import');
+            *Fake::Exporter3::IMPORTER_MENU = sub { () };
+            *Fake::Exporter4::IMPORTER_MENU = sub { (generate => sub { 1 }, export_gen => { a => 1 }) };
+        }
 
-        no strict 'refs';
-        no warnings 'once';
-        ("${sig}${name}" => $slot eq 'SCALAR' ? \${"$from\::$_"} : *{"$from\::$_"}{$slot});
-    } @$export, @$export_ok };
+        like(
+            dies { $line = __LINE__; $CLASS->new(from => 'Fake::Exporter4')->reload_menu('fake') },
+            qr/'Fake::Exporter4' provides both 'generate' and 'export_gen' in its IMPORTER_MENU \(They are exclusive, module must pick 1\) at ${\__FILE__} line $line/,
+            "Bad IMPORT_MENU"
+        );
+
+        like(
+            dies { $line = __LINE__; $CLASS->new(from => 'Fake::Exporter5')->reload_menu('fake') },
+            qr/'Fake::Exporter5' does not provide any exports at ${\__FILE__} line $line/,
+            "No exports, not an exporter"
+        );
+
+        my ($menu1, $menu2, $menu3);
+        ok(!dies { $menu1 = $CLASS->new(from => 'Fake::Exporter1')->reload_menu('fake') }, "Package isa Exporter with no exports") || diag $@;
+        ok(!dies { $menu2 = $CLASS->new(from => 'Fake::Exporter2')->reload_menu('fake') }, "Package uses Exporter qw/import/") || diag $@;
+        ok(!dies { $menu3 = $CLASS->new(from => 'Fake::Exporter3')->reload_menu('fake') }, "Package provides IMPORTER_MENU") || diag $@;
+
+        is_deeply(
+            [$menu1, $menu1, $menu2],
+            [$menu2, $menu3, $menu3],
+            "All empty menus are the same"
+        );
+
+        is_deeply(
+            $menu1,
+            {
+                lookup   => {},
+                exports  => {},
+                tags     => { DEFAULT => [] },
+                fail     => undef,
+                generate => undef,
+            },
+            "Got valid, but empty menu"
+        );
+    };
+
+    subtest IMPORTER_MENU => sub {
+        {
+            package Fake::ExporterI;
+            sub IMPORTER_MENU {
+                ::is_deeply(
+                    \@_,
+                    ['Fake::ExporterI', 'fake', ['fake', 'fake.pl', 42]],
+                    "Got input args"
+                );
+                return (
+                    export      => [qw/foo &bar $ZAP %ZAP @ZAP/],
+                    export_ok   => [qw/baz ick missing/],
+                    export_tags => {b => [qw/bar baz/]},
+                    export_fail => [qw/ick/],
+                    export_anon => { x => \&__x, z => \&__z },
+                    export_gen  => {
+                        'gena' => sub {
+                            sub { 'a' }
+                        },
+                        '&genb' => sub {
+                            sub { 'b' }
+                        },
+                    },
+                );
+            }
+
+            sub foo { 'foo' }
+            sub bar { 'bar' }
+            sub baz { 'baz' }
+            sub ick { 'ick' }
+            sub __x { 'x' }
+            sub __z { 'z' }
+
+            # These are here to insure 'exports' does not pull them in, they are listed as generate
+            sub gena { sub { 'oops, should not see this' } }
+            sub genb { sub { 'oops, should not see this' } }
+
+            # These are here to insure 'exports' does not pull them in, refs were provided by anon
+            sub x { sub { 'oops, should not see this' } }
+            sub y { sub { 'oops, should not see this' } }
+
+            package Fake::ExporterI2;
 
-    my $tags = {
-        %$export_tags,
-        'DEFAULT' => [ @$export ],
+            sub IMPORTER_MENU {
+                return (
+                    generate => \&generate,
+                );
+            }
+
+            sub generate { sub { 'a pie' } }
+        }
+
+        my $one = $CLASS->new(from => 'Fake::ExporterI', caller => ['fake', 'fake.pl', 42]);
+        my $menu = $one->reload_menu('fake');
+        is($one->{menu_for}, 'fake', "remember who it was generated for");
+        ok(my $gen = delete $menu->{generate}, "got a generate function");
+
+        is_deeply(
+            $menu,
+            {
+                lookup => {qw/
+                    foo 1       &foo 1
+                    bar 1       &bar 1
+                    baz 1       &baz 1
+                    ick 1       &ick 1
+                    missing 1   &missing 1
+                    x 1         &x 1
+                    z 1         &z 1
+                    gena 1      &gena 1
+                    genb 1      &genb 1
+
+                    $ZAP 1 %ZAP 1 @ZAP 1
+                /},
+                exports => {
+                    '&foo' => Fake::ExporterI->can('foo'),
+                    '&bar' => Fake::ExporterI->can('bar'),
+                    '&baz' => Fake::ExporterI->can('baz'),
+                    '&ick' => Fake::ExporterI->can('ick'),
+                    '&x' => Fake::ExporterI->can('__x'),
+                    '&z' => Fake::ExporterI->can('__z'),
+
+                    '&missing' => undef,
+
+                    '$ZAP' => \$Fake::ExporterI::ZAP,
+                    '@ZAP' => \@Fake::ExporterI::ZAP,
+                    '%ZAP' => \%Fake::ExporterI::ZAP,
+                },
+                tags => {
+                    b => [qw/bar baz/],
+                    DEFAULT => [qw/foo &bar $ZAP %ZAP @ZAP/],
+                },
+                fail => { '&ick' => 1, ick => 1 },
+            },
+            "Got menu"
+        );
+
+        is($gen->('gena')->(), 'a', "generated a");
+        is($gen->('genb')->(), 'b', "generated b");
+
+        $one = $CLASS->new(from => 'Fake::ExporterI2', caller => ['fake', 'fake.pl', 42]);
+        $menu = $one->reload_menu('fake');
+        is($menu->{generate}, \&Fake::ExporterI2::generate, "can provide custom generate")
     };
 
-    my $fail = @$export_fail ? {
-        map {
-            my ($sig, $name) = (m/^(\W?)(.*)$/);
-            $sig ||= '&';
-            ("${sig}${name}" => 1)
-        } @$export_fail
-    } : undef;
-
-    my $lookup = { map { $_ => 1 } @$export, @$export_ok };
-
-    $self->{menu_for} = $into;
-    return $self->{menu} = {
-        lookup   => $lookup,
-        exports  => $exports,
-        tags     => $tags,
-        fail     => $fail,
-        generate => $generate,
+    subtest OLD_STYLE => sub {
+        {
+            package Fake::ExporterE;
+            our @EXPORT      = qw/foo &bar $ZAP %ZAP @ZAP/;
+            our @EXPORT_OK   = qw/baz ick missing/;
+            our %EXPORT_TAGS = (b => [qw/bar baz/]);
+            our @EXPORT_FAIL = qw/ick/;
+            our %EXPORT_ANON = (x => \&__x, z => \&__z);
+            our %EXPORT_GEN  = (
+                'gena' => sub {
+                    sub { 'a' }
+                },
+                '&genb' => sub {
+                    sub { 'b' }
+                },
+            );
+
+            sub foo { 'foo' }
+            sub bar { 'bar' }
+            sub baz { 'baz' }
+            sub ick { 'ick' }
+            sub __x { 'x' }
+            sub __z { 'z' }
+
+            # These are here to insure 'exports' does not pull them in, they are listed as generate
+            sub gena { sub { 'oops, should not see this' } }
+            sub genb { sub { 'oops, should not see this' } }
+
+            # These are here to insure 'exports' does not pull them in, refs were provided by anon
+            sub x { sub { 'oops, should not see this' } }
+            sub y { sub { 'oops, should not see this' } }
+        }
+
+        my $one = $CLASS->new(from => 'Fake::ExporterE', caller => ['fake', 'fake.pl', 42]);
+        my $menu = $one->reload_menu('fake');
+        is($one->{menu_for}, 'fake', "remember who it was generated for");
+        ok(my $gen = delete $menu->{generate}, "got a generate function");
+
+        is_deeply(
+            $menu,
+            {
+                lookup => {qw/
+                    foo 1       &foo 1
+                    bar 1       &bar 1
+                    baz 1       &baz 1
+                    ick 1       &ick 1
+                    missing 1   &missing 1
+                    x 1         &x 1
+                    z 1         &z 1
+                    gena 1      &gena 1
+                    genb 1      &genb 1
+
+                    $ZAP 1 %ZAP 1 @ZAP 1
+                /},
+                exports => {
+                    '&foo' => Fake::ExporterE->can('foo'),
+                    '&bar' => Fake::ExporterE->can('bar'),
+                    '&baz' => Fake::ExporterE->can('baz'),
+                    '&ick' => Fake::ExporterE->can('ick'),
+                    '&x' => Fake::ExporterE->can('__x'),
+                    '&z' => Fake::ExporterE->can('__z'),
+
+                    '&missing' => undef,
+
+                    '$ZAP' => \$Fake::ExporterE::ZAP,
+                    '@ZAP' => \@Fake::ExporterE::ZAP,
+                    '%ZAP' => \%Fake::ExporterE::ZAP,
+                },
+                tags => {
+                    b => [qw/bar baz/],
+                    DEFAULT => [qw/foo &bar $ZAP %ZAP @ZAP/],
+                },
+                fail => { '&ick' => 1, ick => 1 },
+            },
+            "Got menu"
+        );
+
+        is($gen->('gena')->(), 'a', "generated a");
+        is($gen->('genb')->(), 'b', "generated b");
     };
-}
 
+};
+
+done_testing;
+
+__END__
 
 
 sub parse_args {
@@ -280,7 +481,8 @@ sub parse_args {
     my @import;
     my @versions;
 
-    while(my $arg = shift @args) {
+    while(my $full_arg = shift @args) {
+        my $arg = $full_arg;
         my $lead = substr($arg, 0, 1);
         my ($spec, $exc);
 
@@ -341,6 +543,9 @@ sub parse_args {
             $exclude{$_} = 1 for @list;
         }
         else {
+            $self->croak("Cannot use '-as' to rename multiple symbols included by: $full_arg")
+                if $spec->{'-as'} && @list > 1;
+
             push @import => [$_, $spec] for @list;
         }
     }
@@ -348,7 +553,6 @@ sub parse_args {
     return ($into, \@versions, \%exclude, \@import);
 }
 
-
 sub _handle_fail {
     my $self = shift;
     my ($into, $import) = @_;
@@ -401,7 +605,7 @@ sub _set_symbols {
     for my $set (@$import) {
         my ($symbol, $spec) = @$set;
 
-        my ($sig, $name) = ($symbol =~ m/^(\W?)(.*)$/);
+        my ($sig, $name) = ($symbol =~ m/^(\W)(.*)$/);
 
         # Find the thing we are actually shoving in a new namespace
         my $ref = $menu->{exports}->{$symbol};
@@ -428,51 +632,87 @@ sub _set_symbols {
     }
 }
 
-sub do_import {
-    my $self = shift;
-
-    my ($into, $versions, $exclude, $import) = $self->parse_args(@_);
-
-    # Exporter supported multiple version numbers being listed...
-    _version_check($self->from, $self->get_caller, @$versions) if @$versions;
+#########################################################
+## The rest of these are utility functions, not methods!
 
-    return unless @$import;
+sub _version_check {
+    my ($mod, $caller, @versions) = @_;
 
-    $self->_handle_fail($into, $import) if $self->menu($into)->{fail};
-    $self->_set_symbols($into, $exclude, $import);
+    eval <<"    EOT" or die $@;
+#line $caller->[2] "$caller->[1]"
+\$mod->VERSION(\$_) for \@versions;
+1;
+    EOT
 }
 
-sub do_unimport {
-    my $self = shift;
+sub _mod_to_file {
+    my $file = shift;
+    $file =~ s{::}{/}g;
+    $file .= '.pm';
+    return $file;
+}
 
-    my $from = $self->from;
-    my $imported = $IMPORTED{$from} || $self->croak("'$from' does not have any imports to remove");
+sub _load_file {
+    my ($caller, $file) = @_;
 
-    my %allowed = map { $_ => 1 } @$imported;
+    eval <<"    EOT" || die $@;
+#line $caller->[2] "$caller->[1]"
+require \$file;
+    EOT
+}
 
-    my @args = @_ ? @_ : @$imported;
+sub _optimal_import {
+    my ($from, $into, @args) = @_;
 
+    my %final;
     no strict 'refs';
-    my $stash = \%{"$from\::"};
+    return 0 if @{"$from\::EXPORT_FAIL"};
+    @args = @{"$from\::EXPORT"} unless @args;
+    my %allowed = map +($_ => 1), @{"$from\::EXPORT"}, @{"$from\::EXPORT_OK"};
     use strict 'refs';
 
-    for my $name (@args) {
-        $name =~ s/^&//;
+    for my $arg (@args) {
+        # Get sigil, or first letter of name
+        my $sig = substr($arg, 0, 1);
 
-        $self->croak("Sub '$name' was not imported using " . ref($self)) unless $allowed{$name};
+        # Return if non-sub sigil
+        return 0 if $NON_OPTIMAL{$sig};
 
-        no warnings 'once';
-        my $glob = delete $stash->{$name};
-        local *GLOBCLONE = *$glob;
+        # Strip sigil (if sub)
+        my $name = $arg;
+        substr($name, 0, 1, '') if $sig eq '&';
 
-        for my $type (qw/SCALAR HASH ARRAY FORMAT IO/) {
-            next unless defined(*{$glob}{$type});
-            no strict 'refs';
-            *{"$from\::$name"} = *{$glob}{$type}
-        }
+        # Check if the name is allowed (with or without sigil)
+        return 0 unless $allowed{$name} || $allowed{$arg};
+
+        no strict 'refs';
+        $final{$name} = \&{"$from\::$name"};
     }
+
+    no strict 'refs';
+    (*{"$into\::$_"} = $final{$_}, push @{$IMPORTED{$into}} => $_) for keys %final;
+
+    return 1;
 }
 
+sub exporter_import {
+    my $from = shift;
+
+    my @caller = caller(0);
+
+    return unless @_;
+
+    my $file = _mod_to_file($from);
+    _load_file(\@caller, $file) unless $INC{$file};
+
+    return if _optimal_import($from, $caller[0], @_);
+
+    my $self = __PACKAGE__->new(
+        from   => $from,
+        caller => \@caller,
+    );
+
+    $self->do_import($caller[0], @_);
+}
 
-1;