Sort a bunch of outputs in dictionary order

Makes them easier to read

(cherry picked from commit 2d3877590e755fab8a115cd49bb99953dee5d516)
Signed-off-by: Nicolas R <atoomic@cpan.org>

diff --git a/dist/Devel-PPPort/PPPort_pm.PL b/dist/Devel-PPPort/PPPort_pm.PL
index d8ec65f..3ae7e8b 100644 (file)
--- a/dist/Devel-PPPort/PPPort_pm.PL
+++ b/dist/Devel-PPPort/PPPort_pm.PL
@@ -20,6 +20,7 @@
 use strict;
 BEGIN { $^W = 1; }
 require "./parts/ppptools.pl";
+require "./parts/inc/inctools";
 
 my $INCLUDE = 'parts/inc';
 my $DPPP = 'DPPP_';
@@ -37,7 +38,7 @@ $data =~ s{^\%(include)\s+(\w+)((?:[^\S\r\n]+.*?)?)\s*$}
 
 $data = expand($data);
 
-my @api = sort { lc $a cmp lc $b or $a cmp $b } keys %provides;
+my @api = sort dictionary_order keys %provides;
 
 $data =~ s{^(.*)__PROVIDED_API__(\s*?)^}
           {join '', map "$1$_\n", @api}gem;
@@ -54,7 +55,7 @@ $data =~ s!^(.*)__EXPLICIT_API__(\s*?)^!
            sprintf("$1$format\n", 'Function / Variable', 'Static Request', 'Global Request') .
            $1 . '-'x$len . "\n" .
            join('', map { sprintf "$1$format\n", $explicit{$_} eq 'var' ? $_ : "$_()", "NEED_$_", "NEED_${_}_GLOBAL" }
-                    sort keys %explicit)
+                    sort dictionary_order keys %explicit)
           !gem;
 }
 
@@ -89,6 +90,7 @@ for (keys %provides) {
 }
 
 push @perl_api, keys %embed;
