lib/Sub/Exporter/Progressive.pm

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