File Coverage

blib/lib/Sort/Sub/by_perl_op.pm
Criterion Covered Total %
statement 25 26 96.1
branch 6 10 60.0
condition n/a
subroutine 6 7 85.7
pod 0 2 0.0
total 37 45 82.2


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