File Coverage

blib/lib/Exporter/Handy.pm

Criterion	Covered	Total	%
statement	40	73	54.7
branch	1	16	6.2
condition	0	3	0.0
subroutine	12	18	66.6
pod	7	7	100.0
total	60	117	51.2

package Exporter::Handy;

# ABSTRACT: An EXPERIMENTAL subclass of , which helps create easy-to-extend modules that export symbols
our $VERSION = '1.000004';

use utf8;
use strict;
use warnings;

use Exporter::Handy::Util qw(xtags);
use Exporter::Extensible -exporter_setup => 1;

#=== OVERRIDES
sub exporter_export {
  my $self = shift;
  my @args = $self->_exporter_preprocess_export_args(@_);
  $self->SUPER::exporter_export(@args)
}

sub _exporter_preprocess_export_args {
  my $self = shift;
  my @args;
  while (@_) {
    my $arg = shift;
    if ($arg eq ':') {
      push @args, xtags( { sig => ':'}, '' => shift )
    } else {
      push @args, $arg
    }
  }
  @args
}


# === EXPORT OPTIONS ====

# PRAGMATA
# Remember: Pragmas effect the current compilation context.
# No need to keep track of where we are importing into...
# They require their ->import() method to be called directly, no matter how deep the call stack happens to be.
# Just call ->import() directly, like below, and it will do the right thing.
sub strict      : Export(-) { strict->import   }
sub warnings    : Export(-) { warnings->import }
sub utf8        : Export(-) { utf8->import     }

sub strictures  : Export(-) {
  strict->import;
  warnings->import
}

sub sane : Export(-) {
  utf8->import;
  strict->import;
  warnings->import;
}

# use Exporter::Handy qw(-sane -features), exporter_setup => 1;
sub features {
  my ($exporter, $arg)= @_;

  # default features to turn on/off
  my %feats = (
    'current_sub'     => 1, # Perl v5.16+ (2012) : enable __SUB__ token that returns a ref to the current subroutine (or undef).
    'evalbytes'       => 1, # Perl v5.16+ (2012) : like string eval, but it treats its argument as a byte string.
    'fc'              => 1, # Perl v5.16+ (2012) : enable the fc function (Unicode casefolding).
    'lexical_subs'    => 1, # Perl v5.18+ (2012) : enable declaration of subroutines via my sub foo, state sub foo and our sub foo syntax.
    'say'             => 1, # Perl v5.10+ (2007) : enable the Raku-inspired "say" function.
    'state'           => 1, # Perl v5.10+ (2007) : enable state variables.
    'unicode_eval'    => 1, # Perl v5.16+ (2012) : changes the behavior of plain string eval to work more consistently, especially in the Unicode world.
    'unicode_strings' => 1, # Perl v5.12+ (2010) : use Unicode rules in all string operations (unless either use locale or use bytes are also within the scope).
  );

  my @args = eval { @$arg };  # if $arg is an ARRAY-ref, than it denotes a list of features
  my %args = eval { %$arg };  # if $arg is a HASH-ref, then it denotes individual overrides (1: on, 0:off)

  if (@args) {
    if ($args[0] eq '+') { # request to keep defaults.
      shift @args;
      %args = map { $_ => 1 } @args;
    } else {              # replace defaults
      %feats =  map { $_ => 1 } @args;
    }
  }

  # handle individual overrides
  %feats = (%feats, %args);

  return unless %feats;

  # determine features to be turned ON or OFF
  my (@on, @off);
  for (keys %feats) {
    next if m/^-/;  # ignore inline args à la , if any: -prefix, -as, ...

    if (defined $feats{$_} && $feats{$_}) {
      push @on, $_;
    } else {
      push @off, $_;
    }
  }

  # Do the actual work
  require feature;
  feature->import(@on) if @on;
  feature->unimport(@off) if @off;
}

# Note that attribute syntax, i.e. :Export(-?), was not working before version 0.11 of .
# So we take the more verbose approach, as below:
__PACKAGE__->exporter_register_option('features', \&features, '?');

1;

__END__