File Coverage

blib/lib/Exporter/Handy.pm

Criterion	Covered	Total	%
statement	33	75	44.0
branch	0	14	0.0
condition	0	7	0.0
subroutine	11	21	52.3
pod	6	6	100.0
total	50	123	40.6

package Exporter::Handy;

use utf8;
use strict;
use warnings;

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

use Exporter::Extensible -exporter_setup => 1;

# Generators for exported functions
sub _generate_xtags : Export(=xtags) {
  require Exporter::Handy::Util;
  my ($exporter, $symbol, $opts) = @_;
  my %opts = ( sig => ':',  %{; $opts // {} } );
  sub {; Exporter::Handy::Util::xtags_( \%opts, @_ ) } # curried
}

sub _generate_expand_xtags : Export(=expand_xtags) {
  require Exporter::Handy::Util;
  my ($exporter, $symbol, $opts) = @_;
  sub {; Exporter::Handy::Util::expand_xtags_(@_, $opts // { }) } # curried
}


# 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 {  # :Export(-?) syntax was not working before version 0.11 of Exporter::Extensible
  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;
}
__PACKAGE__->exporter_register_option('features', \&features, '?');

1;

__END__