line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Range::Object::Serial; |
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
|
|
50423
|
use strict; |
|
1
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
26
|
|
7
|
1
|
|
|
1
|
|
4
|
no warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
38
|
|
8
|
1
|
|
|
|
|
60
|
use warnings qw(FATAL closed internal debugging pack malloc portable |
9
|
|
|
|
|
|
|
prototype inplace io pipe unpack deprecated glob digit |
10
|
1
|
|
|
1
|
|
4
|
printf reserved taint closure semicolon); |
|
1
|
|
|
|
|
1
|
|
11
|
1
|
|
|
1
|
|
4
|
no warnings qw(exec newline unopened); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
21
|
|
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
5
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
51
|
|
14
|
1
|
|
|
1
|
|
5
|
use List::Util qw( first ); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
125
|
|
15
|
|
|
|
|
|
|
|
16
|
1
|
|
|
1
|
|
6
|
use base qw(Range::Object); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
333
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# Overload definitions |
19
|
|
|
|
|
|
|
|
20
|
1
|
|
|
|
|
7
|
use overload q{""} => 'stringify_collapsed', |
21
|
1
|
|
|
1
|
|
844
|
fallback => 1; |
|
1
|
|
|
|
|
779
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
### PUBLIC INSTANCE METHOD ### |
24
|
|
|
|
|
|
|
# |
25
|
|
|
|
|
|
|
# Returns regex for matching unsigned integer numbers. |
26
|
|
|
|
|
|
|
# |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub pattern { |
29
|
308
|
|
|
308
|
1
|
487
|
my ($self) = @_; |
30
|
|
|
|
|
|
|
|
31
|
308
|
|
|
|
|
592
|
my $delimiter = $self->delimiter(); |
32
|
|
|
|
|
|
|
|
33
|
308
|
|
|
|
|
2088
|
return qr/ |
34
|
|
|
|
|
|
|
(?
|
35
|
|
|
|
|
|
|
\s* # optional greedy whitespace |
36
|
|
|
|
|
|
|
[0-9]+ # then one or more digits |
37
|
|
|
|
|
|
|
(?: # and finally this group consisting of |
38
|
|
|
|
|
|
|
(?: $delimiter) # ... either delimiter |
39
|
|
|
|
|
|
|
| # or |
40
|
|
|
|
|
|
|
(?: \s) # whitespace |
41
|
|
|
|
|
|
|
| # or |
42
|
|
|
|
|
|
|
\z # end of string |
43
|
|
|
|
|
|
|
) # ... end of group |
44
|
|
|
|
|
|
|
/xms; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
48
|
|
|
|
|
|
|
# |
49
|
|
|
|
|
|
|
# Returns regex that is used to separate items in a range list. |
50
|
|
|
|
|
|
|
# Default for Serial is comma (,) or semicolon (;). |
51
|
|
|
|
|
|
|
# |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub separator { |
54
|
308
|
|
|
308
|
1
|
762
|
return qr/ |
55
|
|
|
|
|
|
|
[,;] # comma or semicolon |
56
|
|
|
|
|
|
|
\s* # if there is whitespace, eat it all |
57
|
|
|
|
|
|
|
/xms; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
### PUBLIC INSTANCE METHOD ### |
61
|
|
|
|
|
|
|
# |
62
|
|
|
|
|
|
|
# Returns range delimiter; Serial uses default dash (-). |
63
|
|
|
|
|
|
|
# |
64
|
|
|
|
|
|
|
|
65
|
1127
|
|
|
1127
|
1
|
1868
|
sub delimiter { '-' } |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
############## PRIVATE METHODS BELOW ############## |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
70
|
|
|
|
|
|
|
# |
71
|
|
|
|
|
|
|
# Tests if a sigle value is in current range. Serial uses numeric |
72
|
|
|
|
|
|
|
# comparison. |
73
|
|
|
|
|
|
|
# |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub _search_range { |
76
|
582
|
|
|
582
|
|
964
|
my ($self, $value) = @_; |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
return |
79
|
|
|
|
|
|
|
first { |
80
|
4198
|
100
|
100
|
4198
|
|
9837
|
ref($_) ? (($value >= $_->{start}) && ($value <= $_->{end})) |
81
|
|
|
|
|
|
|
: $_ == $value |
82
|
|
|
|
|
|
|
} |
83
|
582
|
|
|
|
|
1222
|
@{ $self->{range} }; |
|
582
|
|
|
|
|
1370
|
|
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
87
|
|
|
|
|
|
|
# |
88
|
|
|
|
|
|
|
# Returns sorted list of all single items within current range. |
89
|
|
|
|
|
|
|
# Serial uses numeric sorting. |
90
|
|
|
|
|
|
|
# |
91
|
|
|
|
|
|
|
# Works in list context only, croaks if called otherwise. |
92
|
|
|
|
|
|
|
# |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
sub _sort_range { |
95
|
321
|
|
|
321
|
|
732
|
my ($self, @range) = @_; |
96
|
|
|
|
|
|
|
|
97
|
321
|
50
|
|
|
|
651
|
croak "_sort_range can only be used in list context" |
98
|
|
|
|
|
|
|
unless wantarray; |
99
|
|
|
|
|
|
|
|
100
|
321
|
100
|
|
|
|
1129
|
return sort { $a <=> $b } @range ? @range : $self->_full_range(); |
|
3139
|
|
|
|
|
3719
|
|
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
104
|
|
|
|
|
|
|
# |
105
|
|
|
|
|
|
|
# Tests if two values are equal. |
106
|
|
|
|
|
|
|
# |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub _equal_value { |
109
|
46
|
|
|
46
|
|
64
|
my ($self, $first, $last) = @_; |
110
|
|
|
|
|
|
|
|
111
|
46
|
|
|
|
|
120
|
return !!($first == $last); |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
### PRIVATE INSTANCE METHOD ### |
115
|
|
|
|
|
|
|
# |
116
|
|
|
|
|
|
|
# Tests if two values are consequent. |
117
|
|
|
|
|
|
|
# |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub _next_in_range { |
120
|
148
|
|
|
148
|
|
226
|
my ($self, $first, $last) = @_; |
121
|
|
|
|
|
|
|
|
122
|
148
|
|
|
|
|
322
|
return !!($last == $first + 1); |
123
|
|
|
|
|
|
|
}; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
1; |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
__END__ |