lib/Sub/Exporter/Progressive.pm

   1 package Sub::Exporter::Progressive;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.001004';
   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    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 ($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    }
  80
  81    return $TOO_COMPLICATED, {
  82       exports => \@exports,
  83       defaults => \@defaults,
  84       original => $options,
  85    }
  86 }
  87
  88 1;
  89
  90 =head1 NAME
  91
  92 Sub::Exporter::Progressive - Only use Sub::Exporter if you need it
  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.
 128
 129 =head1 AUTHOR
 130
 131 frew - Arthur Axel Schmidt (cpan:FREW) <frioux+cpan@gmail.com>
 132
 133 =head1 CONTRIBUTORS
 134
 135 ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) <ilmari@ilmari.org>
 136
 137 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
 138
 139 =head1 COPYRIGHT
 140
 141 Copyright (c) 2012 the Sub::Exporter::Progressive L</AUTHOR> and
 142 L</CONTRIBUTORS> as listed above.
 143
 144 =head1 LICENSE
 145
 146 This library is free software and may be distributed under the same terms
 147 as perl itself.
 148
 149 =cut