Porting/sort_perldiag.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 no locale;
   6
   7 my %items;
   8 my $item_key;
   9
  10 $/ = '';
  11
  12 while (<>) {
  13   if (/^=item\s+(.+)/) {
  14     # new item
  15
  16     $item_key = get_item_key($1);
  17     $items{$item_key} .= $_;
  18
  19   } elsif (/^=back\b/) {
  20     # no more items in this group
  21
  22     foreach my $item_key (sort keys %items) {
  23       print $items{$item_key};
  24     }
  25
  26     $item_key = undef;
  27     %items = ();
  28
  29     print;
  30
  31   } elsif (defined $item_key) {
  32     # part of the current item
  33
  34     $items{$item_key} .= $_;
  35
  36   } else {
  37     # not part of an item
  38
  39     print;
  40
  41   }
  42 }
  43
  44 if (keys %items) {
  45   warn "Missing =back after final =item.\n";
  46
  47   foreach my $item_key (sort keys %items) {
  48     print $items{$item_key};
  49   }
  50 }
  51
  52
  53 # get the sortable key for an item
  54 sub get_item_key {
  55   my($item) = @_;
  56
  57   # remove POD formatting
  58   $item =~ s/[A-Z]<(.*?)>/$1/g;
  59
  60   # remove printf-style escapes
  61   # note: be careful not to remove things like %hash
  62   $item =~ s/%(?:[scg]|lx|#o)//g;
  63
  64   # remove all non-letter characters
  65   $item =~ tr/A-Za-z//cd;
  66
  67   return lc $item;
  68
  69 }
  70
  71 __END__
  72
  73 =pod
  74
  75 =head1 NAME
  76
  77 sort_perldiag.pl - Sort warning and error messages in perldiag.pod
  78
  79 =head1 SYNOPSIS
  80
  81 B<sort_perldiag.pl> I<file>
  82
  83 =head1 DESCRIPTION
  84
  85 B<sort_perldiag.pl> is a script for sorting the warning and error
  86 messages in F<perldiag.pod>.  POD formatting, printf-style escapes,
  87 non-letter characters, and case are ignored, as explained in L<perldiag>.
  88
  89 =cut
  90