+@perl_api = sort dictionary_order @perl_api;
 
 for (@perl_api) {
   if (exists $provides{$_} && !exists $raw_base{$_}) {
@@ -109,7 +111,7 @@ for (@perl_api) {
 }
 
 $data =~ s/^([\t ]*)__PERL_API__(\s*?)$/
-           join "\n", map "$1$_", sort @perl_api
+           join "\n", map "$1$_", sort dictionary_order @perl_api
           /gem;
 
 my $undocumented = "(undocumented)";
@@ -118,7 +120,7 @@ my @todo;
 for (reverse sort keys %todo) {
   my $ver = format_version($_);
   my $todo = "=item perl $ver\n\n";
-  for (sort @{$todo{$_}}) {
+  for (sort dictionary_order @{$todo{$_}}) {
     $todo .= "  $_";
     $todo .= "  (DEPRECATED)" if  $embed{$_}->{flags}{D};
     $todo .= "  (marked experimental)" if $embed{$_}->{flags}{x};
@@ -641,6 +643,8 @@ SKIP
 
 %include ppphdoc { indent => '|>' }
 
+%include inctools
+
 %include ppphbin
 
 __DATA__

diff --git a/dist/Devel-PPPort/devel/mktodo.pl b/dist/Devel-PPPort/devel/mktodo.pl
index c479eab..6d87ffd 100644 (file)
--- a/dist/Devel-PPPort/devel/mktodo.pl
+++ b/dist/Devel-PPPort/devel/mktodo.pl
@@ -276,7 +276,8 @@ sub write_todo
   $f = new IO::File ">$file" or die "cannot open $file: $!\n";
   $f->print("$ver\n");
 
-  for (sort keys %$sym) {
+  # Dictionary ordering, with only alphanumerics
+  for (sort dictionary_order keys %$sym) {
     $f->print(sprintf "%-30s # %s\n", $_, $sym->{$_});
   }
 }
@@ -337,7 +338,7 @@ sub get_apicheck_symbol_map
               @{$r->{stderr}};
 
     if (keys %sym) {
-      for my $s (sort keys %sym) {
+      for my $s (sort dictionary_order keys %sym) {
         sym('new', $s, $sym{$s});
         $all{$s} = $sym{$s};
       }

diff --git a/dist/Devel-PPPort/devel/scanprov b/dist/Devel-PPPort/devel/scanprov
index 804524c..6a16700 100755 (executable)
--- a/dist/Devel-PPPort/devel/scanprov
+++ b/dist/Devel-PPPort/devel/scanprov
@@ -18,6 +18,7 @@ use strict;
 use Getopt::Long;
 
 require './parts/ppptools.pl';
+require './parts/inc/inctools';
 
 our %opt = (
   mode    => 'check',
@@ -62,7 +63,7 @@ my $out = 'parts/base';
 my $todo = parse_todo($out);
 
 for my $v (keys %v) {
-  my @new = sort grep { !exists $todo->{$_} } keys %{$v{$v}};
+  my @new = sort dictionary_order grep { !exists $todo->{$_} } keys %{$v{$v}};
   @new or next;
   my $file = $v;
   $file =~ s/\.//g;

diff --git a/dist/Devel-PPPort/parts/inc/inctools b/dist/Devel-PPPort/parts/inc/inctools
index df75aae..51e368a 100644 (file)
--- a/dist/Devel-PPPort/parts/inc/inctools
+++ b/dist/Devel-PPPort/parts/inc/inctools
@@ -55,4 +55,32 @@ sub parse_version
   return ($r, $v, $s);
 }
 
+sub dictionary_order($$)    # Sort caselessly, ignoring punct
+{
+    my ($lc_a, $lc_b);
+    my ($squeezed_a, $squeezed_b);
+    my ($valid_a, $valid_b);    # Meaning valid for all releases
+
+    # On early perls, the implicit pass by reference doesn't work, so we have
+    # to use the globals to initialize.
+    if ("$]" < "5.006" ) {
+        $valid_a = $a; $valid_b = $b;
+    }
+    else {
+        ($valid_a, $valid_b) = @_;
+    }
+
+    $lc_a = lc $valid_a;
+    $lc_b = lc $valid_b;
+
+    $squeezed_a = $lc_a;
+    $squeezed_a =~ s/[\W_]//g;   # No punct, including no underscore
+    $squeezed_b = $lc_b;
+    $squeezed_b =~ s/[\W_]//g;
+
+    return( $squeezed_a cmp $squeezed_b
+         or       $lc_a cmp $lc_b
+         or    $valid_a cmp $valid_b);
+}
+
 1;

diff --git a/dist/Devel-PPPort/parts/inc/ppphbin b/dist/Devel-PPPort/parts/inc/ppphbin
index 1cf0236..bbf7b6f 100644 (file)
--- a/dist/Devel-PPPort/parts/inc/ppphbin
+++ b/dist/Devel-PPPort/parts/inc/ppphbin
@@ -90,7 +90,7 @@ __PERL_API__
 
 if (exists $opt{'list-unsupported'}) {
   my $f;
-  for $f (sort { lc $a cmp lc $b } keys %API) {
+  for $f (sort dictionary_order keys %API) {
     next unless $API{$f}{todo};
     print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
   }
@@ -176,14 +176,14 @@ while (<DATA>) {
 
 for (values %depends) {
   my %s;
-  $_ = [sort grep !$s{$_}++, @$_];
+  $_ = [sort dictionary_order grep !$s{$_}++, @$_];
 }
 
 if (exists $opt{'api-info'}) {
   my $f;
   my $count = 0;
   my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
-  for $f (sort { lc $a cmp lc $b } keys %API) {
+  for $f (sort dictionary_order keys %API) {
     next unless $f =~ /$match/;
     print "\n=== $f ===\n\n";
     my $info = 0;
@@ -211,7 +211,7 @@ if (exists $opt{'api-info'}) {
 
 if (exists $opt{'list-provided'}) {
   my $f;
-  for $f (sort { lc $a cmp lc $b } keys %API) {
+  for $f (sort dictionary_order keys %API) {
     next unless $API{$f}{provided};
     my @flags;
     push @flags, 'explicit' if exists $need{$f};
@@ -382,7 +382,7 @@ for $filename (@files) {
   my $c = $file{code};
   my $warnings = 0;
 
-  for $func (sort keys %{$file{uses_Perl}}) {
+  for $func (sort dictionary_order keys %{$file{uses_Perl}}) {
     if ($API{$func}{varargs}) {
       unless ($API{$func}{nothxarg}) {
         my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
@@ -400,12 +400,12 @@ for $filename (@files) {
     }
   }
 
-  for $func (sort keys %{$file{uses_replace}}) {
+  for $func (sort dictionary_order keys %{$file{uses_replace}}) {
     warning("Uses $func instead of $replace{$func}");
     $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
   }
 
-  for $func (sort keys %{$file{uses_provided}}) {
+  for $func (sort dictionary_order keys %{$file{uses_provided}}) {
     if ($file{uses}{$func}) {
       if (exists $file{uses_deps}{$func}) {
         diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
@@ -418,14 +418,14 @@ for $filename (@files) {
   }
 
   unless ($opt{quiet}) {
-    for $func (sort keys %{$file{uses_todo}}) {
+    for $func (sort dictionary_order keys %{$file{uses_todo}}) {
       print "*** WARNING: Uses $func, which may not be portable below perl ",
             format_version($API{$func}{todo}), ", even with '$ppport'\n";
       $warnings++;
     }
   }
 
-  for $func (sort keys %{$file{needed_static}}) {
+  for $func (sort dictionary_order keys %{$file{needed_static}}) {
     my $message = '';
     if (not exists $file{uses}{$func}) {
       $message = "No need to define NEED_$func if $func is never used";
@@ -439,7 +439,7 @@ for $filename (@files) {
     }
   }
 
-  for $func (sort keys %{$file{needed_global}}) {
+  for $func (sort dictionary_order keys %{$file{needed_global}}) {
     my $message = '';
     if (not exists $global{uses}{$func}) {
       $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
@@ -463,7 +463,7 @@ for $filename (@files) {
   if ($file{needs_inc_ppport}) {
     my $pp = '';
 
-    for $func (sort keys %{$file{needs}}) {
+    for $func (sort dictionary_order keys %{$file{needs}}) {
       my $type = $file{needs}{$func};
       next if $type eq 'extern';
       my $suffix = $type eq 'global' ? '_GLOBAL' : '';