File Coverage

blib/lib/Text/NumericList.pm

Criterion	Covered	Total	%
statement	100	113	88.5
branch	25	34	73.5
condition			n/a
subroutine	14	16	87.5
pod	10	10	100.0
total	149	173	86.1

package Text::NumericList;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.01';

# Object creator
sub new{
    my $self = shift;
    my $pkg = {
	array		    => [],
	string		    => '',
	mask		    => undef,
	output_separator    => ',',
	input_separator	    => ',',
	range_regexp	    => '\-',
	range_symbol	    => '-'
    };
    bless $pkg, $self;
    return $pkg;
}

# Convert array to the string. Set array and string attributes
sub set_array{
    no warnings;
    my ($self, @array) = @_;

    # In each array element, remove all non-digit characters.
    foreach (@array){ $_ =~ s/\D//g; }

    # Remove non-unique elements.
    my %seen;
    @array = grep {!$seen{$_}++ and $_ ne ''} @array;

    # Sort the array.
    @array = sort {$a <=> $b} @array;

    # Set 'array' attribute.
    $self->{'array'} = [@array];

    # Apply the mask to the array.
    $self->_mask;
    @array = $self->get_array;

    # Replace 3 and more sequential elements with a range string (e.g.
    # '1-5') using range_symbol attribute.
    my @string;
    my @tmp;
    push @tmp, shift @array;
    while (@array){
	push @tmp, shift @array;
	if ($tmp[$#tmp] - $tmp[0] > $#tmp){
	    unshift @array, pop @tmp;
	    push @string, $self->_range(@tmp);
	    @tmp = ();
	    push @tmp, shift @array;
	}
    }
    push @string, $self->_range(@tmp);
    $self->{'string'} = join($self->{'output_separator'}, @string);
}

# If the array has more than 3 elements, join them with range symbol.
# Otherwise, return the array.
sub _range {
    my ($self, @array) = @_;
    if (@array < 3){return @array}
    return join($self->{'range_symbol'}, $array[0], $array[$#array]);
}

# Return the array attribute
sub get_array{
    my $self = shift;
    return @{$self->{'array'}};
}

# Convert the string into an array.  Set string and array attributes.
sub set_string{
    my ($self, $string) = @_;

    my @array;

    # Convert the string to lower case:
    $string = lc($string);

    # If the range is set and the string matches 'all', 'odd', or 'even',
    # set the 'all', 'odd', or 'even' flag.  Remove 'all', 'odd', or
    # 'even' from the string.
    my $all	= ($string =~ s/all//gi);
    my $odd	= ($string =~ s/odd//gi);
    my $even	= ($string =~ s/even//gi);

    # If 'all' flag is set, the set_array($self->{'mask'}->get_array)
    # method and return.
    if ( ref $self->{'mask'} eq ref $self){
	my @mask_array = $self->{'mask'}->get_array;
	if ($all){
	    # Add the whole mask array
	    push @array, @mask_array;
	}
	if ($odd){
	    # Add odd numbers from the mask array
	    push @array, grep {$_%2} @mask_array;
	}
	if ($even){
	    # Add even numbers from the mask array
	    push @array, grep {!($_%2)} @mask_array;
	}
    }

    # Unless range regular expression is '..',
    # replace all instances of '..' with a space
    unless ($self->{'range_regexp'} eq '\.\.'){
	$string =~ s/\.\./ /g;
    }

    # Replace all instances of  string with '_'
    $string =~ s/$self->{'range_regexp'}+/_/g;

    # $string =~ s/[^\d$is]*_[^\d$is]*/_/g;
    my $is = $self->{'input_separator'};
    $string =~ s/[^\d$is]*_[^\d$is]*/_/g;

    # Replace all instances of one or more non-digit and non-'..'
    # with a comma
    $string =~ s/[^\d_]+/,/g;

    # Remove '_' not surrounded with digits.
    $string =~ s/,_/,/g;
    $string =~ s/_,/,/g;

    # Replace '_\d+_' with a single '_'
    $string =~ s/_\d+_/_/g;

    # Replace all '_' with a '..'
    $string =~ s/_/../g;

    # Split the string using /,/:
    push @array, map {eval "($_)"} split(/,/, $string);

    $self->set_array(@array);
    $self->{'n'} = 0;
}

# Return the string attribute
sub get_string{
    my $self = shift;
    return $self->{'string'};
}

# Set output separator attribute
sub set_output_separator{
    my ($self, $separator) = @_;
    if ($separator){
	$self->{'string'} =~ s/$self->{'output_separator'}/$separator/g;
        $self->{'output_separator'} = $separator;
    } else {
	warn "Output separator is empty. Output separator is unchanged.";
    }
}

# Set input separator attribute
sub set_input_separator{
    my ($self, $separator) = @_;
    if ($separator){
	$self->{'input_separator'} = $separator;
    } else {
	warn "Input separator is empty.  Input separator is unchanged.";
    }
}

# Set range symbol attribute
sub set_range_symbol{
    my ($self, $symbol) = @_;
    if ($symbol){
	$self->{'string'} =~ s/$self->{'range_symbol'}/$symbol/g;
	$self->{'range_symbol'} = $symbol;
    }
    else {
	warn "Range symbol is empty.  Range symbol is left unchanged."
    }
}

# Set range regular expression
sub set_range_regexp{
    my ($self, $regexp) = @_;
    if ($regexp){
	$self->{'range_regexp'} = $regexp;
    }
    else {
	warn 'Range regular expression is empty.  Range regular expression is left unchanged.';
    }
}

# Set object mask
sub set_mask{
    my ($self, $mask) = @_;
    if (ref $mask eq ref $self){
	$self->{'mask'} = $mask;
	$self->_mask;
    } else {
	warn "The mask is not a ".ref $self." object.  The mask is left unchanged.";
    }
}

# Apply the mask to the array
sub _mask{
    my $self = shift;
    unless (ref $self->{'mask'} eq ref $self){return}
    my @array = $self->get_array;
    my @mask_array = $self->{'mask'}->get_array;
    if (@mask_array){
	my (@union, %union, @isect, %isect);
	@union = @isect = ();
	%union = %isect = ();

	foreach my $e (@array, @mask_array){ $union{$e}++ && $isect{$e}++ }

	$self->set_array(sort {$a <=> $b} keys %isect) unless $self->{'n'}++;
    }
}


1;
__END__