File Coverage

blib/lib/enum/hash.pm

Criterion	Covered	Total	%
statement	46	50	92.0
branch	14	20	70.0
condition			n/a
subroutine	5	5	100.0
pod	0	2	0.0
total	65	77	84.4

package enum::hash;
use strict;
use warnings;
use Carp;

require Exporter;
our $VERSION = '1.00';

our @ISA       = qw/ Exporter /;
our @EXPORT_OK = qw/ enum /;


sub enum {
  my $prefix = '';
  my $index  = 0;
  my @enum;

  while (@_) {
    my $item = shift;
    my $key;

    ## Prefix change
    if (substr($item, 0, 1) eq ':') {

      ## get rid of leading :
      $item = substr($item, 1);

      ## Index change too?
      my $tmp_prefix;

      if (index($item, '=') != -1) {
        my $assign;
        ($tmp_prefix, $assign) = split '=', $item;

        $index = index_change( $assign );
      }
      else {
        $tmp_prefix = $item;
      }

      ## Incase it's a null prefix
      $prefix = defined $tmp_prefix ? $tmp_prefix : '';

      next;
    }

    ## Index change
    elsif (index($item, '=') != -1) {
      my $assign;
      ($key, $assign) = split '=', $item;

      $index = index_change( $assign );
    }

    ## A..Z case magic lists
    elsif (index($item, '..') != -1) {

      my ($start, $end) = split(/\.\./, $item, 2);

      for ($start .. $end) {
        push @enum, $prefix.$_, $index++;
      }

      next;
    }

    ## Plain tag is most common case
    else {

      $key = $item;
    }

    push @enum, $prefix.$key, $index++;
  }

  return @enum;
}


sub index_change {
  my ($change) = @_;
  my ($neg, $index);

  if ($change =~ /(-?)(.+)/) {
    $neg   = $1;
    $index = $2;
  }
  else {
    croak (qq/No index value defined after "="/);
  }

  ## 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;
  }

  return $index;
}

1;

__END__