Added the "also" param to Moose::Exporter, which allows you to say you

want to export what some other package(s) are exporting.

Wrote a bunch of tests for this.

Renamed the old extending & embedding test to indicate that it's just
for back compat now.

diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm
index a6eb924..c49bc0b 100644 (file)
--- a/lib/Moose/Exporter.pm
+++ b/lib/Moose/Exporter.pm
@@ -5,6 +5,7 @@ use warnings;
 
 use Class::MOP;
 use namespace::clean 0.08 ();
+use List::MoreUtils qw( uniq );
 use Sub::Exporter;
 
 
@@ -18,10 +19,10 @@ sub build_import_methods {
 
     $EXPORT_SPEC{$exporting_package} = \%args;
 
-    my $exports = $class->_process_exports(
-        exporting_package => $exporting_package,
-        %args,
-    );
+    my @exports_from = $class->_follow_also( $exporting_package );
+
+    my $exports
+        = $class->_process_exports( $exporting_package, @exports_from );
 
     my $exporter = Sub::Exporter::build_exporter(
         {
@@ -42,36 +43,81 @@ sub build_import_methods {
     *{ $exporting_package . '::unimport' } = $unimport;
 }
 
-sub _process_exports {
-    my $class = shift;
-    my %args  = @_;
+{
+    my %seen;
 
-    my $exporting_package = $args{exporting_package};
+    sub _follow_also {
+        my $class             = shift;
+        my $exporting_package = shift;
 
-    my %exports;
-    for my $name ( @{ $args{with_caller} } ) {
-        my $sub
-            = do { no strict 'refs'; \&{ $exporting_package . '::' . $name } };
+        %seen = ( $exporting_package => 1 );
 
-        $exports{$name}
-            = $class->_make_wrapped_sub( $exporting_package, $name, $sub );
+        return uniq( _follow_also_real($exporting_package) );
     }
 
-    for my $name ( @{ $args{as_is} } ) {
-        my $sub;
+    sub _follow_also_real {
+        my $exporting_package = shift;
+
+        die "Package in also ($exporting_package) does not seem to use MooseX::Exporter"
+            unless exists $EXPORT_SPEC{$exporting_package};
+
+        my $also = $EXPORT_SPEC{$exporting_package}{also};
+
+        return unless defined $also;
+
+        my @also = ref $also ? @{$also} : $also;
+
+        for my $package (@also)
+        {
+            die "Circular reference in also parameter to MooseX::Exporter between $exporting_package and $package"
+                if $seen{$package};
 
-        if ( ref $name ) {
-            $sub  = $name;
-            $name = ( Class::MOP::get_code_info($name) )[1];
+            $seen{$package} = 1;
         }
-        else {
-            $sub = do {
+
+        return @also, map { _follow_also_real($_) } @also;
+    }
+}
+
+sub _process_exports {
+    my $class    = shift;
+    my @packages = @_;
+
+    my %exports;
+
+    for my $package (@packages) {
+        my $args = $EXPORT_SPEC{$package}
+            or die "The $package package does not use Moose::Exporter\n";
+
+        for my $name ( @{ $args->{with_caller} } ) {
+            my $sub = do {
                 no strict 'refs';
-                \&{ $exporting_package . '::' . $name };
+                \&{ $package . '::' . $name };
             };
+
+            $exports{$name} = $class->_make_wrapped_sub(
+                $package,
+                $name,
+                $sub
+            );
         }
 
-        $exports{$name} = sub {$sub};
+        for my $name ( @{ $args->{as_is} } ) {
+            my $sub;
+
+            if ( ref $name ) {
+                $sub  = $name;
+                $name = ( Class::MOP::get_code_info($name) )[1];
+            }
+            else {
+                $sub = do {
+                    no strict 'refs';
+                    \&{ $package . '::' . $name };
+                };
+            }
+
+            $exports{$name} = sub {$sub};
+        }
     }
 
     return \%exports;

diff --git a/t/050_metaclasses/010_extending_and_embedding.t b/t/050_metaclasses/010_extending_and_embedding_back_compat.t
similarity index 100%
rename from t/050_metaclasses/010_extending_and_embedding.t
rename to t/050_metaclasses/010_extending_and_embedding_back_compat.t

diff --git a/t/050_metaclasses/012_moose_exporter.t b/t/050_metaclasses/012_moose_exporter.t
new file mode 100644 (file)
index 0000000..efeb1d6
--- /dev/null
+++ b/t/050_metaclasses/012_moose_exporter.t
@@ -0,0 +1,182 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+use Test::Exception;
+
+# All the BEGIN blocks are necessary to emulate the behavior of
+# loading modules via use and the similar compile-time effect of "no
+# ..."
+{
+    package MooseX::Empty;
+
+    use Moose ();
+    BEGIN { Moose::Exporter->build_import_methods( also => 'Moose' ); }
+}
+
+{
+    package WantsMoose;
+
+    BEGIN { MooseX::Empty->import(); }
+
+    sub foo { 1 }
+
+    BEGIN {
+        ::can_ok( 'WantsMoose', 'has' );
+        ::can_ok( 'WantsMoose', 'with' );
+        ::can_ok( 'WantsMoose', 'foo' );
+    }
+
+    BEGIN{ MooseX::Empty->unimport();}
+}
+
+{
+    ok( ! WantsMoose->can('has'),  'WantsMoose::has() has been cleaned' );
+    ok( ! WantsMoose->can('with'), 'WantsMoose::with() has been cleaned' );
+    can_ok( 'WantsMoose', 'foo' );
+}
+
+{
+    package MooseX::Sugar;
+
+    use Moose ();
+
+    sub wrapped1 {
+        my $caller = shift;
+        return $caller . ' called wrapped1';
+    }
+
+    BEGIN {
+        Moose::Exporter->build_import_methods(
+            with_caller => ['wrapped1'],
+            also        => 'Moose',
+        );
+    }
+}
+
+{
+    package WantsSugar;
+
+    BEGIN { MooseX::Sugar->import() }
+
+    sub foo { 1 }
+
+    BEGIN {
+        ::can_ok( 'WantsSugar', 'has' );
+        ::can_ok( 'WantsSugar', 'with' );
+        ::can_ok( 'WantsSugar', 'wrapped1' );
+        ::can_ok( 'WantsSugar', 'foo' );
+        ::is( wrapped1(), 'WantsSugar called wrapped1',
+              'wrapped1 identifies the caller correctly' );
+    }
+
+    BEGIN{ MooseX::Sugar->unimport();}
+}
+
+{
+    ok( ! WantsSugar->can('has'),  'WantsSugar::has() has been cleaned' );
+    ok( ! WantsSugar->can('with'), 'WantsSugar::with() has been cleaned' );
+    ok( ! WantsSugar->can('wrapped1'), 'WantsSugar::wrapped1() has been cleaned' );
+    can_ok( 'WantsSugar', 'foo' );
+}
+
+{
+    package MooseX::MoreSugar;
+
+    use Moose ();
+
+    sub wrapped2 {
+        my $caller = shift;
+        return $caller . ' called wrapped2';
+    }
+
+    sub as_is1 {
+        return 'as_is1';
+    }
+
+    BEGIN {
+        Moose::Exporter->build_import_methods(
+            with_caller => ['wrapped2'],
+            as_is       => ['as_is1'],
+            also        => 'MooseX::Sugar',
+        );
+    }
+}
+
+{
+    package WantsMoreSugar;
+
+    BEGIN { MooseX::MoreSugar->import() }
+
+    sub foo { 1 }
+
+    BEGIN {
+        ::can_ok( 'WantsMoreSugar', 'has' );
+        ::can_ok( 'WantsMoreSugar', 'with' );
+        ::can_ok( 'WantsMoreSugar', 'wrapped1' );
+        ::can_ok( 'WantsMoreSugar', 'wrapped2' );
+        ::can_ok( 'WantsMoreSugar', 'as_is1' );
+        ::can_ok( 'WantsMoreSugar', 'foo' );
+        ::is( wrapped1(), 'WantsMoreSugar called wrapped1',
+              'wrapped1 identifies the caller correctly' );
+        ::is( wrapped2(), 'WantsMoreSugar called wrapped2',
+              'wrapped2 identifies the caller correctly' );
+        ::is( as_is1(), 'as_is1',
+              'as_is1 works as expected' );
+    }
+
+    BEGIN{ MooseX::MoreSugar->unimport();}
+}
+
+{
+    ok( ! WantsMoreSugar->can('has'),  'WantsMoreSugar::has() has been cleaned' );
+    ok( ! WantsMoreSugar->can('with'), 'WantsMoreSugar::with() has been cleaned' );
+    ok( ! WantsMoreSugar->can('wrapped1'), 'WantsMoreSugar::wrapped1() has been cleaned' );
+    ok( ! WantsMoreSugar->can('wrapped2'), 'WantsMoreSugar::wrapped2() has been cleaned' );
+    ok( ! WantsMoreSugar->can('as_is1'), 'WantsMoreSugar::as_is1() has been cleaned' );
+    can_ok( 'WantsMoreSugar', 'foo' );
+}
+
+{
+    package MooseX::CircularAlso;
+
+    use Moose ();
+
+    ::dies_ok(
+        sub {
+            Moose::Exporter->build_import_methods(
+                also => [ 'Moose', 'MooseX::CircularAlso' ],
+            );
+        },
+        'a circular reference in also dies with an error'
+    );
+
+    ::like(
+        $@,
+        qr/\QCircular reference in also parameter to MooseX::Exporter between MooseX::CircularAlso and MooseX::CircularAlso/,
+        'got the expected error from circular reference in also'
+    );
+}
+
+{
+    package MooseX::CircularAlso;
+
+    use Moose ();
+
+    ::dies_ok(
+        sub {
+            Moose::Exporter->build_import_methods(
+                also => [ 'NoSuchThing' ],
+            );
+        },
+        'a package which does not use Moose::Exporter in also dies with an error'
+    );
+
+    ::like(
+        $@,
+        qr/\QPackage in also (NoSuchThing) does not seem to use MooseX::Exporter/,
+        'got the expected error from a reference in also to a package which does not use Moose::Exporter'
+    );
+}