#!/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;