File Coverage

blib/lib/Sub/Exporter.pm

Criterion	Covered	Total	%
statement	174	181	96.1
branch	92	98	93.8
condition	51	55	92.7
subroutine	24	25	96.0
pod	4	5	80.0
total	345	364	94.7

use v5.12.0;
use warnings;
package Sub::Exporter 0.991;
# ABSTRACT: a sophisticated exporter for custom-built routines

use Carp ();
use Data::OptList 0.100 ();
use Params::Util 0.14 (); # _CODELIKE
use Sub::Install 0.92 ();

#pod =head1 SYNOPSIS
#pod
#pod Sub::Exporter must be used in two places.  First, in an exporting module:
#pod
#pod   # in the exporting module:
#pod   package Text::Tweaker;
#pod   use Sub::Exporter -setup => {
#pod     exports => [
#pod       qw(squish titlecase), # always works the same way
#pod       reformat => \&build_reformatter, # generator to build exported function
#pod       trim     => \&build_trimmer,
#pod       indent   => \&build_indenter,
#pod     ],
#pod     collectors => [ 'defaults' ],
#pod   };
#pod
#pod Then, in an importing module:
#pod
#pod   # in the importing module:
#pod   use Text::Tweaker
#pod     'squish',
#pod     indent   => { margin => 5 },
#pod     reformat => { width => 79, justify => 'full', -as => 'prettify_text' },
#pod     defaults => { eol => 'CRLF' };
#pod
#pod With this setup, the importing module ends up with three routines: C,
#pod C, and C.  The latter two have been built to the
#pod specifications of the importer -- they are not just copies of the code in the
#pod exporting package.
#pod
#pod =head1 DESCRIPTION
#pod
#pod B  If you're not familiar with Exporter or exporting, read
#pod L first!
#pod
#pod =head2 Why Generators?
#pod
#pod The biggest benefit of Sub::Exporter over existing exporters (including the
#pod ubiquitous Exporter.pm) is its ability to build new coderefs for export, rather
#pod than to simply export code identical to that found in the exporting package.
#pod
#pod If your module's consumers get a routine that works like this:
#pod
#pod   use Data::Analyze qw(analyze);
#pod   my $value = analyze($data, $tolerance, $passes);
#pod
#pod and they constantly pass only one or two different set of values for the
#pod non-C<$data> arguments, your code can benefit from Sub::Exporter.  By writing a
#pod simple generator, you can let them do this, instead:
#pod
#pod   use Data::Analyze
#pod     analyze => { tolerance => 0.10, passes => 10, -as => analyze10 },
#pod     analyze => { tolerance => 0.15, passes => 50, -as => analyze50 };
#pod
#pod   my $value = analyze10($data);
#pod
#pod The package with the generator for that would look something like this:
#pod
#pod   package Data::Analyze;
#pod   use Sub::Exporter -setup => {
#pod     exports => [
#pod       analyze => \&build_analyzer,
#pod     ],
#pod   };
#pod
#pod   sub build_analyzer {
#pod     my ($class, $name, $arg) = @_;
#pod
#pod     return sub {
#pod       my $data      = shift;
#pod       my $tolerance = shift || $arg->{tolerance};
#pod       my $passes    = shift || $arg->{passes};
#pod
#pod       analyze($data, $tolerance, $passes);
#pod     }
#pod   }
#pod
#pod Your module's user now has to do less work to benefit from it -- and remember,
#pod you're often your own user!  Investing in customized subroutines is an
#pod investment in future laziness.
#pod
#pod This also avoids a common form of ugliness seen in many modules: package-level
#pod configuration.  That is, you might have seen something like the above
#pod implemented like so:
#pod
#pod   use Data::Analyze qw(analyze);
#pod   $Data::Analyze::default_tolerance = 0.10;
#pod   $Data::Analyze::default_passes    = 10;
#pod
#pod This might save time, until you have multiple modules using Data::Analyze.
#pod Because there is only one global configuration, they step on each other's toes
#pod and your code begins to have mysterious errors.
#pod
#pod Generators can also allow you to export class methods to be called as
#pod subroutines:
#pod
#pod   package Data::Methodical;
#pod   use Sub::Exporter -setup => { exports => { some_method => \&_curry_class } };
#pod
#pod   sub _curry_class {
#pod     my ($class, $name) = @_;
#pod     sub { $class->$name(@_); };
#pod   }
#pod
#pod Because of the way that exporters and Sub::Exporter work, any package that
#pod inherits from Data::Methodical can inherit its exporter and override its
#pod C.  If a user imports C from that package, he'll
#pod receive a subroutine that calls the method on the subclass, rather than on
#pod Data::Methodical itself.  Keep in mind that if you re-setup Sub::Exporter in a
#pod package that inherits from Data::Methodical you will, of course, be entirely
#pod replacing the exporter from Data::Methodical.  C is a method, and is
#pod hidden by the same means as any other method.
#pod
#pod =head2 Other Customizations
#pod
#pod Building custom routines with generators isn't the only way that Sub::Exporters
#pod allows the importing code to refine its use of the exported routines.  They may
#pod also be renamed to avoid naming collisions.
#pod
#pod Consider the following code:
#pod
#pod   # this program determines to which circle of Hell you will be condemned
#pod   use Morality qw(sin virtue); # for calculating viciousness
#pod   use Math::Trig qw(:all);     # for dealing with circles
#pod
#pod The programmer has inadvertently imported two C routines.  The solution,
#pod in Exporter.pm-based modules, would be to import only one and then call the
#pod other by its fully-qualified name.  Alternately, the importer could write a
#pod routine that did so, or could mess about with typeglobs.
#pod
#pod How much easier to write:
#pod
#pod   # this program determines to which circle of Hell you will be condemned
#pod   use Morality qw(virtue), sin => { -as => 'offense' };
#pod   use Math::Trig -all => { -prefix => 'trig_' };
#pod
#pod and to have at one's disposal C and C -- not to mention
#pod C and C.
#pod
#pod =head1 EXPORTER CONFIGURATION
#pod
#pod You can configure an exporter for your package by using Sub::Exporter like so:
#pod
#pod   package Tools;
#pod   use Sub::Exporter
#pod     -setup => { exports => [ qw(function1 function2 function3) ] };
#pod
#pod This is the simplest way to use the exporter, and is basically equivalent to
#pod this:
#pod
#pod   package Tools;
#pod   use base qw(Exporter);
#pod   our @EXPORT_OK = qw(function1 function2 function3);
#pod
#pod Any basic use of Sub::Exporter will look like this:
#pod
#pod   package Tools;
#pod   use Sub::Exporter -setup => \%config;
#pod
#pod The following keys are valid in C<%config>:
#pod
#pod   exports - a list of routines to provide for exporting; each routine may be
#pod             followed by generator
#pod   groups  - a list of groups to provide for exporting; each must be followed by
#pod             either (a) a list of exports, possibly with arguments for each
#pod             export, or (b) a generator
#pod
#pod   collectors - a list of names into which values are collected for use in
#pod                routine generation; each name may be followed by a validator
#pod
#pod In addition to the basic options above, a few more advanced options may be
#pod passed:
#pod
#pod   into_level - how far up the caller stack to look for a target (default 0)
#pod   into       - an explicit target (package) into which to export routines
#pod
#pod In other words: Sub::Exporter installs a C routine which, when called,
#pod exports routines to the calling namespace.  The C and C
#pod options change where those exported routines are installed.
#pod
#pod   generator  - a callback used to produce the code that will be installed
#pod                default: Sub::Exporter::default_generator
#pod
#pod   installer  - a callback used to install the code produced by the generator
#pod                default: Sub::Exporter::default_installer
#pod
#pod For information on how these callbacks are used, see the documentation for
#pod C> and C>.
#pod
#pod =head2 Export Configuration
#pod
#pod The C list may be provided as an array reference or a hash reference.
#pod The list is processed in such a way that the following are equivalent:
#pod
#pod   { exports => [ qw(foo bar baz), quux => \&quux_generator ] }
#pod
#pod   { exports =>
#pod     { foo => undef, bar => undef, baz => undef, quux => \&quux_generator } }
#pod
#pod Generators are code that return coderefs.  They are called with four
#pod parameters:
#pod
#pod   $class - the class whose exporter has been called (the exporting class)
#pod   $name  - the name of the export for which the routine is being build
#pod  \%arg   - the arguments passed for this export
#pod  \%col   - the collections for this import
#pod
#pod Given the configuration in the L, the following C statement:
#pod
#pod   use Text::Tweaker
#pod     reformat => { -as => 'make_narrow', width => 33 },
#pod     defaults => { eol => 'CR' };
#pod
#pod would result in the following call to C<&build_reformatter>:
#pod
#pod   my $code = build_reformatter(
#pod     'Text::Tweaker',
#pod     'reformat',
#pod     { width => 33 }, # note that -as is not passed in
#pod     { defaults => { eol => 'CR' } },
#pod   );
#pod
#pod The returned coderef (C<$code>) would then be installed as C in the
#pod calling package.
#pod
#pod Instead of providing a coderef in the configuration, a reference to a method
#pod name may be provided.  This method will then be called on the invocant of the
#pod C method.  (In this case, we do not pass the C<$class> parameter, as it
#pod would be redundant.)
#pod
#pod =head2 Group Configuration
#pod
#pod The C list can be passed in the same forms as C.  Groups must
#pod have values to be meaningful, which may either list exports that make up the
#pod group (optionally with arguments) or may provide a way to build the group.
#pod
#pod The simpler case is the first: a group definition is a list of exports.  Here's
#pod the example that could go in exporter in the L.
#pod
#pod   groups  => {
#pod     default    => [ qw(reformat) ],
#pod     shorteners => [ qw(squish trim) ],
#pod     email_safe => [
#pod       'indent',
#pod       reformat => { -as => 'email_format', width => 72 }
#pod     ],
#pod   },
#pod
#pod Groups are imported by specifying their name prefixed be either a dash or a
#pod colon.  This line of code would import the C group:
#pod
#pod   use Text::Tweaker qw(-shorteners);
#pod
#pod Arguments passed to a group when importing are merged into the groups options
#pod and passed to any relevant generators.  Groups can contain other groups, but
#pod looping group structures are ignored.
#pod
#pod The other possible value for a group definition, a coderef, allows one
#pod generator to build several exportable routines simultaneously.  This is useful
#pod when many routines must share enclosed lexical variables.  The coderef must
#pod return a hash reference.  The keys will be used as export names and the values
#pod are the subs that will be exported.
#pod
#pod This example shows a simple use of the group generator.
#pod
#pod   package Data::Crypto;
#pod   use Sub::Exporter -setup => { groups => { cipher => \&build_cipher_group } };
#pod
#pod   sub build_cipher_group {
#pod     my ($class, $group, $arg) = @_;
#pod     my ($encode, $decode) = build_codec($arg->{secret});
#pod     return { cipher => $encode, decipher => $decode };
#pod   }
#pod
#pod The C and C routines are built in a group because they are
#pod built together by code which encloses their secret in their environment.
#pod
#pod =head3 Default Groups
#pod
#pod If a module that uses Sub::Exporter is Cd with no arguments, it will try
#pod to export the group named C.  If that group has not been specifically
#pod configured, it will be empty, and nothing will happen.
#pod
#pod Another group is also created if not defined: C.  The C group
#pod contains all the exports from the exports list.
#pod
#pod =head2 Collector Configuration
#pod
#pod The C entry in the exporter configuration gives names which, when
#pod found in the import call, have their values collected and passed to every
#pod generator.
#pod
#pod For example, the C generator that we saw above could be
#pod rewritten as:
#pod
#pod  sub build_analyzer {
#pod    my ($class, $name, $arg, $col) = @_;
#pod
#pod    return sub {
#pod      my $data      = shift;
#pod      my $tolerance = shift || $arg->{tolerance} || $col->{defaults}{tolerance};
#pod      my $passes    = shift || $arg->{passes}    || $col->{defaults}{passes};
#pod
#pod      analyze($data, $tolerance, $passes);
#pod    }
#pod  }
#pod
#pod That would allow the importer to specify global defaults for his imports:
#pod
#pod   use Data::Analyze
#pod     'analyze',
#pod     analyze  => { tolerance => 0.10, -as => analyze10 },
#pod     analyze  => { tolerance => 0.15, passes => 50, -as => analyze50 },
#pod     defaults => { passes => 10 };
#pod
#pod   my $A = analyze10($data);     # equivalent to analyze($data, 0.10, 10);
#pod   my $C = analyze50($data);     # equivalent to analyze($data, 0.15, 50);
#pod   my $B = analyze($data, 0.20); # equivalent to analyze($data, 0.20, 10);
#pod
#pod If values are provided in the C list during exporter setup, they
#pod must be code references, and are used to validate the importer's values.  The
#pod validator is called when the collection is found, and if it returns false, an
#pod exception is thrown.  We could ensure that no one tries to set a global data
#pod default easily:
#pod
#pod   collectors => { defaults => sub { return (exists $_[0]->{data}) ? 0 : 1 } }
#pod
#pod Collector coderefs can also be used as hooks to perform arbitrary actions
#pod before anything is exported.
#pod
#pod When the coderef is called, it is passed the value of the collection and a
#pod hashref containing the following entries:
#pod
#pod   name        - the name of the collector
#pod   config      - the exporter configuration (hashref)
#pod   import_args - the arguments passed to the exporter, sans collections (aref)
#pod   class       - the package on which the importer was called
#pod   into        - the package into which exports will be exported
#pod
#pod Collectors with all-caps names (that is, made up of underscore or capital A
#pod through Z) are reserved for special use.  The only currently implemented
#pod special collector is C, whose hook (if present in the exporter
#pod configuration) is always run before any other hook.
#pod
#pod =head1 CALLING THE EXPORTER
#pod
#pod Arguments to the exporter (that is, the arguments after the module name in a
#pod C statement) are parsed as follows:
#pod
#pod First, the collectors gather any collections found in the arguments.  Any
#pod reference type may be given as the value for a collector.  For each collection
#pod given in the arguments, its validator (if any) is called.
#pod
#pod Next, groups are expanded.  If the group is implemented by a group generator,
#pod the generator is called.  There are two special arguments which, if given to a
#pod group, have special meaning:
#pod
#pod   -prefix - a string to prepend to any export imported from this group
#pod   -suffix - a string to append to any export imported from this group
#pod
#pod Finally, individual export generators are called and all subs, generated or
#pod otherwise, are installed in the calling package.  There is only one special
#pod argument for export generators:
#pod
#pod   -as     - where to install the exported sub
#pod
#pod Normally, C<-as> will contain an alternate name for the routine.  It may,
#pod however, contain a reference to a scalar.  If that is the case, a reference the
#pod generated routine will be placed in the scalar referenced by C<-as>.  It will
#pod not be installed into the calling package.
#pod
#pod =head2 Special Exporter Arguments
#pod
#pod The generated exporter accept some special options, which may be passed as the
#pod first argument, in a hashref.
#pod
#pod These options are:
#pod
#pod   into_level
#pod   into
#pod   generator
#pod   installer
#pod
#pod These override the same-named configuration options described in L
#pod CONFIGURATION>.
#pod
#pod =cut

