File Coverage

blib/lib/Data/Unixish/sort.pm
Criterion Covered Total %
statement 41 46 89.1
branch 13 14 92.8
condition 3 5 60.0
subroutine 9 9 100.0
pod 1 1 100.0
total 67 75 89.3


line stmt bran cond sub pod time code
1             package Data::Unixish::sort;
2              
3 7     7   4276 use 5.010;
  7         26  
4 7     7   41 use strict;
  7         9  
  7         193  
5 7     7   459 use syntax 'each_on_array'; # to support perl < 5.12
  7         24032  
  7         54  
6 7     7   4522 use warnings;
  7         16  
  7         269  
7             #use Log::Any '$log';
8              
9 7     7   457 use Data::Unixish::Util qw(%common_args);
  7         14  
  7         1630  
10              
11             our $VERSION = '1.571'; # 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 241 my %args = @_;
63 34         198 my ($in, $out) = ($args{in}, $args{out});
64 34         143 my $numeric = $args{numeric};
65 34 100       105 my $reverse = $args{reverse} ? -1 : 1;
66 34         71 my $ci = $args{ci};
67 34         128 my $random = $args{random};
68              
69 7     7   45 no warnings;
  7         19  
  7         2380  
70 34         61 my @buf;
71              
72             # special case
73 34 50       86 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         356 while (my ($index, $item) = each @$in) {
83 122         8551 my $key;
84 122 100       248 if (defined $args{key_element}) {
85 3 100 50     13 $key = ref $item eq 'ARRAY' ? ($item->[$args{key_element}] // '') : $item;
86             } else {
87 119         215 $key = $item;
88             }
89 122 100       223 $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       804 push @buf, [$item, $key, $numeric ? $key+0 : undef];
93             }
94              
95 34         258 my $sortsub;
96 34 100       156 if ($numeric) {
97 10   66 10   35 $sortsub = sub { $reverse * (
98 2         9 ($a->[2] <=> $b->[2]) || ($a->[1] cmp $b->[1]) ) };
99             } else {
100 125     125   391 $sortsub = sub { $reverse * (
101 32         375 ($a->[1] cmp $b->[1]) ) };
102             }
103 34         299 @buf = sort $sortsub @buf;
104              
105 34         292 push @$out, $_->[0] for @buf;
106              
107 34         409 [200, "OK"];
108             }
109              
110             1;
111             # ABSTRACT: Sort items
112              
113             __END__