#!/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 },
    );
    given ($type) {
        when ([qw[dr rd]]) { $sorter{$type} = sub { reverse($b) cmp reverse($a) }; }
        when ([qw[ar ra]]) { $sorter{$type} = sub { reverse($a) cmp reverse($b) }; }
        when ([qw[ai ia]]) { $sorter{$type} = sub { uc $a cmp uc $b }; }
        when ([qw[di id]]) { $sorter{$type} = sub { uc $b cmp uc $a }; }
        when ([qw[an na]]) { $sorter{$type} = sub { $a <=> $b }; }
        when ([qw[nd dn]]) { $sorter{$type} = sub { $b <=> $a }; }
        when ([qw[la al]]) { $sorter{$type} = sub { length($a) <=> length($b) }; }
        when ([qw[ld dl]]) { $sorter{$type} = sub { length($b) <=> length($a) }; }
        when ([qw[air ari iar ira rai ria]]) {
            $sorter{$type} = sub { uc reverse($a) cmp uc reverse($b) };
        }
        when ([qw[dir dri idr ird rdi rid]]) {
            $sorter{$type} = sub { uc reverse($b) cmp uc reverse($a) };
        }
    }

    if ($type) {
        return $sorter{$type} or die 'AAARGH!!';
    }
    else {
        return (shuffle values %sorter)[0];
    }
}

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

print "$_\n" for @sorted;

__DATA__
yelloW
green
cyan
blue
red
lilac
magenta