# Given a potential import name, this returns the group name -- if it's got a
# group prefix.
sub _group_name {
  my ($name) = @_;

  return if (index q{-:}, (substr $name, 0, 1)) == -1;
  return substr $name, 1;
}

# \@groups is a canonicalized opt list of exports and groups this returns
# another canonicalized opt list with groups replaced with relevant exports.
# \%seen is groups we've already expanded and can ignore.
# \%merge is merged options from the group we're descending through.
sub _expand_groups {
  my ($class, $config, $groups, $collection, $seen, $merge) = @_;
  $seen  ||= {};
  $merge ||= {};
  my @groups = @$groups;

  for my $i (reverse 0 .. $#groups) {
    if (my $group_name = _group_name($groups[$i][0])) {
      my $seen = { %$seen }; # faux-dynamic scoping

      splice @groups, $i, 1,
        _expand_group($class, $config, $groups[$i], $collection, $seen, $merge);
    } else {
      # there's nothing to munge in this export's args
      next unless my %merge = %$merge;

      # we have things to merge in; do so
      my $prefix = (delete $merge{-prefix}) || '';
      my $suffix = (delete $merge{-suffix}) || '';

      if (
        Params::Util::_CODELIKE($groups[$i][1]) ## no critic Private
        or
        Params::Util::_SCALAR0($groups[$i][1]) ## no critic Private
      ) {
        # this entry was build by a group generator
        $groups[$i][0] = $prefix . $groups[$i][0] . $suffix;
      } else {
        my $as
          = ref $groups[$i][1]{-as} ? $groups[$i][1]{-as}
          :     $groups[$i][1]{-as} ? $prefix . $groups[$i][1]{-as} . $suffix
          :                           $prefix . $groups[$i][0]      . $suffix;

        $groups[$i][1] = { %{ $groups[$i][1] }, %merge, -as => $as };
      }
    }
  }

  return \@groups;
}

