FILE: C:\Program Files (x86)\Plesk\perl\lib\enum.pm
--
package enum;
use strict;
no strict 'refs'; # Let's just make this very clear right off
use Carp;
use vars qw($VERSION);
$VERSION = do { my @r = (q$Revision: 1.16 $ =~ /\d+/g); sprintf '%d.%03d'.'%02d' x ($#r-1), @r};
my $Ident = '[^\W_0-9]\w*';
sub ENUM () { 1 }
sub BITMASK () { 2 }
sub import {
my $class = shift;
@_ or return; # Ignore 'use enum;'
my $pkg = caller() . '::';
my $prefix = ''; # default no prefix
my $index = 0; # default start index
my $mode = ENUM; # default to enum
## Pragmas should be as fast as they can be, so we inline some
## pieces.
foreach (@_) {
## Plain tag is most common case
if (/^$Ident$/o) {
my $n = $index;
if ($mode == ENUM) {
$index++;
}
elsif ($mode == BITMASK) {
$index ||= 1;
$index *= 2;
if ( $index & ($index - 1) ) {
croak (
"$index is not a valid single bitmask "
. " (Maybe you overflowed your system's max int value?)"
);
}
}
else {
confess qq(Can't Happen: mode $mode invalid);
}
*{"$pkg$prefix$_"} = sub () { $n };
}
## Index change
elsif (/^($Ident)=(-?)(.+)$/o) {
my $name= $1;
my $neg = $2;
$index = $3;
## Convert non-decimal numerics to decimal
if ($index =~ /^0x[\da-f]+$/i) { ## Hex
$index = hex $index;
}
elsif ($index =~ /^0\d/) { ## Octal
$index = oct $index;
}
elsif ($index !~ /[^\d_]/) { ## 123_456 notation
$index =~ s/_//g;
}
## Force numeric context, but only in numeric context
if ($index =~ /\D/) {
$index = "$neg$index";
}
else {
$index = "$neg$index";
$index += 0;
}
my $n = $index;
if ($mode == BITMASK) {
($index & ($index - 1))
and croak "$index is not a valid single bitmask";
$index *= 2;
}
elsif ($mode == ENUM) {
$index++;
}
else {
confess qq(Can't Happen: mode $mode invalid);
}
*{"$pkg$prefix$name"} = sub () { $n };
}
## Prefix/option change
elsif (/^([A-Z]*):($Ident)?(=?)(-?)(.*)/) {
## Option change
if ($1) {
if ($1 eq 'ENUM') { $mode = ENUM; $index = 0 }
elsif ($1 eq 'BITMASK') { $mode = BITMASK; $index = 1 }
else { croak qq(Invalid enum option '$1') }
}
my $neg = $4;
## Index change too?
if ($3) {
if (length $5) {
$index = $5;
## Convert non-decimal numerics to decimal
if ($index =~ /^0x[\da-f]+$/i) { ## Hex
$index = hex $index;
}
elsif ($index =~ /^0\d/) { ## Oct
$index = oct $index;
}
elsif ($index !~ /[^\d_]/) { ## 123_456 notation
$index =~ s/_//g;
}
## Force numeric context, but only in numeric context
if ($index =~ /\D/) {
$index = "$neg$index";
}
else {
$index = "$neg$index";
$index += 0;
}
## Bitmask mode must check index changes
if ($mode == BITMASK) {
($index & ($index - 1))
and croak "$index is not a valid single bitmask";
}
}
else {
croak qq(No index value defined after "=");
}
}
## Incase it's a null prefix
$prefix = defined $2 ? $2 : '';
}
## A..Z case magic lists
elsif (/^($Ident)\.\.($Ident)$/o) {
## Almost never used, so check last
foreach my $name ("$1" .. "$2") {
my $n = $index;
if ($mode == BITMASK) {
($index & ($index - 1))
and croak "$index is not a valid single bitmask";
$index *= 2;
}
elsif ($mode == ENUM) {
$index++;
}
else {
confess qq(Can't Happen: mode $mode invalid);
}
*{"$pkg$prefix$name"} = sub () { $n };
}
}
else {
croak qq(Can't define "$_" as enum type (name contains invalid characters));
}
}
}
1;
__END__
=head1 NAME
enum - C style enumerated types and bitmask flags in Perl
=head1 SYNOPSIS
use enum qw(Sun Mon Tue Wed Thu Fri Sat);
# Sun == 0, Mon == 1, etc
use enum qw(Forty=40 FortyOne Five=5 Six Seven);
# Yes, you can change the start indexs at any time as in C
use enum qw(:Prefix_ One Two Three);
## Creates Prefix_One, Prefix_Two, Prefix_Three
use enum qw(:Letters_ A..Z);
## Creates Letters_A, Letters_B, Letters_C, ...
use enum qw(
:Months_=0 Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
:Days_=0 Sun Mon Tue Wed Thu Fri Sat
:Letters_=20 A..Z
);
## Prefixes can be changed mid list and can have index changes too
use enum qw(BITMASK:LOCK_ SH EX NB UN);
## Creates bitmask constants for LOCK_SH == 1, LOCK_EX == 2,
## LOCK_NB == 4, and LOCK_UN == 8.
## NOTE: This example is only valid on FreeBSD-2.2.5 however, so don't
## actually do this. Import from Fnctl instead.
=head1 DESCRIPTION
Defines a set of symbolic constants with ordered numeric values ala B B types.
Now capable of creating creating ordered bitmask constants as well. See the B
section for details.
What are they good for? Typical uses would be for giving mnemonic names to indexes of
arrays. Such arrays might be a list of months, days, or a return value index from
a function such as localtime():
use enum qw(
:Months_=0 Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
:Days_=0 Sun Mon Tue Wed Thu Fri Sat
:LC_=0 Sec Min Hour MDay Mon Year WDay YDay Isdst
);
if ((localtime)[LC_Mon] == Months_Jan) {
print "It's January!\n";
}
if ((localtime)[LC_WDay] == Days_Fri) {
print "It's Friday!\n";
}
This not only reads easier, but can also be typo-checked at compile time when
run under B