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