# \@group is a name/value pair from an opt list.
sub _expand_group {
  my ($class, $config, $group, $collection, $seen, $merge) = @_;
  $merge ||= {};

  my ($group_name, $group_arg) = @$group;
  $group_name = _group_name($group_name);

  Carp::croak qq(group "$group_name" is not exported by the $class module)
    unless exists $config->{groups}{$group_name};

  return if $seen->{$group_name}++;

  if (ref $group_arg) {
    my $prefix = (delete $merge->{-prefix}||'') . ($group_arg->{-prefix}||'');
    my $suffix = ($group_arg->{-suffix}||'') . (delete $merge->{-suffix}||'');
    $merge = {
      %$merge,
      %$group_arg,
      ($prefix ? (-prefix => $prefix) : ()),
      ($suffix ? (-suffix => $suffix) : ()),
    };
  }

  my $exports = $config->{groups}{$group_name};

  if (
    Params::Util::_CODELIKE($exports) ## no critic Private
    or
    Params::Util::_SCALAR0($exports) ## no critic Private
  ) {
    # I'm not very happy with this code for hiding -prefix and -suffix, but
    # it's needed, and I'm not sure, offhand, how to make it better.
    # -- rjbs, 2006-12-05
    my $group_arg = $merge ? { %$merge } : {};
    delete $group_arg->{-prefix};
    delete $group_arg->{-suffix};

    my $group = Params::Util::_CODELIKE($exports) ## no critic Private
              ? $exports->($class, $group_name, $group_arg, $collection)
              : $class->$$exports($group_name, $group_arg, $collection);

    Carp::croak qq(group generator "$group_name" did not return a hashref)
      if ref $group ne 'HASH';

    my $stuff = [ map { [ $_ => $group->{$_} ] } keys %$group ];
    return @{
      _expand_groups($class, $config, $stuff, $collection, $seen, $merge)
    };
  } else {
    $exports
      = Data::OptList::mkopt($exports, "$group_name exports");

    return @{
      _expand_groups($class, $config, $exports, $collection, $seen, $merge)
    };
  }
}

