File Coverage

blib/lib/Range/Object/Serial.pm

Criterion	Covered	Total	%
statement	41	41	100.0
branch	5	6	83.3
condition	3	3	100.0
subroutine	16	16	100.0
pod	3	3	100.0
total	68	69	98.5

package Range::Object::Serial;

# This is basically what common::sense does, but without the pragma itself
# to remain compatible with Perls older than 5.8

use strict;
no  warnings;
use warnings qw(FATAL closed internal debugging pack malloc portable
                prototype inplace io pipe unpack deprecated glob digit
                printf reserved taint closure semicolon);
no  warnings qw(exec newline unopened);

use Carp;
use List::Util qw( first );

use base qw(Range::Object);

# Overload definitions

use overload q{""}    => 'stringify_collapsed',
             fallback => 1;

### PUBLIC INSTANCE METHOD ###
#
# Returns regex for matching unsigned integer numbers.
#

sub pattern {
    my ($self) = @_;

    my $delimiter = $self->delimiter();

    return qr/
                (?
                \s*                 # optional greedy whitespace
                [0-9]+              # then one or more digits
                (?:                 # and finally this group consisting of
                    (?: $delimiter) # ... either delimiter
                    |               # or
                    (?: \s)         # whitespace
                    |               # or
                    \z              # end of string
                )                   # ... end of group
            /xms;
}

### PRIVATE INSTANCE METHOD ###
#
# Returns regex that is used to separate items in a range list.
# Default for Serial is comma (,) or semicolon (;).
#

sub separator {
    return qr/
                [,;]                # comma or semicolon
                \s*                 # if there is whitespace, eat it all
            /xms;
}

### PUBLIC INSTANCE METHOD ###
#
# Returns range delimiter; Serial uses default dash (-).
#

sub delimiter  { '-' }

############## PRIVATE METHODS BELOW ##############

### PRIVATE INSTANCE METHOD ###
#
# Tests if a sigle value is in current range. Serial uses numeric
# comparison.
#

sub _search_range {
    my ($self, $value) = @_;

    return
        first {
                ref($_) ? (($value >= $_->{start}) && ($value <= $_->{end}))
                :         $_ == $value
              }
              @{ $self->{range} };
}

### PRIVATE INSTANCE METHOD ###
#
# Returns sorted list of all single items within current range.
# Serial uses numeric sorting.
#
# Works in list context only, croaks if called otherwise.
#

sub _sort_range {
    my ($self, @range) = @_;

    croak "_sort_range can only be used in list context"
        unless wantarray;

    return sort { $a <=> $b } @range ? @range : $self->_full_range();
}

### PRIVATE INSTANCE METHOD ###
#
# Tests if two values are equal.
#

sub _equal_value {
    my ($self, $first, $last) = @_;

    return !!($first == $last);
}

### PRIVATE INSTANCE METHOD ###
#
# Tests if two values are consequent.
#

sub _next_in_range {
    my ($self, $first, $last) = @_;

    return !!($last == $first + 1);
};

1;

__END__