line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sort::strverscmp; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
require Sort::strverscmp::StringIterator; |
4
|
|
|
|
|
|
|
|
5
|
3
|
|
|
3
|
|
28321
|
use Exporter 'import'; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
92
|
|
6
|
3
|
|
|
3
|
|
73
|
use 5.010; |
|
3
|
|
|
|
|
7
|
|
7
|
|
|
|
|
|
|
|
8
|
3
|
|
|
3
|
|
17
|
use strict; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
48
|
|
9
|
3
|
|
|
3
|
|
7
|
use warnings; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
1373
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = "0.014"; |
12
|
|
|
|
|
|
|
our @EXPORT = qw(strverscmp); |
13
|
|
|
|
|
|
|
our @EXPORT_OK = qw(strverssort versionsort); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# strnum_cmp from bam_sort.c |
16
|
|
|
|
|
|
|
sub strverscmp($$) { |
17
|
39
|
|
|
39
|
1
|
2841
|
my $ai = Sort::strverscmp::StringIterator->new($_[0]); |
18
|
39
|
|
|
|
|
62
|
my $bi = Sort::strverscmp::StringIterator->new($_[1]); |
19
|
|
|
|
|
|
|
|
20
|
39
|
|
66
|
|
|
33
|
do { |
21
|
123
|
100
|
66
|
|
|
171
|
if (_isdigit($ai->head) && _isdigit($bi->head)) { |
22
|
48
|
|
|
|
|
76
|
my $an = (($ai->head . $ai->tail) =~ /^(\d*)/)[0]; |
23
|
48
|
|
|
|
|
87
|
my $bn = (($bi->head . $bi->tail) =~ /^(\d*)/)[0]; |
24
|
48
|
100
|
100
|
|
|
148
|
if ($an =~ /^0\d/ || $bn =~ /^0\d/) { |
25
|
7
|
|
|
|
|
9
|
return _fcmp($an, $bn); |
26
|
|
|
|
|
|
|
} else { |
27
|
41
|
100
|
|
|
|
75
|
if ($an <=> $bn) { |
28
|
26
|
|
|
|
|
77
|
return ($an <=> $bn); |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
} else { |
32
|
75
|
100
|
|
|
|
106
|
if ($ai->head cmp $bi->head) { |
33
|
5
|
|
|
|
|
8
|
return ($ai->head cmp $bi->head); |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
} |
36
|
85
|
|
|
|
|
158
|
$ai->advance(); |
37
|
85
|
|
|
|
|
102
|
$bi->advance(); |
38
|
|
|
|
|
|
|
} while (defined($ai->head) && defined($bi->head)); |
39
|
|
|
|
|
|
|
|
40
|
1
|
50
|
|
|
|
5
|
return $ai->head ? 1 : $bi->head ? -1 : 0; |
|
|
50
|
|
|
|
|
|
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
1
|
|
|
1
|
1
|
14
|
sub versionsort { &strverssort } |
44
|
|
|
|
|
|
|
sub strverssort { |
45
|
1
|
|
|
1
|
0
|
6
|
return sort { strverscmp($a, $b) } @_; |
|
2
|
|
|
|
|
6
|
|
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub _isdigit { |
49
|
171
|
|
|
171
|
|
119
|
my $c = shift; |
50
|
171
|
|
66
|
|
|
783
|
return (defined($c) && $c =~ /^\d+$/); |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub _fcmp { |
54
|
7
|
|
|
7
|
|
10
|
my ($l, $r) = @_; |
55
|
|
|
|
|
|
|
|
56
|
7
|
|
|
|
|
4
|
my ($lz, $ln, $rz, $rn); |
57
|
7
|
|
|
|
|
8
|
($lz, $ln) = _decompose_fractional($l); |
58
|
7
|
|
|
|
|
9
|
($rz, $rn) = _decompose_fractional($r); |
59
|
|
|
|
|
|
|
|
60
|
7
|
100
|
|
|
|
12
|
if (length($lz) == length($rz)) { |
61
|
1
|
|
|
|
|
5
|
return $ln <=> $rn; |
62
|
|
|
|
|
|
|
} else { |
63
|
6
|
100
|
|
|
|
33
|
return (length($lz) > length($rz) ? -1 : 1); |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub _decompose_fractional { |
68
|
14
|
|
|
14
|
|
31
|
my ($zeroes, $number) = shift =~ /^(0*)(\d+)$/; |
69
|
14
|
|
|
|
|
22
|
return ($zeroes, $number); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
1; |
73
|
|
|
|
|
|
|
__END__ |