sub _mk_collection_builder {
  my ($col, $etc) = @_;
  my ($config, $import_args, $class, $into) = @$etc;

  my %seen;
  sub {
    my ($collection) = @_;
    my ($name, $value) = @$collection;

    Carp::croak "collection $name provided multiple times in import"
      if $seen{ $name }++;

    if (ref(my $hook = $config->{collectors}{$name})) {
      my $arg = {
        name        => $name,
        config      => $config,
        import_args => $import_args,
        class       => $class,
        into        => $into,
      };

      my $error_msg = "collection $name failed validation";
      if (Params::Util::_SCALAR0($hook)) { ## no critic Private
        Carp::croak $error_msg unless $class->$$hook($value, $arg);
      } else {
        Carp::croak $error_msg unless $hook->($value, $arg);
      }
    }

    $col->{ $name } = $value;
  }
}

# Given a config and pre-canonicalized importer args, remove collections from
# the args and return them.
sub _collect_collections {
  my ($config, $import_args, $class, $into) = @_;

  my @collections
    = map  { splice @$import_args, $_, 1 }
      grep { exists $config->{collectors}{ $import_args->[$_][0] } }
      reverse 0 .. $#$import_args;

  unshift @collections, [ INIT => {} ] if $config->{collectors}{INIT};

  my $col = {};
  my $builder = _mk_collection_builder($col, \@_);
  for my $collection (@collections) {
    $builder->($collection)
  }

  return $col;
}

