File Coverage

blib/lib/Sort/Sub/by_perl_code.pm
Criterion Covered Total %
statement 41 44 93.1
branch 8 12 66.6
condition n/a
subroutine 12 13 92.3
pod 0 2 0.0
total 61 71 85.9


line stmt bran cond sub pod time code
1             package Sort::Sub::by_perl_code;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2020-05-25'; # DATE
5             our $DIST = 'Sort-Sub'; # DIST
6             our $VERSION = '0.120'; # VERSION
7              
8 1     1   17 use 5.010;
  1         3  
9 1     1   4 use strict;
  1         1  
  1         17  
10 1     1   4 use warnings;
  1         1  
  1         154  
11              
12             sub meta {
13             return {
14 0     0 0 0 v => 1,
15             summary => 'Sort by Perl code',
16             args => {
17             code => {
18             summary => 'Either compiled code or string code excluding the "sub {" and "}" enclosure',
19             description => <<'_',
20              
21             Code should accept two arguments (the operands to be compared) and is expected
22             to return -1, 0, -1 like the builtin `cmp` operator.
23              
24             _
25             schema => 'str*',
26             req => 1,
27             },
28             },
29             };
30             }
31             sub gen_sorter {
32 6     6 0 13 my ($is_reverse, $is_ci, $args) = @_;
33              
34 6         8 my $code = $args->{code};
35 6 50       12 die "Please supply sorter argument 'code'"
36             unless defined $code;
37              
38 6 100       11 if (ref $code ne 'CODE') {
39 1     1   5 $code = eval "no strict; no warnings; sub { $code }";
  1     1   2  
  1     1   18  
  1     1   4  
  1     1   2  
  1     1   45  
  1         11  
  1         2  
  1         19  
  1         4  
  1         2  
  1         45  
  1         5  
  1         2  
  1         35  
  1         5  
  1         2  
  1         36  
  3         180  
40 3 50       10 die "Can't compile $code: $@" if $@;
41             }
42              
43             sub {
44 1     1   6 no strict 'refs';
  1         1  
  1         150  
45              
46 16     16   22 my $caller = caller();
47 16 50       22 my $a = @_ ? $_[0] : ${"$caller\::a"};
  0         0  
48 16 50       22 my $b = @_ ? $_[1] : ${"$caller\::b"};
  0         0  
49              
50 16         145 my $cmp = $code->($a, $b);
51 16 100       61 $is_reverse ? -1*$cmp : $cmp;
52 6         26 };
53             }
54              
55             1;
56             # ABSTRACT: Sort by Perl code
57              
58             __END__
59              
60             =pod
61              
62             =encoding UTF-8
63              
64             =head1 NAME
65              
66             Sort::Sub::by_perl_code - Sort by Perl code
67              
68             =head1 VERSION
69              
70             This document describes version 0.120 of Sort::Sub::by_perl_code (from Perl distribution Sort-Sub), released on 2020-05-25.
71              
72             =head1 SYNOPSIS
73              
74             Generate sorter (accessed as variable) via L<Sort::Sub> import:
75              
76             use Sort::Sub '$by_perl_code'; # use '$by_perl_code<i>' for case-insensitive sorting, '$by_perl_code<r>' for reverse sorting
77             my @sorted = sort $by_perl_code ('item', ...);
78              
79             Generate sorter (accessed as subroutine):
80              
81             use Sort::Sub 'by_perl_code<ir>';
82             my @sorted = sort {by_perl_code} ('item', ...);
83              
84             Generate directly without Sort::Sub:
85              
86             use Sort::Sub::by_perl_code;
87             my $sorter = Sort::Sub::by_perl_code::gen_sorter(
88             ci => 1, # default 0, set 1 to sort case-insensitively
89             reverse => 1, # default 0, set 1 to sort in reverse order
90             );
91             my @sorted = sort $sorter ('item', ...);
92              
93             Use in shell/CLI with L<sortsub> (from L<App::sortsub>):
94              
95             % some-cmd | sortsub by_perl_code
96             % some-cmd | sortsub by_perl_code --ignore-case -r
97              
98             =head1 DESCRIPTION
99              
100             This:
101              
102             use Sort::Sub '$by_perl_code', {code=>'length $_[0] <=> length $_[1]'};
103             my @sorted = sort $by_perl_code @data;
104              
105             is equivalent to:
106              
107             my @sorted = sort { length $a <=> length $b } @data;
108              
109             Case-sensitivity flag C<i> is not relevant.
110              
111             =for Pod::Coverage ^(gen_sorter|meta)$
112              
113             =head1 SORT ARGUMENTS
114              
115             C<*> marks required arguments.
116              
117             =head2 code*
118              
119             str.
120              
121             Either compiled code or string code excluding the "sub {" and "}" enclosure.
122              
123             Code should accept two arguments (the operands to be compared) and is expected
124             to return -1, 0, -1 like the builtin C<cmp> operator.
125              
126             =head1 HOMEPAGE
127              
128             Please visit the project's homepage at L<https://metacpan.org/release/Sort-Sub>.
129              
130             =head1 SOURCE
131              
132             Source repository is at L<https://github.com/perlancar/perl-Sort-Sub>.
133              
134             =head1 BUGS
135              
136             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Sort-Sub>
137              
138             When submitting a bug or request, please include a test-file or a
139             patch to an existing test-file that illustrates the bug or desired
140             feature.
141              
142             =head1 SEE ALSO
143              
144             L<Sort::Sub>
145              
146             =head1 AUTHOR
147              
148             perlancar <perlancar@cpan.org>
149              
150             =head1 COPYRIGHT AND LICENSE
151              
152             This software is copyright (c) 2020, 2019, 2018, 2016, 2015 by perlancar@cpan.org.
153              
154             This is free software; you can redistribute it and/or modify it under
155             the same terms as the Perl 5 programming language system itself.
156              
157             =cut