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