File Coverage

blib/lib/Sort/Sub/by_example.pm
Criterion Covered Total %
statement 20 28 71.4
branch 5 12 41.6
condition n/a
subroutine 5 7 71.4
pod 0 2 0.0
total 30 49 61.2


line stmt bran cond sub pod time code
1             package Sort::Sub::by_example;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2020-05-24'; # DATE
5             our $DIST = 'Sort-Sub-by_example'; # DIST
6             our $VERSION = '0.001'; # VERSION
7              
8 1     1   1756 use 5.010001;
  1         4  
9 1     1   5 use strict;
  1         2  
  1         21  
10 1     1   4 use warnings;
  1         2  
  1         204  
11              
12             sub meta {
13             return {
14 0     0 0 0 v => 1,
15             summary => 'Sort by example',
16             args => {
17             example => {
18             summary => 'Either an arrayref or comma-separated string',
19             schema => ['any' => {of=>['array*', 'str*']}],
20             req => 1,
21             pos => 0,
22             },
23             },
24             };
25             }
26              
27             sub gen_sorter {
28 2     2 0 1673 require Sort::ByExample;
29              
30 2         12559 my ($is_reverse, $is_ci, $args) = @_;
31              
32 2 50       7 die "Reverse sorting not yet supported" if $is_reverse;
33              
34             my $example = ref $args->{example} eq 'ARRAY' ?
35 2 50       23 [@{$args->{example}}] : [split /\s*,\s*/, $args->{example}];
  0         0  
36 2 100       9 $example = [map {lc} @$example] if $is_ci;
  5         14  
37              
38 2         11 my $cmp = Sort::ByExample->cmp($example);
39 2 50       85 if ($is_reverse) {
40             return sub {
41 1     1   8 no strict 'refs';
  1         2  
  1         150  
42              
43 0     0   0 my $caller = caller();
44 0 0       0 my $a = @_ ? $_[0] : ${"$caller\::a"};
  0         0  
45 0 0       0 my $b = @_ ? $_[1] : ${"$caller\::b"};
  0         0  
46 0         0 };
47             } else {
48 2         9 return $cmp;
49             }
50             }
51              
52             1;
53             # ABSTRACT: Sort by example
54              
55             __END__