view release on metacpan or  search on metacpan

lib/Acme/constant.pm  view on Meta::CPAN

package Acme::constant;
{
  $Acme::constant::VERSION = '0.1.3';
}
use 5.014;
use strictures 1;
use Carp ();

sub generate_constant {
    my ($package, $name, @values) = @_;
    # Prototype is used to make it work like a constant (constants
    # shouldn't take arguments). While anonymous subroutines don't use
    # prototypes, the prototype gets meaning when this subroutine is
    # assigned to type glob.
    my $constant = sub () : lvalue {
        # When constant used as array, it's very simple to understand
        # user wants an array. The !defined wantarray check is intended
        # to detect use of wantarray() in void context.
        if (wantarray || !defined wantarray) {
            @values;
        }
        # When constant has one element, writing to it in scalar
        # context is fine.
        elsif (@values == 1) {
            $values[0];
        }
        # This shows an error, as otherwise, this could cause a strange
        # situation where scalar A shows (A)[0], when A has one
        # element, and 2 when A has two elements. The behavior of Array
        # constructor in ECMAScript is already confusing enough (new
        # Array(3) is [,,,], but new Array(3, 3) is [3, 3]).
        else {
            Carp::croak "Can't call ${package}::$name in scalar context";

            # Return lvalue in order to make older versions of Perl
            # happy, even when it's not going to be used.
            @values;
        }
    };
    # Make a block, to make a scope for strict "refs".
    {
        # Because of symbol table modifications, I have to allow
        # symbolic references.
        no strict qw(refs);
        *{"${package}::$name"} = $constant;
    }
}

sub import {
    my $package = caller;

    # The first argument is this package name
    my $name = shift;

    # Without arguments, simply fail.
    if (@_ == 0) {
        Carp::carp qq[Useless use of "$name" pragma];
    }

    # When called with one argument, this argument would be hash
    # reference.
    elsif (@_ == 1) {
        my %hash = %{shift()};
        # each is safe here, as %hash is lexical variable.
        while (my ($name, $value) = each %hash) {
            generate_constant $package, $name, $value;
        }
    }

    # Otherwise, assume one constant, that possibly could return a list
    # of values.
    else {
        my $name = shift;
        generate_constant $package, $name, @_;