#! perl -slw use strict; sub mapNM (&@) { my $code = shift; map{ local( *a, *b ) = \( @_[ 0, 1 ] ); $code->(shift); } 0 .. @_ - 2 } sub strcmp{ my( $p, $b ) = (0) x 2; $p++ until $b = substr( $_[ 0 ], $p, 1 ) cmp substr( $_[ 1 ], $p, 1 ); $p * $b; }; my @names = sort map{ join' ', map{ $_ = ucfirst } split '[^a-z0-9]+', lc } ; print "@$_" for mapNM{ if( $a->[ 0 ] eq $b->[ 0 ] ) { my $n = strcmp $a->[ 1 ], $b->[ 1 ]; if( $n ) { $a->[ 0 ] .= substr( $a->[ 1 ], abs $n, 1 ); $b->[ 0 ] .= substr( $b->[ 1 ], abs $n, 1 ); } } $a; } sort{ $a->[ 0 ] cmp $b->[ 0 ] } map{ [ join('', m[([A-Z])]g), $_ ] } @names; __DATA__ A Robertson A Robinson A A Milne A A Milner [SNIP]