#pod =head1 SUBROUTINES
#pod
#pod =head2 setup_exporter
#pod
#pod This routine builds and installs an C routine.  It is called with one
#pod argument, a hashref containing the exporter configuration.  Using this, it
#pod builds an exporter and installs it into the calling package with the name
#pod "import."  In addition to the normal exporter configuration, a few named
#pod arguments may be passed in the hashref:
#pod
#pod   into       - into what package should the exporter be installed
#pod   into_level - into what level up the stack should the exporter be installed
#pod   as         - what name should the installed exporter be given
#pod
#pod By default the exporter is installed with the name C into the immediate
#pod caller of C.  In other words, if your package calls
#pod C without providing any of the three above arguments, it will
#pod have an C routine installed.
#pod
#pod Providing both C and C will cause an exception to be thrown.
#pod
#pod The exporter is built by C>.
#pod
#pod =cut

sub setup_exporter {
  my ($config)  = @_;

  Carp::croak 'into and into_level may not both be supplied to exporter'
    if exists $config->{into} and exists $config->{into_level};

  my $as   = delete $config->{as}   || 'import';
  my $into
    = exists $config->{into}       ? delete $config->{into}
    : exists $config->{into_level} ? caller(delete $config->{into_level})
    :                                caller(0);

  my $import = build_exporter($config);

  Sub::Install::reinstall_sub({
    code => $import,
    into => $into,
    as   => $as,
  });
}

#pod =head2 build_exporter
#pod
#pod Given a standard exporter configuration, this routine builds and returns an
#pod exporter -- that is, a subroutine that can be installed as a class method to
#pod perform exporting on request.
#pod
#pod Usually, this method is called by C>, which then installs
#pod the exporter as a package's import routine.
#pod
#pod =cut

sub _key_intersection {
  my ($x, $y) = @_;
  my %seen = map { $_ => 1 } keys %$x;
  my @names = grep { $seen{$_} } keys %$y;
}

# Given the config passed to setup_exporter, which contains sugary opt list
# data, rewrite the opt lists into hashes, catch a few kinds of invalid
# configurations, and set up defaults.  Since the config is a reference, it's
# rewritten in place.
my %valid_config_key;
BEGIN {
  %valid_config_key =
    map { $_ => 1 }
    qw(as collectors installer generator exports groups into into_level),
    qw(exporter), # deprecated
}

sub _assert_collector_names_ok {
  my ($collectors) = @_;

  for my $reserved_name (grep { /\A[_A-Z]+\z/ } keys %$collectors) {
    Carp::croak "unknown reserved collector name: $reserved_name"
      if $reserved_name ne 'INIT';
  }
}

