line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Regexp::Common::number; |
2
|
|
|
|
|
|
|
|
3
|
71
|
|
|
71
|
|
585
|
use 5.10.0; |
|
71
|
|
|
|
|
151
|
|
4
|
|
|
|
|
|
|
|
5
|
71
|
|
|
71
|
|
225
|
use strict; |
|
71
|
|
|
|
|
81
|
|
|
71
|
|
|
|
|
1152
|
|
6
|
71
|
|
|
71
|
|
199
|
use warnings; |
|
71
|
|
|
|
|
87
|
|
|
71
|
|
|
|
|
1442
|
|
7
|
71
|
|
|
71
|
|
199
|
no warnings 'syntax'; |
|
71
|
|
|
|
|
174
|
|
|
71
|
|
|
|
|
1703
|
|
8
|
|
|
|
|
|
|
|
9
|
71
|
|
|
71
|
|
232
|
use Config; |
|
71
|
|
|
|
|
68
|
|
|
71
|
|
|
|
|
2570
|
|
10
|
71
|
|
|
71
|
|
908
|
use Regexp::Common qw /pattern clean no_defaults/; |
|
71
|
|
|
|
|
70
|
|
|
71
|
|
|
|
|
336
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '2016060801'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub _croak { |
16
|
4
|
|
|
4
|
|
24
|
require Carp; |
17
|
4
|
|
|
|
|
335
|
goto &Carp::croak; |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
my $digits = join ("", 0 .. 9, "A" .. "Z"); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub int_creator { |
23
|
13908
|
|
|
13908
|
0
|
12277
|
my $flags = $_ [1]; |
24
|
|
|
|
|
|
|
my ($sep, $group, $base, $places, $sign) = |
25
|
13908
|
|
|
|
|
11314
|
@{$flags} {qw /-sep -group -base -places -sign/}; |
|
13908
|
|
|
|
|
21976
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# Deal with the bases. |
28
|
13908
|
50
|
33
|
|
|
54194
|
_croak "Base must be between 1 and 36" unless $base >= 1 && |
29
|
|
|
|
|
|
|
$base <= 36; |
30
|
13908
|
|
|
|
|
17769
|
my $chars = substr $digits, 0, $base; |
31
|
|
|
|
|
|
|
|
32
|
13908
|
50
|
33
|
|
|
51490
|
$sep = ',' if exists $flags -> {-sep} && !defined $flags -> {-sep}; |
33
|
|
|
|
|
|
|
|
34
|
13908
|
|
|
|
|
10861
|
my $max = $group; |
35
|
13908
|
100
|
|
|
|
18293
|
$max = $2 if $group =~ /^\s*(\d+)\s*,\s*(\d+)\s*$/; |
36
|
|
|
|
|
|
|
|
37
|
13908
|
100
|
|
|
|
19240
|
my $quant = $places ? "{$places}" : "+"; |
38
|
|
|
|
|
|
|
|
39
|
13908
|
100
|
|
|
|
44732
|
return $sep ? qq {(?k:(?k:$sign)(?k:[$chars]{1,$max}} . |
40
|
|
|
|
|
|
|
qq {(?:$sep} . qq {[$chars]{$group})*))} |
41
|
|
|
|
|
|
|
: qq {(?k:(?k:$sign)(?k:[$chars]$quant))} |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub real_creator { |
45
|
|
|
|
|
|
|
my ($base, $places, $radix, $sep, $group, $expon, $sign) = |
46
|
45
|
|
|
45
|
0
|
95
|
@{$_[1]}{-base, -places, -radix, -sep, -group, -expon, -sign}; |
|
45
|
|
|
|
|
132
|
|
47
|
45
|
100
|
100
|
|
|
202
|
_croak "Base must be between 1 and 36" |
48
|
|
|
|
|
|
|
unless $base >= 1 && $base <= 36; |
49
|
|
|
|
|
|
|
$sep = ',' if exists $_[1]->{-sep} |
50
|
43
|
100
|
66
|
|
|
208
|
&& !defined $_[1]->{-sep}; |
51
|
43
|
100
|
66
|
|
|
129
|
if ($base > 14 && $expon =~ /^[Ee]$/) {$expon = 'G'} |
|
14
|
|
|
|
|
17
|
|
52
|
43
|
100
|
|
|
|
63
|
foreach ($radix, $sep, $expon) {$_ = "[$_]" if 1 == length} |
|
129
|
|
|
|
|
234
|
|
53
|
43
|
|
|
|
|
66
|
my $chars = substr $digits, 0, $base; |
54
|
43
|
100
|
|
|
|
267
|
return $sep |
55
|
|
|
|
|
|
|
? qq {(?k:(?i)(?k:$sign)(?k:(?=$radix?[$chars])} . |
56
|
|
|
|
|
|
|
qq {(?k:[$chars]{1,$group}(?:(?:$sep)[$chars]{$group})*)} . |
57
|
|
|
|
|
|
|
qq {(?:(?k:$radix)(?k:[$chars]{$places}))?)} . |
58
|
|
|
|
|
|
|
qq {(?:(?k:$expon)(?k:(?k:$sign)(?k:[$chars]+))|))} |
59
|
|
|
|
|
|
|
: qq {(?k:(?i)(?k:$sign)(?k:(?=$radix?[$chars])} . |
60
|
|
|
|
|
|
|
qq {(?k:[$chars]*)(?:(?k:$radix)(?k:[$chars]{$places}))?)} . |
61
|
|
|
|
|
|
|
qq {(?:(?k:$expon)(?k:(?k:$sign)(?k:[$chars]+))|))}; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
sub decimal_creator { |
64
|
|
|
|
|
|
|
my ($base, $places, $radix, $sep, $group, $sign) = |
65
|
3721
|
|
|
3721
|
0
|
5103
|
@{$_[1]}{-base, -places, -radix, -sep, -group, -sign}; |
|
3721
|
|
|
|
|
7037
|
|
66
|
3721
|
100
|
100
|
|
|
13077
|
_croak "Base must be between 1 and 36" |
67
|
|
|
|
|
|
|
unless $base >= 1 && $base <= 36; |
68
|
|
|
|
|
|
|
$sep = ',' if exists $_[1]->{-sep} |
69
|
3719
|
50
|
33
|
|
|
12489
|
&& !defined $_[1]->{-sep}; |
70
|
3719
|
100
|
|
|
|
3976
|
foreach ($radix, $sep) {$_ = "[$_]" if 1 == length} |
|
7438
|
|
|
|
|
10729
|
|
71
|
3719
|
|
|
|
|
4411
|
my $chars = substr $digits, 0, $base; |
72
|
3719
|
50
|
|
|
|
12798
|
return $sep |
73
|
|
|
|
|
|
|
? qq {(?k:(?i)(?k:$sign)(?k:(?=$radix?[$chars])} . |
74
|
|
|
|
|
|
|
qq {(?k:[$chars]{1,$group}(?:(?:$sep)[$chars]{$group})*)} . |
75
|
|
|
|
|
|
|
qq {(?:(?k:$radix)(?k:[$chars]{$places}))?))} |
76
|
|
|
|
|
|
|
: qq {(?k:(?i)(?k:$sign)(?k:(?=$radix?[$chars])} . |
77
|
|
|
|
|
|
|
qq {(?k:[$chars]*)(?:(?k:$radix)(?k:[$chars]{$places}))?))} |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
pattern name => [qw (num int -sep= -base=10 -group=3 -sign=[-+]?)], |
82
|
|
|
|
|
|
|
create => \&int_creator, |
83
|
|
|
|
|
|
|
; |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
pattern name => [qw (num real -base=10), '-places=0,', |
86
|
|
|
|
|
|
|
qw (-radix=[.] -sep= -group=3 -expon=E -sign=[-+]?)], |
87
|
|
|
|
|
|
|
create => \&real_creator, |
88
|
|
|
|
|
|
|
; |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
pattern name => [qw (num decimal -base=10), '-places=0,', |
91
|
|
|
|
|
|
|
qw (-radix=[.] -sep= -group=3 -sign=[-+]?)], |
92
|
|
|
|
|
|
|
create => \&decimal_creator, |
93
|
|
|
|
|
|
|
; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
sub real_synonym { |
96
|
284
|
|
|
284
|
0
|
342
|
my ($name, $base) = @_; |
97
|
|
|
|
|
|
|
pattern name => ['num', $name, '-places=0,', '-radix=[.]', |
98
|
|
|
|
|
|
|
'-sep=', '-group=3', '-expon=E', '-sign=[-+]?'], |
99
|
17
|
|
|
17
|
|
23
|
create => sub {my %flags = (%{$_[1]}, -base => $base); |
|
17
|
|
|
|
|
130
|
|
100
|
17
|
|
|
|
|
44
|
real_creator (undef, \%flags); |
101
|
|
|
|
|
|
|
} |
102
|
284
|
|
|
|
|
1135
|
; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
real_synonym (hex => 16); |
107
|
|
|
|
|
|
|
real_synonym (dec => 10); |
108
|
|
|
|
|
|
|
real_synonym (oct => 8); |
109
|
|
|
|
|
|
|
real_synonym (bin => 2); |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# 2147483647 == 2^31 - 1 |
113
|
|
|
|
|
|
|
# 9223372036854775807 == 2^63 - 1 |
114
|
|
|
|
|
|
|
pattern name => [qw (num square)], |
115
|
|
|
|
|
|
|
create => sub { |
116
|
71
|
|
|
71
|
|
332
|
use re 'eval'; |
|
71
|
|
|
|
|
85
|
|
|
71
|
|
|
|
|
11841
|
|
117
|
|
|
|
|
|
|
my $sixty_four_bits = $Config {use64bitint}; |
118
|
|
|
|
|
|
|
# |
119
|
|
|
|
|
|
|
# CPAN testers claim it fails on 5.8.8 and darwin 9.0. |
120
|
|
|
|
|
|
|
# |
121
|
|
|
|
|
|
|
my $num = $sixty_four_bits |
122
|
|
|
|
|
|
|
? '0*(?:(?:9(?:[0-1][0-9]{17}' . |
123
|
|
|
|
|
|
|
'|2(?:[0-1][0-9]{16}' . |
124
|
|
|
|
|
|
|
'|2(?:[0-2][0-9]{15}' . |
125
|
|
|
|
|
|
|
'|3(?:[0-2][0-9]{14}' . |
126
|
|
|
|
|
|
|
'|3(?:[0-6][0-9]{13}' . |
127
|
|
|
|
|
|
|
'|7(?:[0-1][0-9]{12}' . |
128
|
|
|
|
|
|
|
'|20(?:[0-2][0-9]{10}' . |
129
|
|
|
|
|
|
|
'|3(?:[0-5][0-9]{9}' . |
130
|
|
|
|
|
|
|
'|6(?:[0-7][0-9]{8}' . |
131
|
|
|
|
|
|
|
'|8(?:[0-4][0-9]{7}' . |
132
|
|
|
|
|
|
|
'|5(?:[0-3][0-9]{6}' . |
133
|
|
|
|
|
|
|
'|4(?:[0-6][0-9]{5}' . |
134
|
|
|
|
|
|
|
'|7(?:[0-6][0-9]{4}' . |
135
|
|
|
|
|
|
|
'|7(?:[0-4][0-9]{3}' . |
136
|
|
|
|
|
|
|
'|5(?:[0-7][0-9]{2}' . |
137
|
|
|
|
|
|
|
'|80(?:[0-6])))))))))))))))))|[1-8]?[0-9]{0,18})' |
138
|
|
|
|
|
|
|
: '0*(?:2(?:[0-0][0-9]{8}' . |
139
|
|
|
|
|
|
|
'|1(?:[0-3][0-9]{7}' . |
140
|
|
|
|
|
|
|
'|4(?:[0-6][0-9]{6}' . |
141
|
|
|
|
|
|
|
'|7(?:[0-3][0-9]{5}' . |
142
|
|
|
|
|
|
|
'|4(?:[0-7][0-9]{4}' . |
143
|
|
|
|
|
|
|
'|8(?:[0-2][0-9]{3}' . |
144
|
|
|
|
|
|
|
'|3(?:[0-5][0-9]{2}' . |
145
|
|
|
|
|
|
|
'|6(?:[0-3][0-9]{1}' . |
146
|
|
|
|
|
|
|
'|4[0-7])))))))))|1?[0-9]{1,9}'; |
147
|
|
|
|
|
|
|
qr {($num)(?(?{length $^N && sqrt ($^N) == int sqrt ($^N)})|(?!))} |
148
|
|
|
|
|
|
|
}, |
149
|
|
|
|
|
|
|
; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
pattern name => [qw (num roman)], |
152
|
|
|
|
|
|
|
create => '(?xi)(?=[MDCLXVI]) |
153
|
|
|
|
|
|
|
(?k:M{0,4} |
154
|
|
|
|
|
|
|
(?:C[DM]|D?C{0,4})? |
155
|
|
|
|
|
|
|
(?:X[LC]|L?X{0,4})? |
156
|
|
|
|
|
|
|
(?:I[VX]|V?I{0,4})?)' |
157
|
|
|
|
|
|
|
; |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
1; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
__END__ |