line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::Unixish::sort; |
2
|
|
|
|
|
|
|
|
3
|
7
|
|
|
7
|
|
4453
|
use 5.010; |
|
7
|
|
|
|
|
23
|
|
4
|
7
|
|
|
7
|
|
45
|
use strict; |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
212
|
|
5
|
7
|
|
|
7
|
|
369
|
use syntax 'each_on_array'; # to support perl < 5.12 |
|
7
|
|
|
|
|
19468
|
|
|
7
|
|
|
|
|
49
|
|
6
|
7
|
|
|
7
|
|
3868
|
use warnings; |
|
7
|
|
|
|
|
15
|
|
|
7
|
|
|
|
|
278
|
|
7
|
|
|
|
|
|
|
#use Log::Any '$log'; |
8
|
|
|
|
|
|
|
|
9
|
7
|
|
|
7
|
|
391
|
use Data::Unixish::Util qw(%common_args); |
|
7
|
|
|
|
|
19
|
|
|
7
|
|
|
|
|
1719
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '1.572'; # VERSION |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our %SPEC; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
$SPEC{sort} = { |
16
|
|
|
|
|
|
|
v => 1.1, |
17
|
|
|
|
|
|
|
summary => 'Sort items', |
18
|
|
|
|
|
|
|
description => <<'_', |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
By default sort ascibetically, unless `numeric` is set to true to sort |
21
|
|
|
|
|
|
|
numerically. |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
_ |
24
|
|
|
|
|
|
|
args => { |
25
|
|
|
|
|
|
|
%common_args, |
26
|
|
|
|
|
|
|
numeric => { |
27
|
|
|
|
|
|
|
summary => 'Whether to sort numerically', |
28
|
|
|
|
|
|
|
schema=>[bool => {default=>0}], |
29
|
|
|
|
|
|
|
cmdline_aliases => { n=>{} }, |
30
|
|
|
|
|
|
|
}, |
31
|
|
|
|
|
|
|
reverse => { |
32
|
|
|
|
|
|
|
summary => 'Whether to reverse sort result', |
33
|
|
|
|
|
|
|
schema=>[bool => {default=>0}], |
34
|
|
|
|
|
|
|
cmdline_aliases => { r=>{} }, |
35
|
|
|
|
|
|
|
}, |
36
|
|
|
|
|
|
|
ci => { |
37
|
|
|
|
|
|
|
summary => 'Whether to ignore case', |
38
|
|
|
|
|
|
|
schema=>[bool => {default=>0}], |
39
|
|
|
|
|
|
|
cmdline_aliases => { i=>{} }, |
40
|
|
|
|
|
|
|
}, |
41
|
|
|
|
|
|
|
random => { |
42
|
|
|
|
|
|
|
summary => 'Whether to sort by random', |
43
|
|
|
|
|
|
|
schema=>[bool => {default=>0}], |
44
|
|
|
|
|
|
|
cmdline_aliases => { R=>{} }, |
45
|
|
|
|
|
|
|
}, |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
key_element => { |
48
|
|
|
|
|
|
|
summary => 'Sort using an array element', |
49
|
|
|
|
|
|
|
schema => 'uint*', |
50
|
|
|
|
|
|
|
description => <<'_', |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
If specified, `sort` will assume the item is an array and will sort using the |
53
|
|
|
|
|
|
|
'th element (zero-based) as key. If an item turns out to not be an |
54
|
|
|
|
|
|
|
array, the item itself is used as key. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
_ |
57
|
|
|
|
|
|
|
}, |
58
|
|
|
|
|
|
|
}, |
59
|
|
|
|
|
|
|
tags => [qw/ordering/], |
60
|
|
|
|
|
|
|
}; |
61
|
|
|
|
|
|
|
sub sort { |
62
|
34
|
|
|
34
|
1
|
319
|
my %args = @_; |
63
|
34
|
|
|
|
|
152
|
my ($in, $out) = ($args{in}, $args{out}); |
64
|
34
|
|
|
|
|
111
|
my $numeric = $args{numeric}; |
65
|
34
|
100
|
|
|
|
140
|
my $reverse = $args{reverse} ? -1 : 1; |
66
|
34
|
|
|
|
|
76
|
my $ci = $args{ci}; |
67
|
34
|
|
|
|
|
92
|
my $random = $args{random}; |
68
|
|
|
|
|
|
|
|
69
|
7
|
|
|
7
|
|
48
|
no warnings; |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
2352
|
|
70
|
34
|
|
|
|
|
71
|
my @buf; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
# special case |
73
|
34
|
50
|
|
|
|
100
|
if ($random) { |
74
|
0
|
|
|
|
|
0
|
require List::Util; |
75
|
0
|
|
|
|
|
0
|
while (my ($index, $item) = each @$in) { |
76
|
0
|
|
|
|
|
0
|
push @buf, $item; |
77
|
|
|
|
|
|
|
} |
78
|
0
|
|
|
|
|
0
|
push @$out, $_ for (List::Util::shuffle(@buf)); |
79
|
0
|
|
|
|
|
0
|
return [200, "OK"]; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
34
|
|
|
|
|
368
|
while (my ($index, $item) = each @$in) { |
83
|
122
|
|
|
|
|
8561
|
my $key; |
84
|
122
|
100
|
|
|
|
252
|
if (defined $args{key_element}) { |
85
|
3
|
100
|
50
|
|
|
10
|
$key = ref $item eq 'ARRAY' ? ($item->[$args{key_element}] // '') : $item; |
86
|
|
|
|
|
|
|
} else { |
87
|
119
|
|
|
|
|
180
|
$key = $item; |
88
|
|
|
|
|
|
|
} |
89
|
122
|
100
|
|
|
|
216
|
$key = lc($key) if $ci; |
90
|
|
|
|
|
|
|
# XXX: optimize: when !ci && !key_element, just use $item as $key so no |
91
|
|
|
|
|
|
|
# need to produce a separate $key |
92
|
122
|
100
|
|
|
|
866
|
push @buf, [$item, $key, $numeric ? $key+0 : undef]; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
34
|
|
|
|
|
207
|
my $sortsub; |
96
|
34
|
100
|
|
|
|
133
|
if ($numeric) { |
97
|
10
|
|
66
|
10
|
|
24
|
$sortsub = sub { $reverse * ( |
98
|
2
|
|
|
|
|
9
|
($a->[2] <=> $b->[2]) || ($a->[1] cmp $b->[1]) ) }; |
99
|
|
|
|
|
|
|
} else { |
100
|
125
|
|
|
125
|
|
432
|
$sortsub = sub { $reverse * ( |
101
|
32
|
|
|
|
|
424
|
($a->[1] cmp $b->[1]) ) }; |
102
|
|
|
|
|
|
|
} |
103
|
34
|
|
|
|
|
313
|
@buf = sort $sortsub @buf; |
104
|
|
|
|
|
|
|
|
105
|
34
|
|
|
|
|
325
|
push @$out, $_->[0] for @buf; |
106
|
|
|
|
|
|
|
|
107
|
34
|
|
|
|
|
394
|
[200, "OK"]; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
1; |
111
|
|
|
|
|
|
|
# ABSTRACT: Sort items |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
__END__ |