File Coverage

blib/lib/Range/Object/DigitString.pm
Criterion Covered Total %
statement 46 46 100.0
branch 2 2 100.0
condition 3 3 100.0
subroutine 16 16 100.0
pod 3 3 100.0
total 70 70 100.0


line stmt bran cond sub pod time code
1             package Range::Object::DigitString;
2              
3             # This is basically what common::sense does, but without the pragma itself
4             # to remain compatible with Perls older than 5.8
5              
6 1     1   58849 use strict;
  1         11  
  1         27  
7              
8 1     1   28 no warnings;
  1         3  
  1         43  
9 1         63 use warnings qw(FATAL closed internal debugging pack malloc portable
10             prototype inplace io pipe unpack deprecated glob digit
11 1     1   5 printf reserved taint closure semicolon);
  1         9  
12 1     1   8 no warnings qw(exec newline unopened);
  1         3  
  1         42  
13              
14 1     1   8 use Carp;
  1         3  
  1         85  
15 1     1   7 use List::Util qw( first );
  1         1  
  1         105  
16              
17 1     1   5 use base qw(Range::Object);
  1         2  
  1         315  
18              
19             # Overload definitions
20              
21 1         6 use overload q{""} => 'stringify_collapsed',
22 1     1   743 fallback => 1;
  1         762  
23              
24             ### PUBLIC INSTANCE METHOD ###
25             #
26             # Returns regex for matching phone digit strings.
27             #
28              
29             sub pattern {
30 382     382 1 1066 return qr/
31             # Can't have anything but space or dash before digits
32             (?
33              
34             # First digit is mandatory, it can be *, # or 0-9
35             [0-9]
36              
37             # Up to 14 digits can follow
38             [0-9]{0,15}
39              
40             # Can't have dash, space or end of line after digits
41             (?=
42             (?: [- ] | \z )
43             )
44             /xms;
45             }
46              
47             ### PUBLIC INSTANCE METHOD ###
48             #
49             # Returns regex that is used to separate items in a range list.
50             # Default for Extensions is comma (,) or semicolon (;).
51             #
52              
53             sub separator {
54 112     112 1 249 return qr/
55             # Comma or semicolon
56             [,;]
57              
58             # If there is any whitespace, eat it all up
59             \s*
60             /xms;
61             }
62              
63             ### PUBLIC INSTANCE METHOD ###
64             #
65             # Returns default range delimiter for current class.
66             #
67              
68 308     308 1 562 sub delimiter { '-' }
69              
70             ############## PRIVATE METHODS BELOW ##############
71              
72             ### PRIVATE INSTANCE METHOD ###
73             #
74             # Returns default list separator for use with stringify() and
75             # stringify_collapsed()
76             #
77              
78 18     18   53 sub _list_separator { q{,} }
79              
80             ### PRIVATE INSTANCE METHOD ###
81             #
82             # Expands a list of phone digit strings.
83             #
84              
85             my $EXPLODE_REGEX
86             = qr/\A
87             qw\( # Literal 'qw('
88             \d+ # Then match some digits...
89             \) # Closing parentheses for 1st qw()
90              
91             \.\. # Literal '..'
92              
93             qw\( # Literal 'qw('
94             \d+ # Some digits again
95             \) # Close parentheses for 2nd qw()
96             \z/xms;
97              
98             sub _explode_range {
99 270     270   486 my ($self, $string) = @_;
100              
101             # First quote and delimit the values
102 270         440 my $pattern = $self->pattern;
103 270         497 for ( $string ) {
104 270         486 s/\s+//g;
105 270         1842 s/ ( $pattern ) /qw($1)/gx;
106 270         799 s/ qw\( (.*?) \) - qw\( (.*?) \) /qw($1)..qw($2)/x;
107             };
108              
109             # Expand the list and add leading prefix back
110 270         603 my @items = $self->SUPER::_explode_range($string);
111              
112 270         864 return @items;
113             }
114              
115             ### PRIVATE INSTANCE METHOD ###
116             #
117             # Tests if a single value is within boundaries of collapsed range item.
118             #
119              
120             sub _is_in_range_hashref {
121 270     270   412 my ($self, $range_ref, $value) = @_;
122              
123             # If length is different, $value can't be in range
124 270 100       569 return unless length($value) == length($range_ref->{start});
125              
126             # Unpack for brevity
127 118         156 my $start = $range_ref->{start};
128 118         144 my $end = $range_ref->{end};
129              
130             # Finally, compare strings
131 118   100     449 return ( ($value ge $start) && ($value le $end) );
132             }
133              
134             ### PRIVATE INSTANCE METHOD ###
135             #
136             # Tests if two values are equal using string comparison.
137             #
138              
139             sub _equal_value {
140 678     678   1040 my ($self, $first, $last) = @_;
141              
142 678         1411 return !!($first eq $last);
143             }
144              
145             ### PRIVATE INSTANCE METHOD ###
146             #
147             # Tests if two values are consequent.
148             #
149              
150             sub _next_in_range {
151 90     90   144 my ($self, $first, $last) = @_;
152              
153             # Increment the value
154 90         118 $first = ++$first;
155              
156 90         238 return !!($first eq $last);
157             }
158              
159             1;
160              
161             __END__