From: Leon Timmermans <fawaka@gmail.com>
Date: Sat, 11 Aug 2012 11:24:25 +0000 (+0300)
Subject: Add support for tags
X-Git-Tag: v0.001005~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=47825557a84208a5bcf2e4b4fcae63a462d5abdf;p=p5sagit%2FSub-Exporter-Progressive.git

Add support for tags
---

diff --git a/Changes b/Changes
index 9f0680e..77b9698 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,4 @@
+  - Add support for tags
   - Warn if defaults are not in exports
 
 0.001004 - 2012-08-09
diff --git a/lib/Sub/Exporter/Progressive.pm b/lib/Sub/Exporter/Progressive.pm
index 53fe5a3..0496648 100644
--- a/lib/Sub/Exporter/Progressive.pm
+++ b/lib/Sub/Exporter/Progressive.pm
@@ -23,11 +23,12 @@ DEATH
    no strict;
    @{"${inner_target}::EXPORT_OK"} = @{$export_data->{exports}};
    @{"${inner_target}::EXPORT"} = @{$export_data->{defaults}};
+   %{"${inner_target}::EXPORT_TAGS"} = %{$export_data->{tags}};
    *{"${inner_target}::import"} = sub {
       use strict;
       my ($self, @args) = @_;
 
-      if (first { ref || !m/^\w+$/ } @args) {
+      if (first { ref || !m/^:?\w+$/ } @args) {
          die 'your usage of Sub::Exporter::Progressive requires Sub::Exporter to be installed'
             unless eval { require Sub::Exporter };
          $full_exporter ||=
@@ -48,6 +49,7 @@ sub sub_export_options {
 
    my @exports;
    my @defaults;
+   my %tags;
 
    if ($setup eq '-setup') {
       my %options = %$options;
@@ -65,17 +67,17 @@ sub sub_export_options {
                if first { ref } @exports;
 
          } elsif ($opt eq 'groups') {
-
-            $TOO_COMPLICATED = 1, last OPTIONS
-               if first { $_ ne 'default' } keys %{$options{groups}};
-
-            @defaults = @{$options{groups}{default} || [] };
+            %tags = %{$options{groups}};
+            for my $tagset (values %tags) {
+               $TOO_COMPLICATED = 1 if first { /^-(?!all\b)/ || ref } @{$tagset};
+            }
+            @defaults = @{$tags{default} || [] };
          } else {
             $TOO_COMPLICATED = 1;
             last OPTIONS
          }
       }
-      @defaults = @exports if @defaults && $defaults[0] eq '-all';
+      @{$_} = map { $_ eq '-all' ? @exports : $_ } @{$_} for \@defaults, values %tags;
       my @errors = grep { my $default = $_; !grep { $default eq $_ } @exports } @defaults;
       die join(', ', @errors) . " is not exported by the $inner_target module\n" if @errors;
    }
@@ -84,6 +86,7 @@ sub sub_export_options {
       exports => \@exports,
       defaults => \@defaults,
       original => $options,
+      tags => \%tags,
    }
 }
 
@@ -125,10 +128,10 @@ if all they are doing is picking exports, but use C<Sub::Exporter> if your
 users try to use C<Sub::Exporter>'s more advanced features features, like
 renaming exports, if they try to use them.
 
-Note that this module will export C<@EXPORT> and C<@EXPORT_OK> package
-variables for C<Exporter> to work.  Additionally, if your package uses advanced
-C<Sub::Exporter> features like currying, this module will only ever use
-C<Sub::Exporter>, so you might as well use it directly.
+Note that this module will export C<@EXPORT>, C<@EXPORT_OK> and
+C<%EXPORT_TAGS> package variables for C<Exporter> to work.  Additionally, if
+your package uses advanced C<Sub::Exporter> features like currying, this module
+will only ever use C<Sub::Exporter>, so you might as well use it directly.
 
 =head1 AUTHOR
 
diff --git a/t/lib/A/Junk.pm b/t/lib/A/Junk.pm
index 112344b..a5eab20 100644
--- a/t/lib/A/Junk.pm
+++ b/t/lib/A/Junk.pm
@@ -1,13 +1,15 @@
 package A::Junk;
 
 use Sub::Exporter::Progressive -setup => {
-  exports => [qw(junk1 junk2)],
+  exports => [qw(junk1 junk2 junk3)],
   groups => {
      default => ['junk2'],
+     other => ['junk3'],
   },
 };
 
 sub junk1 { 1 }
 sub junk2 { 1 }
+sub junk3 { 1 }
 
 1;
diff --git a/t/tags.t b/t/tags.t
new file mode 100644
index 0000000..a94e706
--- /dev/null
+++ b/t/tags.t
@@ -0,0 +1,15 @@
+use strict;
+use warnings;
+
+use Test::More 0.89;
+use List::Util 'first';
+use lib 't/lib';
+use A::Junk ':other';
+
+ok(!main->can('junk1'), 'junk1 not exported');
+ok(!main->can('junk2'), 'junk2 not exported');
+ok(main->can('junk3'), 'junk3 exported');
+ok(! $INC{'Sub/Exporter.pm'}, 'Sub::Exporter not loaded');
+
+done_testing;
+