Add export_on_use feature

4 files changed, 60 insertions, 3 deletions

diff --git a/Changes b/Changes
index 9379f5b..3f908cd 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 {{$NEXT}}
 
+    - Add on_use/sub EXPORT_ON_USE { ... } feature
+
 0.016     2016-08-20 21:41:34-07:00 America/Los_Angeles (TRIAL RELEASE)
 
     - Add polish to version-sets
diff --git a/lib/Importer.pm b/lib/Importer.pm
index 2571d75..df60c74 100644
--- a/lib/Importer.pm
+++ b/lib/Importer.pm
@@ -333,6 +333,7 @@ sub reload_menu {
         $got{export_anon}     = \%{"$from\::EXPORT_ANON"};
         $got{export_magic}    = \%{"$from\::EXPORT_MAGIC"};
         $got{export_versions} = \%{"$from\::EXPORT_VERSIONS"};
+        $got{export_on_use}   = \&{"$from\::EXPORT_ON_USE"} if defined *{"$from\::EXPORT_ON_USE"}{CODE};
 
         return $self->_build_menu($into => \%got, 0);
     }
@@ -353,6 +354,8 @@ sub _build_menu {
     my $export_gen   = $got->{export_gen}      || {};
     my $export_vers  = $got->{export_versions} || {};
 
+    my $export_on_use = $got->{export_on_use};
+
     my $generate = $got->{generate};
     $generate ||= sub {
         my $symbol = shift;
@@ -428,6 +431,7 @@ sub _build_menu {
             fail     => $fail,
             generate => $generate,
             magic    => $export_magic,
+            on_use   => $export_on_use,
         },
     };
     for my $v (keys %$export_vers) {
@@ -469,10 +473,19 @@ sub _build_menu {
                 }
             }
 
+            $vd->{on_use} ||= $common->{on_use} if $common->{on_use};
+
             # Update the tag added for the version
             my %seen = ();
             @{$tags->{$v}} = grep { !$seen{$_} } @{$tags->{$v}}, @{$common->{tags}->{DEFAULT}};
         }
+
+        for my $tag (qw/DEFAULT ALL/) {
+            my %seen;
+            @{$tags->{$tag}} = grep { !$seen{$_} } @{$tags->{$tag}}, @{$common->{tags}->{$tag}};
+        }
+
+        %$exports = ( %{$common->{exports}}, %$exports );
     }
 
     $self->{menu_for} = $into;
@@ -484,6 +497,7 @@ sub _build_menu {
         generate => $generate,
         magic    => $export_magic,
         versions => $versions,
+        on_use   => $export_on_use,
     };
 }
 
@@ -629,17 +643,22 @@ sub { *{"$into\\::\$_[0]"} = \$_[1] }
     EOT
 
     my $menu = $main_menu;
