initial commit

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..e28a87f
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,14 @@
+*.swp
+Build
+_build
+*.bak
+*.old
+blib
+*gz
+inc
+pm_to_blib
+Makefile
+MANIFEST
+META.yml
+README
+Sub-Exporter-Progressive-*

diff --git a/Changes b/Changes
new file mode 100644 (file)
index 0000000..b2c398a
--- /dev/null
+++ b/Changes
@@ -0,0 +1,5 @@
+Revision history for {{$dist->name}}
+
+{{$NEXT}}
+  - Initial Release
+

diff --git a/dist.ini b/dist.ini
new file mode 100644 (file)
index 0000000..af46e2d
--- /dev/null
+++ b/dist.ini
@@ -0,0 +1,28 @@
+name             = Sub-Exporter-Progressive
+author           = Arthur Axel "fREW" Schmidt <frioux+cpan@gmail.com>
+license          = Perl_5
+copyright_holder = Arthur Axel "fREW" Schmidt
+version          = 0.001000
+
+[NextRelease]
+[@Git]
+[@Filter]
+bundle = @Basic
+remove = MetaYAML
+
+[MetaResources]
+repository.url    = git://github.com/frioux/Sub-Exporter-Progressive.git
+repository.web    = http://github.com/frioux/Sub-Exporter-Progressive
+repository.type   = git
+
+[MetaJSON]
+[PodWeaver]
+[PkgVersion]
+[ReadmeFromPod]
+[PodSyntaxTests]
+
+[Prereqs]
+Sub::Exporter    = 0
+Exporter         = 0
+List::Util       = 0
+

diff --git a/lib/Sub/Exporter/Progressive.pm b/lib/Sub/Exporter/Progressive.pm
new file mode 100644 (file)
index 0000000..e77ca34
--- /dev/null
+++ b/lib/Sub/Exporter/Progressive.pm
@@ -0,0 +1,127 @@
+package Sub::Exporter::Progressive;
+
+# ABSTRACT: Only use Sub::Exporter if you need it
+
+use strict;
+use warnings;
+
+use List::Util 'first';
+
+sub import {
+   my ($self, @args) = @_;
+
+   my $inner_target = caller(0);
+   my ($TOO_COMPLICATED, $export_data) = sub_export_options(@args);
+
+   if ($TOO_COMPLICATED) {
+      warn <<'WARNING';
+You are using Sub::Exporter::Progressive, but the features your program uses from
+Sub::Exporter cannot be implemented without Sub::Exporter, so you might as well
+just use vanilla Sub::Exporter
+WARNING
+      require Sub::Exporter;
+      goto \&Sub::Exporter::import;
+   }
+   else {
+      my $full_exporter;
+      no strict;
+      @{"${inner_target}::EXPORT_OK"} = @{$export_data->{exports}};
+      @{"${inner_target}::EXPORT"} = @{$export_data->{defaults}};
+      *{"${inner_target}::import"} = sub {
+         use strict;
+         my ($self, @args) = @_;
+
+         if (first { ref || !m/^\w+$/ } @args) {
+            require Sub::Exporter;
+            $full_exporter ||=
+               Sub::Exporter::build_exporter($export_data->{original});
+
+            goto $full_exporter;
+         } else {
+            require Exporter;
+            goto \&Exporter::import;
+         }
+      };
+   }
+}
+
+sub sub_export_options {
+   my ($setup, $options) = @_;
+
+   my $TOO_COMPLICATED = 0;
+
+   my @exports;
+   my @defaults;
+
+   if ($setup eq '-setup') {
+      my %options = %$options;
+
+      OPTIONS:
+      for my $opt (keys %options) {
+         if ($opt eq 'exports') {
+
+            $TOO_COMPLICATED = 1, last OPTIONS
+               if ref $options{exports} ne 'ARRAY';
+
+            @exports = @{$options{exports}};
+
+            $TOO_COMPLICATED = 1, last 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} || [] };
+            @defaults = @exports if $defaults[0] eq '-all';
+         } else {
+            $TOO_COMPLICATED = 1;
+            last OPTIONS
+         }
+      }
+   }
+
+   return $TOO_COMPLICATED, {
+      exports => \@exports,
+      defaults => \@defaults,
+      original => $options,
+   }
+}
+
+1;
+
+=head1 SYNOPSIS
+
+ package Syntax::Keyword::Gather;
+
+ use Sub::Exporter::Progressive -setup => {
+   exports => [qw( break gather gathered take )],
+   groups => {
+     defaults => [qw( break gather gathered take )],
+   },
+ };
+
+ # elsewhere
+
+ # uses Exporter for speed
+ use Syntax::Keyword::Gather;
+
+ # somewhere else
+
+ # uses Sub::Exporter for features
+ use Syntax::Keyword::Gather 'gather', take => { -as => 'grab' };
+
+=head1 DESCRIPTION
+
+L<Sub::Exporter> is an incredibly powerful module, but with that power comes
+great responsibility, er- as well as some runtime penalties.  This module
+is a C<Sub::Exporter> wrapper that will let your users just use L<Exporter>
+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.

diff --git a/t/basic.t b/t/basic.t
new file mode 100644 (file)
index 0000000..5a841d1
--- /dev/null
+++ b/t/basic.t
@@ -0,0 +1,13 @@
+
+use strict;
+use warnings;
+
+use Test::More;
+use List::Util 'first';
+use lib 't/lib';
+use A::Junk 'junk1';
+
+ok(main->can('junk1'), 'requested sub exported');
+ok(! $INC{'Sub/Exporter.pm'}, 'Sub::Exporter not loaded');
+
+done_testing;

diff --git a/t/default.t b/t/default.t
new file mode 100644 (file)
index 0000000..f7eb327
--- /dev/null
+++ b/t/default.t
@@ -0,0 +1,13 @@
+
+use strict;
+use warnings;
+
+use Test::More;
+use List::Util 'first';
+use lib 't/lib';
+use A::Junk;
+
+ok(main->can('junk2'), 'sub exported');
+ok(! $INC{'Sub/Exporter.pm'}, 'Sub::Exporter not loaded');
+
+done_testing;

diff --git a/t/lib/A/Junk.pm b/t/lib/A/Junk.pm
new file mode 100644 (file)
index 0000000..3f0d7c8
--- /dev/null
+++ b/t/lib/A/Junk.pm
@@ -0,0 +1,13 @@
+package A::Junk;
+
+use Sub::Exporter::Progressive -setup => {
+  exports => [qw(junk1)],
+  groups => {
+     default => ['junk2'],
+  },
+};
+
+sub junk1 { 1 }
+sub junk2 { 1 }
+
+1;

diff --git a/t/sex.t b/t/sex.t
new file mode 100644 (file)
index 0000000..7f5f0e1
--- /dev/null
+++ b/t/sex.t
@@ -0,0 +1,13 @@
+
+use strict;
+use warnings;
+
+use Test::More;
+use List::Util 'first';
+use lib 't/lib';
+use A::Junk 'junk1' => { -as => 'junk' };
+
+ok(main->can('junk'), 'sub renamed with Sub::Exporter');
+ok($INC{'Sub/Exporter.pm'}, 'Sub::Exporter loaded');
+
+done_testing;