File Coverage

blib/lib/Number/Range.pm

Criterion	Covered	Total	%
statement	127	158	80.3
branch	38	70	54.2
condition	7	18	38.8
subroutine	17	19	89.4
pod	7	9	77.7
total	196	274	71.5

package Number::Range;

use strict;
use warnings;
use warnings::register;
use Carp;
use POSIX; # Only needed for max integer size check in large ranges

require Exporter;

our @ISA = qw(Exporter);


our $VERSION = '0.12';

sub new {
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = {};
  bless $self, $class;
  # Max size of range before its stored as a pointer instead of hashed
  $self->{max_hash_size} = 1000;
  $self->initialize("add", @_);
  return $self;
}

sub initialize {
  my $self = shift;
  my $type = shift;
  my $rangesep = qr/(?:\.\.)/;
  my $sectsep  = qr/(?:\s|,)/;
  my $validation = qr/(?:
       [^0-9,. -]|        # These are the only allowed characters (Numbers and "separators")
       $rangesep$sectsep| # We don't want a range separator followed by section separator
       $sectsep$rangesep| # We don't want a section separator followed by range separator
       \d-\d|             # We don't want 10-10 since - is for negative numbers
       ^$sectsep|         # We don't want a section separator at the start
       ^$rangesep|        # We don't want a range separator at the start
       $sectsep$|         # We don't want a section separator at the end
       $rangesep$         # We don't want a range separator at the end
       )/x;
  foreach my $item (@_) {
    croak "$item contains invalid data" if ($item =~ m/$validation/g);
    foreach my $section (split(/$sectsep/, $item)) {
      if ($section =~ m/$rangesep/) {
        my ($start, $end) = split(/$rangesep/, $section, 2);
        if ($start > $end) {
          carp "$start is > $end" if (warnings::enabled());
          ($start, $end) = ($end, $start);
        }
        if ($start == $end) {
          carp "$start:$end is pointless" if (warnings::enabled());
          if ($type eq "add") {
            $self->_addnumbers($start);
          }
          elsif ($type eq "del") {
            $self->_delnumbers($start);
          }
          else {
            die "Neither 'add' nor 'del' was passed initialize()";
          }
        }
        else {
          if ($type eq "add") {
            if(($end - $start) > $self->{max_hash_size}) {
                $self->_addrange($start, $end);
            } else {
                $self->_addnumbers($start .. $end);
            }
          }
          elsif ($type eq "del") {
            if($end - $start > $self->{max_hash_size}) {
                $self->_delrange($start, $end);
            } else {
                $self->_delnumbers($start .. $end);
            }
          }
          else {
            die "Neither 'add' nor 'del' was passed initialize()";
          }
        }
      }
      else {
        if ($type eq "add") {
           $self->_addnumbers($section);
         }
         elsif ($type eq "del") {
          $self->_delnumbers($section);
         }
         else {
          die "Neither 'add' nor 'del' was passed initialize()";
        }
      }
    }
  }
}

sub set_max_hash_size {
    my $self = shift;
    my $val = shift;
    if($val !~ m/^\d+$/) { return 0; }
    $self->{max_hash_size} = $val;
}

sub _addrange {
    my $self = shift;
    my $start = shift;
    my $end = shift;
    $self->{_largeRangehash}{"$start .. $end"} = [$start, $end];
}

sub _delrange {
    my $self = shift;
    my $start = shift;
    my $end = shift;
    delete $self->{_largeRangehash}{"$start .. $end"};
}

sub _testlarge {
    my $self = shift;
    my $test = shift;
    if(!exists($self->{_largeRangehash})) {
        return 0;
    }
    foreach my $rangeID (keys(%{$self->{_largeRangehash}})) {
      my $range = $self->{_largeRangehash}->{$rangeID};
      if ($test >= @$range[0]
        && $test <= @$range[1]) {
        return 1;
      }
    }
    return 0;
}

sub _addnumbers {
  my $self = shift;
  foreach my $number (@_) {
    if (warnings::enabled()) {
      carp "$number already in range" if $self->inrange($number);
    }
    $self->{_rangehash}{$number} = 1;
  }
}

sub _delnumbers {
  my $self = shift;
  foreach my $number (@_) {
    if (warnings::enabled()) {
      carp "$number not in range or already removed" if (!$self->inrange($number));
    }
    delete $self->{_rangehash}{$number};
  }
}

sub inrange {
  my $self   = shift;
  if (scalar(@_) == 1) {
    if ( exists($self->{_rangehash}{-+-$_[0]})
        || $self->_testlarge($_[0])) {
        return 1;
    } else {
        return 0;
    }
  } else {
    if (wantarray) {
      my @returncodes;
      foreach my $test (@_) {
        push(@returncodes, ($self->inrange($test)) ? 1 : 0);
      }
      return @returncodes;
    } else {
      foreach my $test (@_) {
        if (!$self->inrange($test)) {
          return 0;
        }
        return 1;
      }
    }
  }
}

sub addrange {
  my $self = shift;
  $self->initialize("add", @_);
}

sub delrange {
  my $self = shift;
  $self->initialize("del", @_);
}

sub range {
  my $self = shift;
  my $excludeLarge = shift;
  if (wantarray) {
    my @range = keys(%{$self->{_rangehash}});
    if(! $excludeLarge
       && exists($self->{_largeRangehash})) {
        foreach my $rangeID (keys(%{$self->{_largeRangehash}})) {
          my $range = $self->{_largeRangehash}->{$rangeID};
            if ( @$range[0] > LONG_MAX
                || @$range[1] > LONG_MAX
                || ( @$range[1] -  @$range[0]) > LONG_MAX ) {
                carp "Range to large to return" if (warnings::enabled());
                return 0;
            }

            @range = (@range, @$range[0]..@$range[1]);
        }
    }
    my @sorted = sort {$a <=> $b} @range;
    return @sorted;
  }
  else {
    my @range    = $self->range;
    my $previous = shift @range;
    my $format   = "$previous";
    foreach my $current (@range) {
      if ($current == ($previous + 1)) {
        $format =~ s/\.\.$previous$//;
        $format .= "..$current";
      }
      else {
        $format .= ",$current";
      }
      $previous = $current;
    }
    return $format;
  }
}

sub size {
  my $self = shift;
  my @temp = keys(%{$self->{_rangehash}});;
  my $size = scalar(@temp);
  if(exists($self->{_largeRangehash})) {
    foreach my $rangeID (keys(%{$self->{_largeRangehash}})) {
      my $range = $self->{_largeRangehash}->{$rangeID};
      $size += (@$range[1] - @$range[0]) + 1;
    }
  }
  return $size;
}

sub rangeList {
  my $self = shift;
  my @return;
  # Get the range as an array (excluding large ones)
  my @range = $self->range(1);

  # If we have any ranges
  if (@range) {

    # Get the first element in the array range
    my $previous = shift(@range);
    my @sub = ($previous);

    # Process ranges stored as arrays
    foreach my $current (@range) {
        if ($current == ($previous + 1)) {
            $sub[1] = $current;
        } else {
            push(@return,[@sub]);
            @sub = ($current);
        }
        $previous = $current;
    }
    push(@return,[@sub]);
  }

  # Process ranges stored as large range hash entries
  if($self->{_largeRangehash}) {
      while(my @range = each(%{$self->{_largeRangehash}}) ) {
          push(@return, [int($range[1][0]), int($range[1][1])]);
      }
  }

  return @return;
}

1;
__END__