-    my $ver = "";
+    my $ver = 'v0';
+    my $ver_str = "";
+    my %used;
     for my $set (@$import) {
         my ($symbol, $spec) = @$set;
 
         my ($sig, $name) = ($symbol =~ m/^(\W)(.*)$/) or die "Invalid symbol: $symbol";
         if ($sig eq '+') {
-            $ver = "version-set $name ";
+            $ver = $name;
+            $ver_str = "version-set $name ";
             $menu = $main_menu->{versions}->{$name};
             next;
         }
 
+        $menu->{on_use}->($ver) if $menu->{on_use} && !$used{$ver}++;
+
         # Find the thing we are actually shoving in a new namespace
         my $ref = $menu->{exports}->{$symbol};
         $ref ||= $menu->{generate}->($symbol) if $menu->{generate};
@@ -647,7 +666,7 @@ sub { *{"$into\\::\$_[0]"} = \$_[1] }
         # 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.
-        $self->croak("$from ${ver}does not export $symbol") unless $ref || $menu->{lookup}->{"${sig}${name}"};
+        $self->croak("$from ${ver_str}does not export $symbol") unless $ref || $menu->{lookup}->{"${sig}${name}"};
         next unless $ref;
 
         my $type = ref($ref);
@@ -717,6 +736,7 @@ my %HEAVY_VARS = (
     EXPORT_GEN    => 'HASH',  # Origin package has generators
     EXPORT_ANON   => 'HASH',  # Origin package has anonymous exports
     EXPORT_MAGIC  => 'HASH',  # Origin package has magic to apply post-export
+    EXPORT_ON_ISE => 'CODE',  # Origin package has on-use callback
 );
 
 sub optimal_import {
diff --git a/t/units.t b/t/units.t
index 099ac81..63f53e0 100644
--- a/t/units.t
+++ b/t/units.t
@@ -292,6 +292,7 @@ subtest reload_menu => sub {
                 fail     => undef,
                 generate => undef,
                 magic    => {},
+                on_use   => undef,
             },
             "Got valid, but empty menu"
         );
@@ -392,6 +393,7 @@ subtest reload_menu => sub {
                 },
                 fail => { '&ick' => 1, ick => 1 },
                 magic => {},
+                on_use => undef,
             },
             "Got menu"
         );
@@ -480,6 +482,7 @@ subtest reload_menu => sub {
                 },
                 fail => { '&ick' => 1, ick => 1 },
                 magic => {},
+                on_use => undef,
             },
             "Got menu"
         );
diff --git a/t/versions.t b/t/versions.t
index ff4d201..2bb8061 100644
--- a/t/versions.t
+++ b/t/versions.t
@@ -3,6 +3,8 @@ use warnings;
 
 use Importer 'Test::More';
 
+our %USED;
+
 BEGIN {
     $INC{'My/Exporter.pm'} = 1;
     package My::Exporter;
@@ -11,6 +13,11 @@ BEGIN {
     sub y { 'y' }
     sub z { 'z' }
 
+    my $on_use = sub {
+        return unless $main::ON_USE;
+        $main::USED{$_[0]}++;
+    };
+
     sub IMPORTER_MENU {
         return (
             export_anon => {
@@ -20,10 +27,12 @@ BEGIN {
                 d => sub { 'd0' },
                 e => sub { 'e0' },
             },
+            export_on_use => $on_use,
             export_versions => {
                 '*' => {
                     export => [qw/x/],
                     export_ok => [qw/y z/],
+                    export_on_use => $on_use,
                     generate => sub {
                         my $symbol = shift;
                         my ($sig, $name) = ($symbol =~ m/^(\W?)(.*)$/);
@@ -55,6 +64,7 @@ BEGIN {
                 },
                 v2 => {
                     export => [qw/a b c/],
+                    export_on_use => sub { $on_use->(@_), $main::USED{v2_2} = 'yes' },
                     export_anon => {
                         a => sub { 'a2' },
                         b => sub { 'b2' },
@@ -105,4 +115,26 @@ BEGIN {
     ::ok(!__PACKAGE__->can('d'), "Did not import d()");
 }
 
+
+$main::ON_USE = 1;
+{
+    package My::On::Use::A;
+    Importer->import('My::Exporter');
+    ::can_ok(__PACKAGE__, 'x');
+    ::is($main::USED{v0}, 1, "noted that we used v0");
+
+    package My::On::Use::B;
+    Importer->import('My::Exporter');
+    ::is($main::USED{v0}, 2, "noted that we used v0 again");
+
+    package My::On::Use::C;
+    Importer->import('My::Exporter', ':v1');
+    ::is($main::USED{v1}, 1, "noted that we used v1");
+
+    package My::On::Use::D;
+    Importer->import('My::Exporter', ':v2');
+    ::is($main::USED{v2}, 1, "noted that we used v2");
+    ::is($main::USED{v2_2}, 'yes', "Used the v2 specific on_use sub");
+}
+
 done_testing;