1: #!/usr/bin/perl -w
   2: 
   3: =head1 by_number
   4: 
   5: This demonstrates the use of a custom sorting routine "by_number"
   6: which is designed to sort strings with embedded numbers in the same
   7: way that a human might expect, ie taking account of the magnitude of
   8: the number rather than the lexicographical ordering of it.
   9: 
  10: This is especially good for sorting IP addresses - ie
  11: 
  12:          Input         Alpha     by_number
  13:       10.0.0.2      10.0.0.1      10.0.0.1
  14:       10.0.0.1     10.0.0.10      10.0.0.2
  15:      10.10.1.1      10.0.0.2     10.0.0.10
  16:      10.1.10.1     10.0.1.10     10.0.1.10
  17:       10.2.1.2      10.0.2.2      10.0.2.2
  18:       10.0.2.2     10.1.10.1     10.1.10.1
  19:      10.0.1.10     10.10.1.1      10.2.1.2
  20:      10.0.0.10      10.2.1.2     10.10.1.1
  21: 
  22: Try the program for a longer example.
  23: 
  24: =cut
  25: 
  26: use strict;
  27: 
  28: my @list = map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [$_, rand] } qw {
  29:    1 2 3 4 10 11 12 20 21 22 100 1000 a00 a10 a29 abc1 abc1a abc11b
  30:    abc111a2 abc1b12 10.0.0.1 10.0.0.2 10.0.0.10 10.0.1.10 10.0.2.2
  31:    10.1.10.1 10.2.1.2 10.10.1.1
  32: };
  33: 
  34: my $result = [
  35:   [ "Input", @list ],
  36:   [ "Alpha", sort @list ],
  37:   [ "by_number", sort by_number @list ],
  38: ];
  39: 
  40: for my $i (0..$#{$result->[0]})
  41: {
  42:     for my $j (0..$#$result)
  43:     {
  44:         printf "%14s", $result->[$j][$i];
  45:     }
  46:     print "\n";
  47: }
  48: 
  49: # Embedded numeric sorter sorts IP addresses & xyz123
  50: 
  51: sub by_number
  52: {
  53:     my @a = split /(\d+)/, $a;
  54:     my @b = split /(\d+)/, $b;
  55:     while (@a && @b)
  56:     {
  57:         my ($aa, $bb) = (shift(@a), shift(@b));
  58:         my $res = ($aa =~ /^\d/ && $bb =~ /^\d/) ?
  59:             $aa <=> $bb :
  60:             $aa cmp $bb ;
  61:         return $res if $res;
  62:     }
  63:     return @a <=> @b;
  64: }
  65: 
  66: =head2 PS
  67: 
  68: I originally wrote the above split()s as
  69: 
  70:    my @a = split /(?<!\d)(?=\d)|(?<=\d)(?!\d)/, $a;
  71: 
  72: Which is is much more exciting being a replacement for \b but for
  73: non-number/number boundaries.  It is the only time I've ever used
  74: all 4 assertions in 1 regexp.  However putting brackets in the split
  75: is much easier!
  76: 
  77: =head2 PPS
  78: 
  79: There are of course lots of modules on CPAN which do this sort of
  80: thing - very similar is Sort::Naturally or Sort::Versions or for the
  81: mother of all sorts Sort::ArbBiLex.  In production you might like to
  82: use one of those - this is merely provided for your entertainment ;-)
  83: 
  84: =cut