File Coverage

blib/lib/Sorter/from_sortkey.pm

Criterion	Covered	Total	%
statement	8	26	30.7
branch	0	10	0.0
condition			n/a
subroutine	3	6	50.0
pod	0	2	0.0
total	11	44	25.0

package Sorter::from_sortkey;

use 5.010001;
use strict 'subs', 'vars';
use warnings;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2024-01-24'; # DATE
our $DIST = 'Sorter-from_sortkey'; # DIST
our $VERSION = '0.001'; # VERSION

sub meta {
    return +{
        v => 1,
        args => {
            sortkey => {schema=>'perl::sortkey::modname_with_optional_args*', req=>1},
            reverse => {schema => 'bool*'},
            ci => {schema => 'bool*'},
        },
    };
}

sub gen_sorter {
    my %args = @_;

    my $sortkey = $args{sortkey} or die "Please specify sortkey";
    my $reverse = $args{reverse};
    my $ci = $args{ci};

    require Module::Load::Util;

    my ($mod, $args) = Module::Load::Util::_normalize_module_with_optional_args($sortkey);
    $mod = Module::Load::Util::_load_module({ns_prefix=>"SortKey"}, $mod);
    my $is_num = $mod =~ /\ASortKey::Num::/ ? 1:0;
    my $keygen = &{"$mod\::gen_keygen"}(@$args);

    sub {
        my @records = map {
            my $key = $args{ci} ? lc($keygen->($_)) : $keygen->($_);
            [$_, $key];
        } @_;

        map { $_->[0] } sort { ($is_num ? ($a->[1] <=> $b->[1]) : ($a->[1] cmp $b->[1])) * ($reverse ? -1:1) } @records;
    };
}

1;
# ABSTRACT: Sort by keys generated by a SortKey:: module

__END__