view release on metacpan or  search on metacpan

lib/Const/Exporter.pm  view on Meta::CPAN

package Const::Exporter;

# ABSTRACT: Declare constants for export.

use v5.14;
use warnings;

our $VERSION = 'v1.3.0';

use Carp;
use Const::Fast;
use Exporter 5.57 ();
use List::Util 1.56 qw/ pairs mesh /;
use Package::Stash;
use Ref::Util qw/ is_blessed_ref is_arrayref is_coderef is_hashref is_ref /;

# RECOMMEND PREREQ: List::SomeUtils::XS
# RECOMMEND PREREQ: Package::Stash::XS
# RECOMMEND PREREQ: Ref::Util::XS
# RECOMMEND PREREQ: Storable 3.05

sub import {
    my $pkg = shift;

    strict->import;
    warnings->import;

    my $caller = caller;
    my $stash  = Package::Stash->new($caller);

    # Create @EXPORT, @EXPORT_OK, %EXPORT_TAGS and import if they
    # don't yet exist.

    my $export = $stash->get_or_add_symbol('@EXPORT');

    my $export_ok = $stash->get_or_add_symbol('@EXPORT_OK');

    my $export_tags = $stash->get_or_add_symbol('%EXPORT_TAGS');

    $stash->add_symbol( '&import', \&Exporter::import )
      unless ( $stash->has_symbol('&import') );

    $stash->add_symbol( '&const', \&Const::Fast::const );
    _export_symbol( $stash, 'const' );

    foreach my $set ( pairs @_ ) {

        my $tag = $set->key;
        croak "'${tag}' is reserved" if $tag eq 'all';

        my $defs = $set->value;

        croak "An array reference required for tag '${tag}'"
          unless is_arrayref($defs);

        while ( my $item = shift @{$defs} ) {

            for ($item) {

                # Array reference means a list of enumerated symbols

                if ( is_arrayref($_) ) {

                    my @enums = @{$item};
                    my $start = shift @{$defs};

                    my @values = is_arrayref($start) ? @{$start} : ($start);

                    my $last = $values[0] // 0;
                    my $fn = sub { $_[0] + 1 };

                    if ( is_coderef $values[1] ) {
                        $fn = $values[1];
                        $values[1] = undef;
                    }

                    foreach my $pair ( pairs mesh \@enums, \@values ) {
                        my $value = $pair->value // $fn->($last);
                        $last = $value;