package SortCustom; my @d_ord = sort (map{ chr($_) } (0..255)); my %d_map = map { $d_ord[$_] => $_ } (0..$#d_ord); sub csort { my ($A,$B) = @_; my $res = 0; my $ndx = 0; while ($ndx < length($A)) { if (length($B) < $ndx) { $res = 1; last; } my ($cA, $cB) = ( substr($A,$ndx,1) , substr($B,$ndx,1) ); $res = ($d_map{$cA} <=> $d_map{$cB}); last if $res != 0; } continue { $ndx++; } return $res; } sub set_order { my $key = \@_; my @val = sort map { $d_map{$_} } @$key; my ($low, $hi) = ($val[0], $val[-1]); for (@$key) { $d_map{$_} = undef } undef @d_ord; for ( sort { $d_map{$a} <=> $d_map{$b} } keys %d_map ) { next unless defined $d_map{$_}; if ( @d_ord < $low || !defined $key ) { push @d_ord, $_; } else { push @d_ord, @$key; $key = undef; } } %d_map = map { $d_ord[$_] => $_ } (0..$#d_ord); } 1;