lib/Sub/Exporter/Progressive.pm

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