use strict; use warnings; my @list = qw( R1-U10 R1-U1 R10-U11 R10-U1 R2-U2 R3-U13 R10-U5 R2 ); @list = sort special_compare @list; print "$_\n" for @list; sub special_compare { my (@myA) = $a =~ /([a-zA-z_]+|\d+)/g; my (@myB) = $b =~ /([a-zA-z_]+|\d+)/g; my $result=0; my $Atoken; my $Btoken; while ( defined ($Atoken = shift @myA) and defined ($Btoken = shift @myB) and $result == 0) { my $numeric = 0; $numeric = 1 if ($Atoken =~ /\d/ and $Btoken =~ /\d/); if ($numeric) { $result = ($Atoken <=> $Btoken); } else { $result = ($Atoken cmp $Btoken); } } if ($result ==0) #if one array "runs out", longest is "greater" { return -1 if (@myA < @myB); return 1 if (@myA > @myB); } return $result; } __END__ R1-U1 R1-U10 R2 R2-U2 R3-U13 R10-U1 R10-U5 R10-U11