File Coverage

blib/lib/enum.pm

Criterion	Covered	Total	%
statement	59	85	69.4
branch	29	60	48.3
condition	0	2	0.0
subroutine	6	6	100.0
pod			n/a
total	94	153	61.4

package enum;

use 5.006;
use strict;
use warnings;
no strict 'refs';  # Let's just make this very clear right off

use Carp;
our $VERSION = '1.10';

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$_"} = eval "sub () { $n }";
        }

        ## Index change
        elsif (/^($Ident)=(-?)(.+)$/o) {
            my $name= $1;
            my $neg = $2;
            $index  = $3;

            ## Convert non-decimal numerics to decimal
            if ($index =~ /^0x[0-9a-f]+$/i) {    ## Hex
                $index = hex $index;
            }
            elsif ($index =~ /^0[0-9]/) {          ## Octal
                $index = oct $index;
            }
            elsif ($index !~ /[^0-9_]/) {        ## 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"} = eval "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[0-9a-f]+$/i) {    ## Hex
                        $index = hex $index;
                    }
                    elsif ($index =~ /^0[0-9]/) {          ## Oct
                        $index = oct $index;
                    }
                    elsif ($index !~ /[^0-9_]/) {        ## 123_456 notation
                        $index =~ s/_//g;
                    }

                    ## Force numeric context, but only in numeric context
                    if ($index =~ /[^0-9]/) {
                        $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"} = eval "sub () { $n }";
            }
        }

        else {
            croak qq(Can't define "$_" as enum type (name contains invalid characters));
        }
    }
}

1;

__END__