sub _rewrite_build_config {
  my ($config) = @_;

  if (my @keys = grep { not exists $valid_config_key{$_} } keys %$config) {
    Carp::croak "unknown options (@keys) passed to Sub::Exporter";
  }

  Carp::croak q(into and into_level may not both be supplied to exporter)
    if exists $config->{into} and exists $config->{into_level};

  # XXX: Remove after deprecation period.
  if ($config->{exporter}) {
    Carp::cluck "'exporter' argument to build_exporter is deprecated. Use 'installer' instead; the semantics are identical.";
    $config->{installer} = delete $config->{exporter};
  }

  Carp::croak q(into and into_level may not both be supplied to exporter)
    if exists $config->{into} and exists $config->{into_level};

  for (qw(exports collectors)) {
    $config->{$_} = Data::OptList::mkopt_hash(
      $config->{$_},
      $_,
      [ 'CODE', 'SCALAR' ],
    );
  }

  _assert_collector_names_ok($config->{collectors});

  if (my @names = _key_intersection(@$config{qw(exports collectors)})) {
    Carp::croak "names (@names) used in both collections and exports";
  }

  $config->{groups} = Data::OptList::mkopt_hash(
      $config->{groups},
      'groups',
      [
        'HASH',   # standard opt list
        'ARRAY',  # standard opt list
        'CODE',   # group generator
        'SCALAR', # name of group generation method
      ]
    );

  # by default, export nothing
  $config->{groups}{default} ||= [];

  # by default, build an all-inclusive 'all' group
  $config->{groups}{all} ||= [ keys %{ $config->{exports} } ];

  $config->{generator} ||= \&default_generator;
  $config->{installer} ||= \&default_installer;
}

sub build_exporter {
  my ($config) = @_;

  _rewrite_build_config($config);

  my $import = sub {
    my ($class) = shift;

    # XXX: clean this up -- rjbs, 2006-03-16
    my $special = (ref $_[0]) ? shift(@_) : {};
    Carp::croak q(into and into_level may not both be supplied to exporter)
      if exists $special->{into} and exists $special->{into_level};

    if ($special->{exporter}) {
      Carp::cluck "'exporter' special import argument is deprecated. Use 'installer' instead; the semantics are identical.";
      $special->{installer} = delete $special->{exporter};
    }

    my $into
      = defined $special->{into}       ? delete $special->{into}
      : defined $special->{into_level} ? caller(delete $special->{into_level})
      : defined $config->{into}        ? $config->{into}
      : defined $config->{into_level}  ? caller($config->{into_level})
      :                                  caller(0);

    my $generator = delete $special->{generator} || $config->{generator};
    my $installer = delete $special->{installer} || $config->{installer};

    # this builds a AOA, where the inner arrays are [ name => value_ref ]
    my $import_args = Data::OptList::mkopt([ @_ ]);

    # is this right?  defaults first or collectors first? -- rjbs, 2006-06-24
    $import_args = [ [ -default => undef ] ] unless @$import_args;

    my $collection = _collect_collections($config, $import_args, $class, $into);

    my $to_import = _expand_groups($class, $config, $import_args, $collection);

    # now, finally $import_arg is really the "to do" list
    _do_import(
      {
        class     => $class,
        col       => $collection,
        config    => $config,
        into      => $into,
        generator => $generator,
        installer => $installer,
      },
      $to_import,
    );
  };

  return $import;
}

sub _do_import {
  my ($arg, $to_import) = @_;

  my @todo;

  for my $pair (@$to_import) {
    my ($name, $import_arg) = @$pair;

    my ($generator, $as);

    if ($import_arg and Params::Util::_CODELIKE($import_arg)) { ## no critic
      # This is the case when a group generator has inserted name/code pairs.
      $generator = sub { $import_arg };
      $as = $name;
    } else {
      $import_arg = { $import_arg ? %$import_arg : () };

      Carp::croak qq("$name" is not exported by the $arg->{class} module)
        unless exists $arg->{config}{exports}{$name};

      $generator = $arg->{config}{exports}{$name};

      $as = exists $import_arg->{-as} ? (delete $import_arg->{-as}) : $name;
    }

    my $code = $arg->{generator}->(
      {
        class     => $arg->{class},
        name      => $name,
        arg       => $import_arg,
        col       => $arg->{col},
        generator => $generator,
      }
    );

    push @todo, $as, $code;
  }

  $arg->{installer}->(
    {
      class => $arg->{class},
      into  => $arg->{into},
      col   => $arg->{col},
    },
    \@todo,
  );
}

## Cute idea, possibly for future use: also supply an "unimport" for:
## no Module::Whatever qw(arg arg arg);
# sub _unexport {
#   my (undef, undef, undef, undef, undef, $as, $into) = @_;
#
#   if (ref $as eq 'SCALAR') {
#     undef $$as;
#   } elsif (ref $as) {
#     Carp::croak "invalid reference type for $as: " . ref $as;
#   } else {
#     no strict 'refs';
#     delete &{$into . '::' . $as};
#   }
# }

