#!/usr/bin/perl 
use strict;
use feature qw(switch say);
use List::Util qw(shuffle);

sub short_sorter {
    my ($type) = @_;

    # Legend:
    # i = case insensitive
    # a  = ascending
    # d  = descending
    # r  = reverse (right to left)
    # n  = numbers
    # l  = length of value

    my %sorter = (
        a   => sub { $a cmp $b },
        d   => sub { $b cmp $a },
        ai  => sub { uc $a cmp uc $b }, 
        di  => sub { uc $b cmp uc $a },
        an  => sub { $a <=> $b },
        dn  => sub { $b <=> $a },
        al  => sub { length($a) <=> length($b) },
        dl  => sub { length($b) <=> length($a) },
        ar  => sub { reverse($a) cmp reverse($b) },
        dr  => sub { reverse($b) cmp reverse($a) },
        air => sub { uc reverse($a) cmp uc reverse($b) },
        dir => sub { uc reverse($b) cmp uc reverse($a) },
    );
    given ($type) {
        when ('dr') { $sorter{$type} = $sorter{dr} }
        when ('ra') { $sorter{$type} = $sorter{ar} }
        when ('ia') { $sorter{$type} = $sorter{ai} }
        when ('id') { $sorter{$type} = $sorter{di} }
        when ('na') { $sorter{$type} = $sorter{an} }
        when ('nd') { $sorter{$type} = $sorter{dn} }
        when ('la') { $sorter{$type} = $sorter{al} }
        when ('ld') { $sorter{$type} = $sorter{dl} }
        when ([qw[ari iar ira rai ria]]) {
            $sorter{$type} = $sorter{air};
        }
        when ([qw[dri idr ird rdi rid]]) {
            $sorter{$type} = $sorter{dir};
        }
    }

    if ($type) {
        return $sorter{$type} or die "Unknown options: $type";
    }
    else {
        return (shuffle values %sorter)[0];
    }
}

my @unsorted = qw(red lilac yelloW green cyan blue magenta);
my $criteria = short_sorter('dri');
my @sorted   = sort $criteria @unsorted;

print "$_\n" for @sorted;