share/backref.pl

   1 #!/usr/bin/env perl
   2 #
   3 #  Cross-reference RFC attributes.
   4 #
   5 #  $Id$
   6 #
   7
   8 $begin_vendor = 0;
   9 $blank = 0;
  10
  11 while (@ARGV) {
  12     $filename = shift;
  13
  14     open FILE, "<$filename" or die "Failed to open $filename: $!\n";
  15
  16     @output = ();
  17
  18     while (<FILE>) {
  19         #
  20         #  Clear out trailing whitespace
  21         #
  22         s/[ \t]+$//;
  23
  24         #
  25         #  And CR's
  26         #
  27         s/\r//g;
  28
  29         #
  30         #  Suppress multiple blank lines
  31         #
  32         if (/^\s+$/) {
  33             next if ($blank == 1);
  34             $blank = 1;
  35             next;
  36         }
  37         $blank = 0;
  38
  39         #
  40         #  Remember the vendor
  41         #
  42         if (/^VENDOR\s+([\w-]+)\s+(\w+)(.*)/) {
  43             $name=$1;
  44             $len = length $name;
  45             if ($len < 32) {
  46                 $lenx = 32 - $len;
  47                 $lenx += 7;             # round up
  48                 $lenx /= 8;
  49                 $lenx = int $lenx;
  50                 $tabs = "\t" x $lenx;
  51             } else {
  52                 $tabs = " ";
  53             }
  54             $vendor = $name;
  55             next;
  56         }
  57
  58         #
  59         #  Remember if we did begin-vendor.
  60         #
  61         if (/^BEGIN-VENDOR\s+([\w-]+)/) {
  62             $begin_vendor = 1;
  63             if (!defined $vendor) {
  64                 $vendor = $1;
  65             } elsif ($vendor ne $1) {
  66                 # do something smart
  67             }
  68
  69             next;
  70         }
  71
  72         #
  73         #  Get attribute.
  74         #
  75         if (/^ATTRIBUTE\s+([\w-]+)\s+(\w+)\s+(\w+)(.*)/) {
  76             $name=$1;
  77             $len = length $name;
  78             if ($len < 40) {
  79                 $lenx = 40 - $len;
  80                 $lenx += 7;             # round up
  81                 $lenx /= 8;
  82                 $lenx = int $lenx;
  83                 $tabs = "\t" x $lenx;
  84                 if ($tabs eq "") {
  85                     $tabs = " ";
  86                 }
  87             } else {
  88                 $tabs = " ";
  89             }
  90
  91             $value = $2;
  92             $type = $3;
  93             $stuff = $4;
  94
  95             if ($begin_vendor == 0) {
  96                 #
  97                 #  FIXME: Catch and print conflicting attributes.
  98                 #
  99                 $file{$value} = $filename;
 100                 $file{$value} =~ s/dictionary\.//;
 101                 $name{$value} = $name . $tabs;
 102             }
 103
 104             #
 105             #  See if it's old format, with the vendor at the end of
 106             #  the line.  If so, make it the new format.
 107             #
 108             if ($stuff =~ /$vendor/) {
 109                 if ($begin_vendor == 0) {
 110                     $begin_vendor = 1;
 111                 }
 112                 $stuff =~ s/$vendor//;
 113                 $stuff =~ s/\s+$//;
 114             }
 115
 116             next;
 117         }
 118
 119         #
 120         #  Values.
 121         #
 122         if (/^VALUE\s+([\w-]+)\s+([\w-\/,.]+)\s+(\w+)(.*)/) {
 123             $attr=$1;
 124             $len = length $attr;
 125             if ($len < 32) {
 126                 $lenx = 32 - $len;
 127                 $lenx += 7;             # round up
 128                 $lenx /= 8;
 129                 $lenx = int $lenx;
 130                 $tabsa = "\t" x $lenx;
 131                 if ($tabsa eq "") {
 132                     $tabsa = " ";
 133                     $len += 1;
 134                 } else {
 135                     $len -= $len % 8;
 136                     $len += 8 * length $tabsa;
 137                 }
 138             } else {
 139                 $tabsa = " ";
 140                 $len += 1;
 141             }
 142
 143             #
 144             #  For the code below, we assume that the attribute lengths
 145             #
 146             if ($len < 32) {
 147                 $lena = 0;
 148             } else {
 149                 $lena = $len - 32;
 150             }
 151
 152             $name = $2;
 153             $len = length $name;
 154             if ($len < 24) {
 155                 $lenx = 24 - $lena - $len;
 156                 $lenx += 7;             # round up
 157                 $lenx /= 8;
 158                 $lenx = int $lenx;
 159                 $tabsn = "\t" x $lenx;
 160                 if ($tabsn eq "") {
 161                     $tabsn = " ";
 162                 }
 163             } else {
 164                 $tabsn = " ";
 165             }
 166
 167             next;
 168         }
 169
 170         #
 171         #  Remember if we did this.
 172         #
 173         if (/^END-VENDOR/) {
 174             $begin_vendor = 0;
 175         }
 176
 177         #
 178         #  Everything else gets dumped out as-is.
 179         #
 180     }
 181
 182     close FILE;
 183
 184 }
 185
 186 #
 187 #  Print out the attributes.
 188 #
 189 foreach $attr (sort {$a <=> $b} keys %file) {
 190     print $name{$attr}, $attr, "\t", $file{$attr}, "\n";
 191 }
 192