From: Arthur Axel 'fREW' Schmidt Date: Sun, 29 Jul 2012 21:38:45 +0000 (-0500) Subject: initial commit X-Git-Tag: v0.001000~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6d823d74158ba9d985bef9e69af8d33e07ed1a72;p=p5sagit%2FSub-Exporter-Progressive.git initial commit --- 6d823d74158ba9d985bef9e69af8d33e07ed1a72 diff --git a/.gitignore b/.gitignore new file mode 100644 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 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 index 0000000..af46e2d --- /dev/null +++ b/dist.ini @@ -0,0 +1,28 @@ +name = Sub-Exporter-Progressive +author = Arthur Axel "fREW" Schmidt +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 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 is an incredibly powerful module, but with that power comes +great responsibility, er- as well as some runtime penalties. This module +is a C wrapper that will let your users just use L +if all they are doing is picking exports, but use C if your +users try to use C'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 to work. Additionally, if your package uses advanced +C features like currying, this module will only ever use +C, so you might as well use it directly. diff --git a/t/basic.t b/t/basic.t new file mode 100644 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 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 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 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;