constant::lexical - Perl pragma to declare lexical compile-time constants

  use constant::lexical DEBUG => 0;
  {
          use constant::lexical PI => 4 * atan2 1, 1;
          use constant::lexical DEBUG => 1;

          print "Pi equals ", PI, "...\n" if DEBUG;
  }
  print "just testing...\n" if DEBUG; # prints nothing
                                        (DEBUG is 0 again)
  use constant::lexical \%hash_of_constants;
  use constant::lexical WEEKDAYS => @weekdays; # list

  use constant::lexical { PIE        => 4 * atan2(1,1),
                          CHEESECAKE => 3 * atan2(1,1),
                         };

use 5.008;

package constant::lexical;

our $VERSION = '2';

my $old = '#line ' . (__LINE__+1) . " " . __FILE__ . "\n" . <<'__';

no constant 1.03 ();
use Sub::Delete;
BEGIN {
 0+$] eq 5.01
  and VERSION Sub::Delete >= .03
  and VERSION Sub::Delete 1.00001 # %^H scoping bug
}

sub import {
	$^H |= 0x20000; # magic incantation to make %^H work before 5.10
	shift;
	my @const = @_ == 1 && ref $_[0] eq 'HASH' ? keys %{$_[0]} : $_[0];
	my $stashname = caller()."::"; my $stash = \%$stashname;
	push @{$^H{+__PACKAGE__} ||= bless[]}, map {
		my $fqname = "$stashname$_"; my $ref;
		if(exists $$stash{$_} && defined $$stash{$_}) {
			$ref = ref $$stash{$_} eq 'SCALAR'
				? $$stash{$_}
				: *$fqname{CODE};
			delete_sub($fqname);
		}
		[$fqname, $stashname, $_, $ref]
	} @const;
	unshift @_, 'constant';
	goto &{can constant 'import'}
}

sub DESTROY { for(@{+shift}) {
	delete_sub(my $fqname = $$_[0]);
	next unless defined (my $ref = $$_[-1]);
	ref $ref eq 'SCALAR' or *$fqname = $ref, next;
	my $stash = \%{$$_[1]}; my $subname = $$_[2];
	if(exists $$stash{$subname} &&defined $$stash{$subname}) {
		my $val = $$ref;
		*$fqname = sub(){$val}
	} else { $$stash{$subname} = $ref }
}}

1;
__

my $new = '#line ' . (__LINE__+1) . " " . __FILE__ . "\n" . <<'__';

require Lexical'Sub;

sub import {
  shift;
  my @args;
  if(@_ == 1 && ref $_[0] eq 'HASH') {
   _validate(keys %{$_[0]});
    while(my($k,$v) = each %{$_[0]}) {
     push @args, $k, sub(){ $v };
    }
  }
  elsif(@_ == 2) {
   _validate($_[0]);
    my $v = pop;
    @args = ($_[0], sub(){ $v });
  }
  else {
   _validate($_[0]);
    @args = (shift, do { my @v = @'_; sub(){ @v } });
  }
  import Lexical'Sub @args;
 _:
}

# Plagiarised from constant.pm

# Some names are evil choices.
my %keywords
 = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD UNITCHECK };

my $normal_constant_name = qr/^_?[^\W_0-9]\w*\z/;
my $tolerable = qr/^[A-Za-z_]\w*\z/;
my $boolean = qr/^[01]?\z/;

sub _validate {
 for(@_) {
  defined or require Carp, Carp'croak("Can't use undef as constant name");
  # Normal constant name
  if (/$normal_constant_name/ and !$keywords{$_}) {
      # Everything is okay

  # Starts with double underscore. Fatal.
  } elsif (/^__/) {
      require Carp;
      Carp::croak("Constant name '$_' begins with '__'");

  # Maybe the name is tolerable
  } elsif (/$tolerable/) {
      # Then we'll warn only if you've asked for warnings
      if (warnings::enabled()) {
          if ($keywords{$_}) {
              warnings::warn("Constant name '$_' is a Perl keyword");
          }
      }

  # Looks like a boolean
  # use constant FRED == fred;
  } elsif (/$boolean/) {
      require Carp;
      if (@_) {
          Carp::croak("Constant name '$_' is invalid");
      } else {
          Carp::croak("Constant name looks like boolean value");
      }

  } else {
     # Must have bad characters
      require Carp;
      Carp::croak("Constant name '$_' has invalid characters");
  }
 }
}

1;
__

eval($] < 5.011002 ? $old : $new) or die $@;

__END__