lib/Sub/Exporter/Progressive.pm

   1 package Sub::Exporter::Progressive;
   2
   3 # ABSTRACT: Only use Sub::Exporter if you need it
   4
   5 use strict;
   6 use warnings;
   7
   8 use List::Util 'first';
   9
  10 sub import {
  11    my ($self, @args) = @_;
  12
  13    my $inner_target = caller(0);
  14    my ($TOO_COMPLICATED, $export_data) = sub_export_options(@args);
  15
  16    if ($TOO_COMPLICATED) {
  17       warn <<'WARNING';
  18 You are using Sub::Exporter::Progressive, but the features your program uses from
  19 Sub::Exporter cannot be implemented without Sub::Exporter, so you might as well
  20 just use vanilla Sub::Exporter
  21 WARNING
  22       require Sub::Exporter;
  23       goto \&Sub::Exporter::import;
  24    }
  25    else {
  26       my $full_exporter;
  27       no strict;
  28       @{"${inner_target}::EXPORT_OK"} = @{$export_data->{exports}};
  29       @{"${inner_target}::EXPORT"} = @{$export_data->{defaults}};
  30       *{"${inner_target}::import"} = sub {
  31          use strict;
  32          my ($self, @args) = @_;
  33
  34          if (first { ref || !m/^\w+$/ } @args) {
  35             require Sub::Exporter;
  36             $full_exporter ||=
  37                Sub::Exporter::build_exporter($export_data->{original});
  38
  39             goto $full_exporter;
  40          } else {
  41             require Exporter;
  42             goto \&Exporter::import;
  43          }
  44       };
  45    }
  46 }
  47
  48 sub sub_export_options {
  49    my ($setup, $options) = @_;
  50
  51    my $TOO_COMPLICATED = 0;
  52
  53    my @exports;
  54    my @defaults;
  55
  56    if ($setup eq '-setup') {
  57       my %options = %$options;
  58
  59       OPTIONS:
  60       for my $opt (keys %options) {
  61          if ($opt eq 'exports') {
  62
  63             $TOO_COMPLICATED = 1, last OPTIONS
  64                if ref $options{exports} ne 'ARRAY';
  65
  66             @exports = @{$options{exports}};
  67
  68             $TOO_COMPLICATED = 1, last OPTIONS
  69                if first { ref } @exports;
  70
  71          } elsif ($opt eq 'groups') {
  72
  73             $TOO_COMPLICATED = 1, last OPTIONS
  74                if first { $_ ne 'default' } keys %{$options{groups}};
  75
  76             @defaults = @{$options{groups}{default} || [] };
  77             @defaults = @exports if $defaults[0] eq '-all';
  78          } else {
  79             $TOO_COMPLICATED = 1;
  80             last OPTIONS
  81          }
  82       }
  83    }
  84
  85    return $TOO_COMPLICATED, {
  86       exports => \@exports,
  87       defaults => \@defaults,
  88       original => $options,
  89    }
  90 }
  91
  92 1;
  93
  94 =head1 SYNOPSIS
  95
  96  package Syntax::Keyword::Gather;
  97
  98  use Sub::Exporter::Progressive -setup => {
  99    exports => [qw( break gather gathered take )],
 100    groups => {
 101      defaults => [qw( break gather gathered take )],
 102    },
 103  };
 104
 105  # elsewhere
 106
 107  # uses Exporter for speed
 108  use Syntax::Keyword::Gather;
 109
 110  # somewhere else
 111
 112  # uses Sub::Exporter for features
 113  use Syntax::Keyword::Gather 'gather', take => { -as => 'grab' };
 114
 115 =head1 DESCRIPTION
 116
 117 L<Sub::Exporter> is an incredibly powerful module, but with that power comes
 118 great responsibility, er- as well as some runtime penalties.  This module
 119 is a C<Sub::Exporter> wrapper that will let your users just use L<Exporter>
 120 if all they are doing is picking exports, but use C<Sub::Exporter> if your
 121 users try to use C<Sub::Exporter>'s more advanced features features, like
 122 renaming exports, if they try to use them.
 123
 124 Note that this module will export C<@EXPORT> and C<@EXPORT_OK> package
 125 variables for C<Exporter> to work.  Additionally, if your package uses advanced
 126 C<Sub::Exporter> features like currying, this module will only ever use
 127 C<Sub::Exporter>, so you might as well use it directly.