lib/Sub/Exporter/Progressive.pm

   1 package Sub::Exporter::Progressive;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.001005';
   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($inner_target, @args);
  15
  16    die <<'DEATH' if $TOO_COMPLICATED;
  17 You are using Sub::Exporter::Progressive, but the features your program uses from
  18 Sub::Exporter cannot be implemented without Sub::Exporter, so you might as well
  19 just use vanilla Sub::Exporter
  20 DEATH
  21
  22    my $full_exporter;
  23    no strict;
  24    @{"${inner_target}::EXPORT_OK"} = @{$export_data->{exports}};
  25    @{"${inner_target}::EXPORT"} = @{$export_data->{defaults}};
  26    *{"${inner_target}::import"} = sub {
  27       use strict;
  28       my ($self, @args) = @_;
  29
  30       if (first { ref || !m/^\w+$/ } @args) {
  31          die 'your usage of Sub::Exporter::Progressive requires Sub::Exporter to be installed'
  32             unless eval { require Sub::Exporter };
  33          $full_exporter ||=
  34             Sub::Exporter::build_exporter($export_data->{original});
  35
  36          goto $full_exporter;
  37       } else {
  38          require Exporter;
  39          goto \&Exporter::import;
  40       }
  41    };
  42 }
  43
  44 sub sub_export_options {
  45    my ($inner_target, $setup, $options) = @_;
  46
  47    my $TOO_COMPLICATED = 0;
  48
  49    my @exports;
  50    my @defaults;
  51
  52    if ($setup eq '-setup') {
  53       my %options = %$options;
  54
  55       OPTIONS:
  56       for my $opt (keys %options) {
  57          if ($opt eq 'exports') {
  58
  59             $TOO_COMPLICATED = 1, last OPTIONS
  60                if ref $options{exports} ne 'ARRAY';
  61
  62             @exports = @{$options{exports}};
  63
  64             $TOO_COMPLICATED = 1, last OPTIONS
  65                if first { ref } @exports;
  66
  67          } elsif ($opt eq 'groups') {
  68
  69             $TOO_COMPLICATED = 1, last OPTIONS
  70                if first { $_ ne 'default' } keys %{$options{groups}};
  71
  72             @defaults = @{$options{groups}{default} || [] };
  73          } else {
  74             $TOO_COMPLICATED = 1;
  75             last OPTIONS
  76          }
  77       }
  78       @defaults = @exports if @defaults && $defaults[0] eq '-all';
  79       my @errors = grep { my $default = $_; !grep { $default eq $_ } @exports } @defaults;
  80       die join(', ', @errors) . " is not exported by the $inner_target module\n" if @errors;
  81    }
  82
  83    return $TOO_COMPLICATED, {
  84       exports => \@exports,
  85       defaults => \@defaults,
  86       original => $options,
  87    }
  88 }
  89
  90 1;
  91
  92 =encoding utf8
  93
  94 =head1 NAME
  95
  96 Sub::Exporter::Progressive - Only use Sub::Exporter if you need it
  97
  98 =head1 SYNOPSIS
  99
 100  package Syntax::Keyword::Gather;
 101
 102  use Sub::Exporter::Progressive -setup => {
 103    exports => [qw( break gather gathered take )],
 104    groups => {
 105      defaults => [qw( break gather gathered take )],
 106    },
 107  };
 108
 109  # elsewhere
 110
 111  # uses Exporter for speed
 112  use Syntax::Keyword::Gather;
 113
 114  # somewhere else
 115
 116  # uses Sub::Exporter for features
 117  use Syntax::Keyword::Gather 'gather', take => { -as => 'grab' };
 118
 119 =head1 DESCRIPTION
 120
 121 L<Sub::Exporter> is an incredibly powerful module, but with that power comes
 122 great responsibility, er- as well as some runtime penalties.  This module
 123 is a C<Sub::Exporter> wrapper that will let your users just use L<Exporter>
 124 if all they are doing is picking exports, but use C<Sub::Exporter> if your
 125 users try to use C<Sub::Exporter>'s more advanced features features, like
 126 renaming exports, if they try to use them.
 127
 128 Note that this module will export C<@EXPORT> and C<@EXPORT_OK> package
 129 variables for C<Exporter> to work.  Additionally, if your package uses advanced
 130 C<Sub::Exporter> features like currying, this module will only ever use
 131 C<Sub::Exporter>, so you might as well use it directly.
 132
 133 =head1 AUTHOR
 134
 135 frew - Arthur Axel Schmidt (cpan:FREW) <frioux+cpan@gmail.com>
 136
 137 =head1 CONTRIBUTORS
 138
 139 ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) <ilmari@ilmari.org>
 140
 141 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
 142
 143 =head1 COPYRIGHT
 144
 145 Copyright (c) 2012 the Sub::Exporter::Progressive L</AUTHOR> and
 146 L</CONTRIBUTORS> as listed above.
 147
 148 =head1 LICENSE
 149
 150 This library is free software and may be distributed under the same terms
 151 as perl itself.
 152
 153 =cut