view release on metacpan or  search on metacpan

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

}

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" . <<'__';

BEGIN { $constant::lexical::{lexsubs} = \($] >= 5.022) }

if (lexsubs) {
 require XSLoader;
  XSLoader::load(__PACKAGE__, $VERSION);
}
else {
 require Lexical'Sub;
}

sub import {
  shift;
  return unless @ '_;
  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 } });
  }
  if (lexsubs) {
    install_lexical_sub(splice @args, 0, 2) while @args;
  }
  else {
    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__

=head1 NAME

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

=head1 VERSION

2.0003

=head1 SYNOPSIS