From: brian d foy <bdfoy@cpan.org>
Date: Thu, 19 Nov 2009 23:56:12 +0000 (-0600)
Subject: * Fixed sort example using =(\d+)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e1d16ab77edac901d7fbfed3aa4b801de9f3325e;p=p5sagit%2Fp5-mst-13.2.git

* Fixed sort example using =(\d+)

The example wanted to sort a list like qw(=1 =2 =a =3 =d). One
example tried to be clever with array indices and precomputed
an array in @nums. However, it forgot to leave holes for the
elements where it could not extract a run of digits. Once the
indices were misaligned, the sort didn't give the right answer.

I know you can read the patch, but since I fixed whitespace too,
a simple diff gives you a lot of output. The old example had:

    for (@old) {
        push @nums, /=(\d+)/;
        push @caps, uc($_);
    }

The new one keeps the indices aligned by using undef when the
match failed:

    for (@old) {
        push @nums, ( /=(\d+)/ ? $1 : undef );
        push @caps, uc($_);
    }

This issue was reported on Stackoverflow:

	http://stackoverflow.com/questions/1754441
---

diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index bacf296..54684b5 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -5329,87 +5329,87 @@ Examples:
 
     # sort lexically
     @articles = sort @files;
-
+    
     # same thing, but with explicit sort routine
     @articles = sort {$a cmp $b} @files;
-
+    
     # now case-insensitively
     @articles = sort {uc($a) cmp uc($b)} @files;
-
+    
     # same thing in reversed order
     @articles = sort {$b cmp $a} @files;
-
+    
     # sort numerically ascending
     @articles = sort {$a <=> $b} @files;
-
+    
     # sort numerically descending
     @articles = sort {$b <=> $a} @files;
-
+    
     # this sorts the %age hash by value instead of key
     # using an in-line function
     @eldest = sort { $age{$b} <=> $age{$a} } keys %age;
-
+    
     # sort using explicit subroutine name
     sub byage {
-	$age{$a} <=> $age{$b};	# presuming numeric
+    $age{$a} <=> $age{$b};	# presuming numeric
     }
     @sortedclass = sort byage @class;
-
+    
     sub backwards { $b cmp $a }
     @harry  = qw(dog cat x Cain Abel);
     @george = qw(gone chased yz Punished Axed);
     print sort @harry;
-	    # prints AbelCaincatdogx
+        # prints AbelCaincatdogx
     print sort backwards @harry;
-	    # prints xdogcatCainAbel
+        # prints xdogcatCainAbel
     print sort @george, 'to', @harry;
-	    # prints AbelAxedCainPunishedcatchaseddoggonetoxyz
+        # prints AbelAxedCainPunishedcatchaseddoggonetoxyz
 
     # inefficiently sort by descending numeric compare using
     # the first integer after the first = sign, or the
     # whole record case-insensitively otherwise
 
-    @new = sort {
-	($b =~ /=(\d+)/)[0] <=> ($a =~ /=(\d+)/)[0]
-			    ||
-	            uc($a)  cmp  uc($b)
+    my @new = sort {
+        ($b =~ /=(\d+)/)[0] <=> ($a =~ /=(\d+)/)[0]
+            ||
+        uc($a)  cmp  uc($b)
     } @old;
 
     # same thing, but much more efficiently;
     # we'll build auxiliary indices instead
     # for speed
-    @nums = @caps = ();
+    my @nums = @caps = ();
     for (@old) {
-	push @nums, /=(\d+)/;
-	push @caps, uc($_);
+        push @nums, ( /=(\d+)/ ? $1 : undef );
+        push @caps, uc($_);
     }
 
-    @new = @old[ sort {
-			$nums[$b] <=> $nums[$a]
-				 ||
-			$caps[$a] cmp $caps[$b]
-		       } 0..$#old
-	       ];
+    my @new = @old[ sort {
+        $nums[$b] <=> $nums[$a]
+            ||
+        $caps[$a] cmp $caps[$b]
+        } 0..$#old
+    ];
 
     # same thing, but without any temps
     @new = map { $_->[0] }
            sort { $b->[1] <=> $a->[1]
-                           ||
-                  $a->[2] cmp $b->[2]
-           } map { [$_, /=(\d+)/, uc($_)] } @old;
+               ||
+           $a->[2] cmp $b->[2]
+    } map { [$_, /=(\d+)/, uc($_)] } @old;
 
     # using a prototype allows you to use any comparison subroutine
     # as a sort subroutine (including other package's subroutines)
     package other;
     sub backwards ($$) { $_[1] cmp $_[0]; }	# $a and $b are not set here
-
+    
     package main;
     @new = sort other::backwards @old;
-
+    
     # guarantee stability, regardless of algorithm
     use sort 'stable';
     @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
-
+    
     # force use of mergesort (not portable outside Perl 5.8)
     use sort '_mergesort';  # note discouraging _
     @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;