Removed undocumented groups feature Moose::Exporter and updated tests accordingly.
Dave Rolsky [Mon, 7 Sep 2009 16:52:50 +0000 (11:52 -0500)]
The feature was good in spirit, but the implementation was very odd, and
basically undocumentable because of its complexity.

I moved some tests from the groups tests to
t/050_metaclasses/012_moose_exporter.t, since there were also useful tests for
prototype handling and with_meta mixed in with the groups tests.

lib/Moose/Exporter.pm
t/050_metaclasses/012_moose_exporter.t
t/050_metaclasses/024_moose_exporter_groups.t [deleted file]

index 1cff223..53f2249 100644 (file)
@@ -37,14 +37,14 @@ sub build_import_methods {
 
     my $export_recorder = {};
 
-    my ( $exports, $is_removable, $groups )
+    my ( $exports, $is_removable )
         = $class->_make_sub_exporter_params(
         [ @exports_from, $exporting_package ], $export_recorder );
 
     my $exporter = Sub::Exporter::build_exporter(
         {
             exports => $exports,
-            groups  => { default => [':all'], %$groups }
+            groups  => { default => [':all'] }
         }
     );
 
@@ -119,7 +119,6 @@ sub _make_sub_exporter_params {
     my $packages          = shift;
     my $export_recorder   = shift;
 
-    my %groups;
     my %exports;
     my %is_removable;
 
@@ -127,17 +126,6 @@ sub _make_sub_exporter_params {
         my $args = $EXPORT_SPEC{$package}
             or die "The $package package does not use Moose::Exporter\n";
 
-        # one group for each 'also' package
-        $groups{$package} = [
-            @{ $args->{with_meta}   || [] },
-            @{ $args->{with_caller} || [] },
-            @{ $args->{as_is}       || [] },
-            (
-                map {":$_"}
-                    keys %{ $args->{groups} || {} }
-            )
-        ];
-
         for my $name ( @{ $args->{with_meta} } ) {
             my $sub = do {
                 no strict 'refs';
@@ -206,26 +194,9 @@ sub _make_sub_exporter_params {
 
             $exports{$name} = sub {$sub};
         }
-
-        for my $name ( keys %{ $args->{groups} } ) {
-            my $group = $args->{groups}{$name};
-
-            if (ref $group eq 'CODE') {
-                $groups{$name} = $class->_make_wrapped_group(
-                    $package,
-                    $group,
-                    $export_recorder,
-                    \%exports,
-                    \%is_removable
-                );
-            }
-            elsif (ref $group eq 'ARRAY') {
-                $groups{$name} = $group;
-            }
-        }
     }
 
-    return ( \%exports, \%is_removable, \%groups );
+    return ( \%exports, \%is_removable );
 }
 
 our $CALLER;
index bb474fd..5e59d8f 100644 (file)
@@ -8,7 +8,7 @@ use Test::Exception;
 BEGIN {
     eval "use Test::Output;";
     plan skip_all => "Test::Output is required for this test" if $@;
-    plan tests => 47;
+    plan tests => 62;
 }
 
 
@@ -72,13 +72,13 @@ BEGIN {
     use Moose ();
 
     sub wrapped1 {
-        my $caller = shift;
-        return $caller . ' called wrapped1';
+        my $meta = shift;
+        return $meta->name . ' called wrapped1';
     }
 
     Moose::Exporter->setup_import_methods(
-        with_caller => ['wrapped1'],
-        also        => 'Moose',
+        with_meta => ['wrapped1'],
+        also      => 'Moose',
     );
 }
 
@@ -291,3 +291,70 @@ BEGIN {
     ok( ! WantsSugar->can('with'), 'WantsSugar::with() has been cleaned' );
 }
 
+{
+    package AllOptions;
+    use Moose ();
+    use Moose::Exporter;
+
+    Moose::Exporter->setup_import_methods(
+        also        => ['Moose'],
+        with_meta   => [ 'with_meta1', 'with_meta2' ],
+        with_caller => [ 'with_caller1', 'with_caller2' ],
+        as_is       => ['as_is1'],
+    );
+
+    sub with_caller1 {
+        return @_;
+    }
+
+    sub with_caller2 (&) {
+        return @_;
+    }
+
+    sub as_is1 {2}
+
+    sub with_meta1 {
+        return @_;
+    }
+
+    sub with_meta2 (&) {
+        return @_;
+    }
+}
+
+{
+    package UseAllOptions;
+
+    AllOptions->import();
+}
+
+{
+    can_ok( 'UseAllOptions', $_ )
+        for qw( with_meta1 with_meta2 with_caller1 with_caller2 as_is1 );
+
+    {
+        my ( $caller, $arg1 ) = UseAllOptions::with_caller1(42);
+        is( $caller, 'UseAllOptions', 'with_caller wrapped sub gets the right caller' );
+        is( $arg1, 42, 'with_caller wrapped sub returns argument it was passed' );
+    }
+
+    {
+        my ( $meta, $arg1 ) = UseAllOptions::with_meta1(42);
+        isa_ok( $meta, 'Moose::Meta::Class', 'with_meta first argument' );
+        is( $arg1, 42, 'with_meta1 returns argument it was passed' );
+    }
+
+    is(
+        prototype( UseAllOptions->can('with_meta2') ),
+        prototype( AllOptions->can('with_meta2') ),
+        'using correct prototype on with_meta function'
+    );
+
+    {
+        package UseAllOptions;
+        AllOptions->unimport();
+    }
+
+    ok( ! UseAllOptions->can($_), "UseAllOptions::$_ has been unimported" )
+        for qw( with_meta1 with_meta2 with_caller1 with_caller2 as_is1 );
+}
diff --git a/t/050_metaclasses/024_moose_exporter_groups.t b/t/050_metaclasses/024_moose_exporter_groups.t
deleted file mode 100755 (executable)
index 7b831a9..0000000
+++ /dev/null
@@ -1,216 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 45;
-use Test::Exception;
-
-{
-
-    package ExGroups1;
-    use Moose::Exporter;
-    use Moose ();
-
-    Moose::Exporter->setup_import_methods(
-        also        => ['Moose'],
-        with_meta   => [ 'with_meta1', 'with_meta2' ],
-        with_caller => ['default_export1'],
-        as_is       => ['default_export2'],
-        groups      => {
-            all_group => [':all'],
-            just_one  => ['default_export1']
-        }
-    );
-
-    sub default_export1 {1}
-    sub default_export2 {2}
-
-    sub with_meta1 {
-        return @_;
-    }
-
-    sub with_meta2 (&) {
-        return @_;
-    }
-}
-
-{
-
-    package UseAllGroup;
-
-    ExGroups1->import(':all_group');
-
-    ::can_ok( __PACKAGE__, 'with_meta1' );
-    ::can_ok( __PACKAGE__, 'default_export1' );
-    ::can_ok( __PACKAGE__, 'default_export2' );
-    ::can_ok( __PACKAGE__, 'has' );
-
-    my ( $meta, $arg1 ) = with_meta1(42);
-    ::isa_ok( $meta, 'Moose::Meta::Class', 'with_meta first argument' );
-    ::is( $arg1, 42, 'with_meta1 returns argument it was passed' );
-
-    ::is(
-        prototype( __PACKAGE__->can('with_meta2') ),
-        prototype( ExGroups1->can('with_meta2') ),
-        'using correct prototype on with_meta function'
-    );
-
-    ExGroups1->unimport();
-
-    ::ok( !__PACKAGE__->can('with_meta1'),
-        __PACKAGE__ . '::with_meta1() has been cleaned' );
-    ::ok( !__PACKAGE__->can('default_export1'),
-        __PACKAGE__ . '::default_export1() has been cleaned' );
-    ::ok( !__PACKAGE__->can('default_export2'),
-        __PACKAGE__ . '::default_export2() has been cleaned' );
-    ::ok( !__PACKAGE__->can('has'),
-        __PACKAGE__ . '::has() has been cleaned' );
-}
-
-{
-
-    package UseJustOne;
-
-    ExGroups1->import(':just_one');
-
-    ::can_ok( __PACKAGE__, 'default_export1' );
-    ::ok( !__PACKAGE__->can('default_export2'),
-        __PACKAGE__ . '::default_export2() was not imported' );
-    ::ok( !__PACKAGE__->can('has'),
-        __PACKAGE__ . '::has() was not imported' );
-
-    ExGroups1->unimport();
-
-    ::ok( !__PACKAGE__->can('default_export1'),
-        __PACKAGE__ . '::default_export1() has been cleared' );
-}
-
-{
-
-    package ExGroups2;
-    use Moose::Exporter;
-
-    Moose::Exporter->setup_import_methods(
-        also        => ['ExGroups1'],
-        as_is       => ['exgroups2_as_is'],
-        with_caller => ['exgroups2_with_caller'],
-        groups      => {
-            default    => ['exgroups2_as_is'],
-            code_group => \&generate_group,
-            parent1    => [qw(:ExGroups1 :code_group)],
-            parent2    => [qw(:all)]
-        }
-    );
-
-    sub exgroups2_as_is {3}
-
-    sub generate_group {
-        my ( $caller, $group_name, $args, $context ) = @_;
-
-        ::is( $group_name, 'code_group',
-            'original name is passed to group code' );
-        ::is( $args->{install_as}, $caller . '_code',
-            'group code arguments match caller' );
-        ::is( $context->{from}, __PACKAGE__,
-            'defined package name is passed to group code' );
-
-        return { $args->{install_as} => \&exported_by_group };
-    }
-
-    sub exported_by_group (&) {
-        my ( $caller, $coderef ) = @_;
-        return $caller;
-    }
-}
-
-{
-
-    package UseDefault;
-
-    ExGroups2->import;
-
-    ::can_ok( __PACKAGE__, 'exgroups2_as_is' );
-    ::ok( !__PACKAGE__->can('exgroups2_with_caller'),
-        '"default" group is no longer "all"' );
-}
-
-{
-
-    package UseCodeGroup;
-
-    ExGroups2->import( ':code_group',
-        { install_as => ( my $export_name = __PACKAGE__ . '_code' ) } );
-
-    ::can_ok( __PACKAGE__, $export_name );
-    ::ok( &UseCodeGroup_code() eq __PACKAGE__,
-        'code group exports act like "with_caller" subs' );
-    ::lives_ok(
-        sub {
-            UseCodeCodeGroup_code { return 'code block'; };
-        },
-        'code group exports keep their prototypes'
-    );
-
-    ::ok( !__PACKAGE__->can('exgroups2_as_is'),
-        'code group will not automatically export any symbols' );
-
-    ExGroups2->unimport;
-
-    ::ok(
-        !__PACKAGE__->can($export_name),
-        'dynamically-named '
-            . __PACKAGE__
-            . "::$export_name() has been cleared"
-    );
-}
-
-{
-
-    package UseParent1;
-
-    ExGroups2->import( ':parent1',
-        { install_as => ( my $export_name = __PACKAGE__ . '_code' ) } );
-
-    ::can_ok( __PACKAGE__, $export_name );
-    ::can_ok( __PACKAGE__, 'default_export1' );
-    ::can_ok( __PACKAGE__, 'default_export2' );
-    ::can_ok( __PACKAGE__, 'has' );
-
-    ExGroups2->unimport;
-
-    ::ok( !__PACKAGE__->can($export_name),
-        __PACKAGE__ . "::$export_name() has been cleared" );
-    ::ok( !__PACKAGE__->can('default_export1'),
-        __PACKAGE__ . '::default_export1() has been cleaned' );
-    ::ok( !__PACKAGE__->can('default_export2'),
-        __PACKAGE__ . '::default_export2() has been cleaned' );
-    ::ok( !__PACKAGE__->can('has'),
-        __PACKAGE__ . '::has() has been cleaned' );
-}
-
-{
-
-    package UseParent2;
-
-    ExGroups2->import( ':parent2',
-        { install_as => ( my $export_name = __PACKAGE__ . '_code' ) } );
-
-    ::ok( !__PACKAGE__->can($export_name),
-        '"all" group will not call code groups' );
-    ::can_ok( __PACKAGE__, 'exgroups2_as_is' );
-    ::can_ok( __PACKAGE__, 'exgroups2_with_caller' );
-    ::can_ok( __PACKAGE__, 'default_export1' );
-    ::can_ok( __PACKAGE__, 'has' );
-
-    ExGroups2->unimport;
-
-    ::ok( !__PACKAGE__->can('exgroups2_as_is'),
-        __PACKAGE__ . '::exgroups2_as_is() has been cleaned' );
-    ::ok( !__PACKAGE__->can('exgroups2_with_caller'),
-        __PACKAGE__ . '::exgroups2_with_caller() has been cleaned' );
-    ::ok( !__PACKAGE__->can('default_export1'),
-        __PACKAGE__ . '::default_export1() has been cleaned' );
-    ::ok( !__PACKAGE__->can('has'),
-        __PACKAGE__ . '::has() has been cleaned' );
-}