File Coverage

blib/lib/Sort/Sub/by_several.pm

Criterion	Covered	Total	%
statement	32	41	78.0
branch	13	32	40.6
condition			n/a
subroutine	6	7	85.7
pod	0	2	0.0
total	51	82	62.2

package Sort::Sub::by_several;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2019-12-17'; # DATE
our $DIST = 'Sort-Sub-by_several'; # DIST
our $VERSION = '0.001'; # VERSION

use 5.010001;
use strict;
use warnings;

sub meta {
    return {
        v => 1,
        summary => 'Sort by one or more sorters',
        args => {
            first  => {schema=>'sortsub::spec*', req=>1, pos=>0},
            second => {schema=>'sortsub::spec*', req=>0, pos=>1},
            third  => {schema=>'sortsub::spec*', req=>0, pos=>2},
            fourth => {schema=>'sortsub::spec*', req=>0, pos=>3},
            fifth  => {schema=>'sortsub::spec*', req=>0, pos=>4},
        },
        args_rels => {
            'dep_any&' => [
                [second => ['first']],
                [third  => ['second']],
                [fourth => ['third']],
                [fifth  => ['fourth']],
            ],
        },
    };
}

sub gen_sorter {
    require Sort::Sub;
    my ($is_reverse, $is_ci, $args) = @_;

    my $sorter1 = defined $args->{first}  ? Sort::Sub::get_sorter($args->{first} ) : undef;
    my $sorter2 = defined $args->{second} ? Sort::Sub::get_sorter($args->{second}) : undef;
    my $sorter3 = defined $args->{third}  ? Sort::Sub::get_sorter($args->{third} ) : undef;
    my $sorter4 = defined $args->{fourth} ? Sort::Sub::get_sorter($args->{fourth}) : undef;
    my $sorter5 = defined $args->{fifth}  ? Sort::Sub::get_sorter($args->{fifth} ) : undef;

    sub {
        no strict 'refs';

        my $caller = caller();
        my $a = @_ ? $_[0] : ${"$caller\::a"};
        my $b = @_ ? $_[1] : ${"$caller\::b"};

        my $cmp;

        {
            $cmp = $sorter1->($a, $b); last if $cmp; last unless $sorter2;
            $cmp = $sorter2->($a, $b); last if $cmp; last unless $sorter3;
            $cmp = $sorter3->($a, $b); last if $cmp; last unless $sorter4;
            $cmp = $sorter4->($a, $b); last if $cmp; last unless $sorter5;
            $cmp = $sorter5->($a, $b);
        }

        $is_reverse ? -1*$cmp : $cmp;
    };
}

1;
# ABSTRACT: Sort by one or more sorters

__END__