http://www.perlmonks.org?node_id=442237

gam3 has asked for the wisdom of the Perl Monks concerning the following question:

I would like a sort that sorts items in a more reasonable way. That is a1a should come before a10a and the releases of Linux should be in release order. release 2.6.10 should not come before 2.6.9. Also 1.55 should come before 1.6. I have a very ugly solution for this problem, but would like some better ones. I am so sure that my opinion of what is reasonable is not as reasonable as it could be.
#!/usr/bin/perl use strict; our @out; our @data; while (<DATA>) { chomp; push @data, $_ if ($_); } our $srtre = qr/^(?:(\d+(?:\.\d+)*)?|\d*)(\D*)(.*)$/; @out = sort { my $x = $a; my $y = $b; my $ret = 0; while (!($x eq $y)) { my ($xx, $yy); my ($l, $m, $xx, $yy); ($l, $xx, $x) = ($x =~ $srtre); ($m, $yy, $y) = ($y =~ $srtre); if ($l eq $m) { # the common case if ($ret = $xx cmp $yy) { last; } } else { if (length($l) && length($m)) { if ($l =~ /\d+\.\d+\.d+/ || $m =~ /\d+\.\d+\.\d+/) { my @ll = split(/\./, $l); my @lm = split(/\./, $m); if ($#ll == $#lm) { for (my $x = 0; $x <= $#ll; $x++) { if ($ret = ($ll[$x] <=> $lm[$x])) { last; } } } elsif ($#ll < $#lm) { for (my $x = 0; $x <= $#ll; $x++) { if ($ret = ($ll[$x] <=> $lm[$x])) { last; } } $ret = -1 unless ($ret); } else { for (my $x = 0; $x <= $#lm; $x++) { if ($ret = ($ll[$x] <=> $lm[$x])) { last; } } $ret = 1 unless ($ret); } last if $ret; } elsif ($l == $m) { # handle leading zeros. # don't want (00 0 000) if ($xx . $x eq $yy . $y) { if ($ret = ($l cmp $m)) { last; } } if ($ret = ($xx cmp $yy)) { last; } } elsif ($ret = ($l <=> $m)) { last; } } else { if ($ret = ($l.$xx cmp $m.$yy)) { last; } } } } return $ret; } @data; print join(', ', @out), "\n"; __END__ a1.5 a1.5b a1.55 a1.55b a1.6 a1.6b linux-2.4.3.tar linux-2.4.28.tar linux-2.4.29.tar linux-2.4.29a.tar linux-2.10.6.tar linux-2.10.50.tar
The DATA section is in 'my' prefered sorted order.
-- gam3
A picture is worth a thousand words, but takes 200K.