#!/usr/bin/perl
use strict;
use Data::Dump qw(dd pp);
use List::Util qw(reduce shuffle);
# the composables
sub Cmp { my ($x, $y) = @_; $x cmp $y }
sub Ncmp { my ($x, $y) = @_; $x <=> $y }
sub Reverse { map { scalar reverse $_ } @_ }
sub Length { map { length $_ } @_ }
sub Uc { map { uc $_ } @_ }
sub Transpose { reverse @_ }
sub Ab { ($a, $b) }
# naive composer using evil
# composes functions f, g, h into sub { f(g(h(@_))) }
sub Compose {
my $body = reduce { "$b($a)" } '@_', reverse @_;
eval "sub { $body }" or die $@;
}
# special case for sort
sub Compose_ab { Compose(@_, 'Ab') }
sub sorter {
my ($type, $src) = @_;
# Legend:
# i = case insensitive
# a = ascending
# d = descending
# r = reverse (right to left)
# n = numbers
# l = length of value
my %sorter = (
a => [qw/Cmp/],
d => [qw/Cmp Transpose/],
ai => [qw/Cmp Uc/],
di => [qw/Cmp Uc Transpose/],
an => [qw/Ncmp/],
dn => [qw/Ncmp Transpose/],
al => [qw/Ncmp Length/],
dl => [qw/Ncmp Length Transpose/],
ar => [qw/Cmp Reverse/],
dr => [qw/Cmp Reverse Transpose/],
air => [qw/Cmp Uc Reverse/],
dir => [qw/Cmp Uc Reverse Transpose/],
);
my @composed;
if ($type) {
$type = join '', sort split //, $type; # normalize
@composed = @{ $sorter{$type} }
or die "Unknown option: $type";
if ($src) {
push @composed, $src;
}
}
else {
@composed = @{ (shuffle values %sorter)[0] };
warn 'random criteria: ' . pp @composed;
}
return Compose_ab(@composed);
}
my @unsorted = qw(red lilac yelloW Green cyan blue magenta);
my $sort_type = shift;
my $criteria = sorter($sort_type);
dd sort $criteria @unsorted;
my %master_list = (
alpha => { members => 1 },
beta => { members => 3 },
gamma => { members => 8 },
delta => { members => 5 },
);
# custom source for $a, $b
sub Members { map { $master_list{$_}{members} } @_ }
$criteria = sorter($sort_type, 'Members');
dd sort $criteria keys %master_list;
|