#pod =head2 default_generator
#pod
#pod This is Sub::Exporter's default generator.  It takes bits of configuration that
#pod have been gathered during the import and turns them into a coderef that can be
#pod installed.
#pod
#pod   my $code = default_generator(\%arg);
#pod
#pod Passed arguments are:
#pod
#pod   class - the class on which the import method was called
#pod   name  - the name of the export being generated
#pod   arg   - the arguments to the generator
#pod   col   - the collections
#pod
#pod   generator - the generator to be used to build the export (code or scalar ref)
#pod
#pod =cut

sub default_generator {
  my ($arg) = @_;
  my ($class, $name, $generator) = @$arg{qw(class name generator)};

  if (not defined $generator) {
    my $code = $class->can($name)
      or Carp::croak "can't locate exported subroutine $name via $class";
    return $code;
  }

  # I considered making this "$class->$generator(" but it seems that
  # overloading precedence would turn an overloaded-as-code generator object
  # into a string before code. -- rjbs, 2006-06-11
  return $generator->($class, $name, $arg->{arg}, $arg->{col})
    if Params::Util::_CODELIKE($generator); ## no critic Private

  # This "must" be a scalar reference, to a generator method name.
  # -- rjbs, 2006-12-05
  return $class->$$generator($name, $arg->{arg}, $arg->{col});
}

#pod =head2 default_installer
#pod
#pod This is Sub::Exporter's default installer.  It does what Sub::Exporter
#pod promises: it installs code into the target package.
#pod
#pod   default_installer(\%arg, \@to_export);
#pod
#pod Passed arguments are:
#pod
#pod   into - the package into which exports should be delivered
#pod
#pod C<@to_export> is a list of name/value pairs.  The default exporter assigns code
#pod (the values) to named slots (the names) in the given package.  If the name is a
#pod scalar reference, the scalar reference is made to point to the code reference
#pod instead.
#pod
#pod =cut

sub default_installer {
  my ($arg, $to_export) = @_;

  for (my $i = 0; $i < @$to_export; $i += 2) {
    my ($as, $code) = @$to_export[ $i, $i+1 ];

    # Allow as isa ARRAY to push onto an array?
    # Allow into isa HASH to install name=>code into hash?

    if (ref $as eq 'SCALAR') {
      $$as = $code;
    } elsif (ref $as) {
      Carp::croak "invalid reference type for $as: " . ref $as;
    } else {
      Sub::Install::reinstall_sub({
        code => $code,
        into => $arg->{into},
        as   => $as
      });
    }
  }
}

sub default_exporter {
  Carp::cluck "default_exporter is deprecated; call default_installer instead; the semantics are identical";
  goto &default_installer;
}

#pod =head1 EXPORTS
#pod
#pod Sub::Exporter also offers its own exports: the C and
#pod C routines described above.  It also provides a special "setup"
#pod collector, which will set up an exporter using the parameters passed to it.
#pod
#pod Note that the "setup" collector (seen in examples like the L above)
#pod uses C, not C.  This means that the special
#pod arguments like "into" and "as" for C are not accepted here.
#pod Instead, you may write something like:
#pod
#pod   use Sub::Exporter
#pod     { into => 'Target::Package' },
#pod     -setup => {
#pod       -as     => 'do_import',
#pod       exports => [ ... ],
#pod     }
#pod   ;
#pod
#pod Finding a good reason for wanting to do this is left as an exercise for the
#pod reader.
#pod
#pod =cut

setup_exporter({
  exports => [
    qw(setup_exporter build_exporter),
    _import => sub { build_exporter($_[2]) },
  ],
  groups  => {
    all   => [ qw(setup_exporter build_export) ],
  },
  collectors => { -setup => \&_setup },
});

sub _setup {
  my ($value, $arg) = @_;

  if (ref $value eq 'HASH') {
    push @{ $arg->{import_args} }, [ _import => { -as => 'import', %$value } ];
    return 1;
  } elsif (ref $value eq 'ARRAY') {
    push @{ $arg->{import_args} },
      [ _import => { -as => 'import', exports => $value } ];
    return 1;
  }
  return;
}

#pod =head1 COMPARISONS
#pod
#pod There are a whole mess of exporters on the CPAN.  The features included in
#pod Sub::Exporter set it apart from any existing Exporter.  Here's a summary of
#pod some other exporters and how they compare.
#pod
#pod =over
#pod
#pod =item * L and co.
#pod
#pod This is the standard Perl exporter.  Its interface is a little clunky, but it's
#pod fast and ubiquitous.  It can do some things that Sub::Exporter can't:  it can
#pod export things other than routines, it can import "everything in this group
#pod except this symbol," and some other more esoteric things.  These features seem
#pod to go nearly entirely unused.
#pod
#pod It always exports things exactly as they appear in the exporting module; it
#pod can't rename or customize routines.  Its groups ("tags") can't be nested.
#pod
#pod L is a whole lot like Exporter, but it does significantly less:
#pod it supports exporting symbols, but not groups, pattern matching, or negation.
#pod
#pod The fact that Sub::Exporter can't export symbols other than subroutines is
#pod a good idea, not a missing feature.
#pod
#pod For simple uses, setting up Sub::Exporter is about as easy as Exporter.  For
#pod complex uses, Sub::Exporter makes hard things possible, which would not be
#pod possible with Exporter.
#pod
#pod When using a module that uses Sub::Exporter, users familiar with Exporter will
#pod probably see no difference in the basics.  These two lines do about the same
#pod thing in whether the exporting module uses Exporter or Sub::Exporter.
#pod
#pod   use Some::Module qw(foo bar baz);
#pod   use Some::Module qw(foo :bar baz);
#pod
#pod The definition for exporting in Exporter.pm might look like this:
#pod
#pod   package Some::Module;
#pod   use base qw(Exporter);
#pod   our @EXPORT_OK   = qw(foo bar baz quux);
#pod   our %EXPORT_TAGS = (bar => [ qw(bar baz) ]);
#pod
#pod Using Sub::Exporter, it would look like this:
#pod
#pod   package Some::Module;
#pod   use Sub::Exporter -setup => {
#pod     exports => [ qw(foo bar baz quux) ],
#pod     groups  => { bar => [ qw(bar baz) ]}
#pod   };
#pod
#pod Sub::Exporter respects inheritance, so that a package may export inherited
#pod routines, and will export the most inherited version.  Exporting methods
#pod without currying away the invocant is a bad idea, but Sub::Exporter allows you
#pod to do just that -- and anyway, there are other uses for this feature, like
#pod packages of exported subroutines which use inheritance specifically to allow
#pod more specialized, but similar, packages.
#pod
#pod L provides a wrapper around the standard Exporter.  It makes it
#pod simpler to build groups, but doesn't provide any more functionality.  Because
#pod it is a front-end to Exporter, it will store your exporter's configuration in
#pod global package variables.
#pod
#pod =item * Attribute-Based Exporters
#pod
#pod Some exporters use attributes to mark variables to export.  L
#pod supports exporting any kind of symbol, and supports groups.  Using a module
#pod like Exporter or Sub::Exporter, it's easy to look at one place and see what is
#pod exported, but it's impossible to look at a variable definition and see whether
#pod it is exported by that alone.  Exporter::Simple makes this trade in reverse:
#pod each variable's declaration includes its export definition, but there is no one
#pod place to look to find a manifest of exports.
#pod
#pod More importantly, Exporter::Simple does not add any new features to those of
#pod Exporter.  In fact, like Exporter::Easy, it is just a front-end to Exporter, so
#pod it ends up storing its configuration in global package variables.  (This means
#pod that there is one place to look for your exporter's manifest, actually.  You
#pod can inspect the C<@EXPORT> package variables, and other related package
#pod variables, at runtime.)
#pod
#pod L isn't actually attribute based, but looks similar.  Its syntax
#pod is borrowed from Perl 6, and implemented by a source filter.  It is a prototype
#pod of an interface that is still being designed.  It should probably be avoided
#pod for production work.  On the other hand, L implements
#pod Perl 6-like exporting, but translates it into Perl 5 by providing attributes.
#pod
#pod =item * Other Exporters
#pod
#pod L wraps the standard Exporter to allow it to export symbols
#pod with changed names.
#pod
#pod L performs a special kind of routine generation, giving each
#pod importing package an instance of your class, and then exporting the instance's
#pod methods as normal routines.  (Sub::Exporter, of course, can easily emulate this
#pod behavior, as shown above.)
#pod
#pod L implements a form of renaming (using its C<_map> argument)
#pod and of prefixing, and implements groups.  It also avoids using package
#pod variables for its configuration.
#pod
#pod =back
#pod
#pod =head1 TODO
#pod
#pod =cut

#pod =over
#pod
#pod =item * write a set of longer, more demonstrative examples
#pod
#pod =item * solidify the "custom exporter" interface (see C<&default_exporter>)
#pod
#pod =item * add an "always" group
#pod
#pod =back
#pod
#pod =head1 THANKS
#pod
#pod Hans Dieter Pearcey provided helpful advice while I was writing Sub::Exporter.
#pod Ian Langworth and Shawn Sorichetti asked some good questions and helped me
#pod improve my documentation quite a bit.  Yuval Kogman helped me find a bunch of
#pod little problems.
#pod
#pod Thanks, friends!
#pod
#pod =head1 BUGS
#pod
#pod Please report any bugs or feature requests through the web interface at
#pod L. I will be notified, and then you'll automatically be
#pod notified of progress on your bug as I make changes.
#pod
#pod =cut

"jn8:32"; # <-- magic true value

__END__