release/doc/share/misc/man2hwnotes.pl

   1 #!/usr/bin/perl -w
   2 # Emacs should use -*- cperl -*- mode
   3 #
   4 # Copyright (c) 2003-2006 Simon L. Nielsen <simon@FreeBSD.org>
   5 # All rights reserved.
   6 #
   7 # Redistribution and use in source and binary forms, with or without
   8 # modification, are permitted provided that the following conditions
   9 # are met:
  10 # 1. Redistributions of source code must retain the above copyright
  11 #    notice, this list of conditions and the following disclaimer.
  12 # 2. Redistributions in binary form must reproduce the above copyright
  13 #    notice, this list of conditions and the following disclaimer in the
  14 #    documentation and/or other materials provided with the distribution.
  15 #
  16 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
  17 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  18 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  19 # ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
  20 # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  21 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  22 # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  23 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  24 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  25 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  26 # SUCH DAMAGE.
  27 #
  28 # $FreeBSD$
  29 #
  30
  31 # Parse the list of supported hardware out of section 4 manual pages
  32 # and output it on stdout as SGML/DocBook entities.
  33
  34 # The script will look for the following line in the manual page:
  35 # .Sh HARDWARE
  36 # and make an entity of the content until the line containing:
  37 # .Sh
  38 #
  39 # For Lists only the first line will be printed.  If there are
  40 # arguments to the .It command, only the argument will be printed.
  41
  42 # Usage:
  43 # man2hwnotes.pl [-cl] [-d 0-6] [-a <archlist file>] [-o <outputfile>]
  44 #                <manualpage> [<manualpage> ...]
  45
  46 use strict;
  47 use Getopt::Std;
  48 use Digest::MD5 qw(md5_hex);
  49
  50 # Section from manual page to extract
  51 my $hwlist_sect = "HARDWARE";
  52
  53 # Override default archtecture list for some devices:
  54 my $archlist_file = "dev.archlist.txt";
  55 my %archlist;
  56
  57 # Globals
  58 my $compat_mode = 0; # Enable compat for old Hardware Notes style
  59 my $debuglevel = 0;
  60 my $only_list_out = 0; # Should only lists be generated in the output?
  61 my @out_lines; # Single lines
  62 my @out_dev;   # Device entities
  63
  64 # Getopt
  65 my %options = ();
  66 if (!getopts("a:cd:lo:",\%options)) {
  67     die("$!: Invalid command line arguments in ", __LINE__, "\n");
  68 }
  69
  70 if (defined($options{c})) {
  71     $compat_mode = 1;
  72 }
  73 if (defined($options{d})) {
  74     $debuglevel = $options{d};
  75 }
  76 if (defined($options{a})) {
  77     $archlist_file = $options{a};
  78 }
  79 if (defined($options{l})) {
  80     $only_list_out = 1;
  81 }
  82
  83 my $outputfile = $options{o};
  84
  85 if ($debuglevel > 0) {
  86     # Don't do output buffering in debug mode.
  87     $| = 1;
  88 }
  89
  90 load_archlist($archlist_file);
  91
  92 if (defined($outputfile)) {
  93     open(OLDOUT, ">&STDOUT") || die("$!: Could not open STDOUT in ", __LINE__, ".\n");
  94     open(STDOUT, ">$outputfile") || die("$!: Could not open $outputfile in ", __LINE__, ".\n");
  95 }
  96
  97 print <<EOT;
  98 <!--
  99  These are automatically generated device lists for FreeBSD hardware notes.
 100 -->
 101 EOT
 102
 103 if ($only_list_out) {
 104     # Print the default device preamble entities
 105     print "<!ENTITY hwlist.preamble.pre 'The'>\n";
 106     print "<!ENTITY hwlist.preamble.post 'driver supports:'>\n";
 107 }
 108
 109 foreach my $page (@ARGV) {
 110     if ($page !~ m/\.4$/) {
 111         dlog(2, "Skipped $page (not *.4)");
 112         next;
 113     }
 114     dlog(2, "Parsing $page");
 115     parse($page);
 116
 117     if (@out_lines) {
 118         print join("\n", @out_lines), "\n";
 119     }
 120     if (@out_dev) {
 121         print join("\n", @out_dev), "\n";
 122     }
 123
 124     @out_lines = ();
 125     @out_dev = ();
 126 }
 127
 128 if (defined($outputfile)) {
 129     open(STDOUT, ">&OLDOUT") || die("$!: Could not open STDOUT in ", __LINE__, ".\n");
 130     close(OLDOUT) || die("$!: Could not close OLDOUT in ", __LINE__, ".\n");
 131 }
 132
 133 sub normalize (@) {
 134     my @lines = @_;
 135
 136     foreach my $l (@lines) {
 137         $l =~ s/\\&//g;
 138         $l =~ s:([\x21-\x2f\x5b-\x60\x7b-\x7f]):sprintf("&\#\%d;", ord($1)):eg;
 139         # Make sure ampersand is encoded as &amp; since jade seems to
 140         # be confused when it is encoded as &#38; inside an entity.
 141         $l =~ s/&#38;/&amp;/g;
 142     }
 143     return (wantarray) ? @lines : join "", @lines;
 144 }
 145
 146 sub parse {
 147     my ($manpage) = @_;
 148
 149     my $cur_mansection;
 150     my $found_hwlist = 0;
 151     my %mdocvars;
 152     $mdocvars{isin_hwlist} = 0;
 153     $mdocvars{isin_list} = 0;
 154     $mdocvars{first_para} = 1;
 155     $mdocvars{parabuf} = "";
 156     $mdocvars{listtype} = "";
 157     $mdocvars{it_nr} = 0;
 158
 159     open(MANPAGE, "$manpage") || die("$!: Could not open $manpage in ", __LINE__, ".\n");
 160     while(<MANPAGE>) {
 161         chomp;
 162         my $line = $_;
 163
 164         dlog(5, "Read '$line'");
 165
 166         # Find commands
 167         if (s/^\.(.*)$/$1/) {
 168             my $cmd = $1;
 169
 170             # Detect, and ignore, comment lines
 171             if (s/^\\"(.*)$/$1/) {
 172                 next;
 173             }
 174
 175             $cmd =~ s/^([^ ]+).*$/$1/;
 176
 177             if (/^Nm "?(\w+)"?/ && !defined($mdocvars{Nm})) {
 178                 dlog(3, "Setting Nm to $1");
 179                 $mdocvars{Nm} = $1;
 180                 # "_" cannot be used for an entity name.
 181                 $mdocvars{EntNm} = $1;
 182                 $mdocvars{EntNm} =~ s,_,.,g;
 183
 184             } elsif (/^Nm$/) {
 185                 if (defined($mdocvars{Nm}) && $mdocvars{Nm} ne "") {
 186                     parabuf_addline(\%mdocvars, "&man.".$mdocvars{EntNm}.".$cur_mansection;");
 187                 } else {
 188                     dlog(2, "Warning: Bad Nm call in $manpage");
 189                 }
 190
 191             } elsif (/^Sh (.+)$/) {
 192                 dlog(4, "Setting section to $1");
 193                 my $cur_section = $1;
 194
 195                 flush_out(\%mdocvars);
 196
 197                 if ($cur_section =~ /^${hwlist_sect}$/) {
 198                     dlog(2, "Found the device section ${hwlist_sect}");
 199                     $mdocvars{isin_hwlist} = 1;
 200                     $found_hwlist = 1;
 201                     add_sgmltag(\%mdocvars, "<!ENTITY hwlist.".$mdocvars{cur_manname}." '");
 202                     if ($only_list_out) {
 203                         add_sgmltag("<para>&hwlist.preamble.pre; " .
 204                                     "&man.".$mdocvars{EntNm}.".$cur_mansection; " .
 205                                     "&hwlist.preamble.post;</para>");
 206                     }
 207                 } elsif ($mdocvars{isin_hwlist}) {
 208                     dlog(2, "Found a HWLIST STOP key!");
 209                     add_sgmltag(\%mdocvars, "'>");
 210                     $mdocvars{isin_hwlist} = 0;
 211                 }
 212                 if ($mdocvars{isin_list}) {
 213                     dlog(1, "Warning: Still in list, but just entered new " .
 214                          "section.  This is probably due to missing .El; " .
 215                          "check manual page for errors.");
 216                     # If we try to recover from this we will probably
 217                     # just end with bad SGML output and it really
 218                     # should be fixed in the manual page so we don't
 219                     # even try to "fix" this.
 220                 }
 221
 222
 223             } elsif (/^Dt ([^ ]+) ([^ ]+)/) {
 224                 dlog(4, "Setting mansection to $2");
 225                 $mdocvars{cur_manname} = lc($1);
 226                 $cur_mansection = $2;
 227
 228                 # "_" cannot be used for an entity name.
 229                 $mdocvars{cur_manname} =~ s,_,.,g;
 230
 231             } elsif (/^It ?(.*)$/) {
 232                 my $txt = $1;
 233
 234                 $mdocvars{it_nr}++;
 235
 236                 # Flush last item
 237                 if ($mdocvars{parabuf} ne "") {
 238                     add_listitem(\%mdocvars);
 239                 }
 240
 241                 # Remove quotes, if any.
 242                 $txt =~ s/"(.*)"/$1/;
 243
 244                 if ($mdocvars{listtype} eq "column") {
 245                     # Ignore first item when it is likely to be a
 246                     # header.
 247                     if ($mdocvars{it_nr} == 1 && $txt =~ m/^(Em|Sy) /) {
 248                         dlog(2, "Skipping header line in column list");
 249                         next;
 250                     }
 251                     # Only extract the first column.
 252                     $txt =~ s/ Ta /\t/g;
 253                     $txt =~ s/([^\t]+)\t.*/$1/;
 254                 }
 255                 parabuf_addline(\%mdocvars, normalize($txt));
 256             } elsif (/^Bl/) {
 257                 $mdocvars{isin_list} = 1;
 258                 flush_out(\%mdocvars);
 259                 add_sgmltag(\%mdocvars, "<itemizedlist>");
 260
 261                 if (/-tag/) {
 262                     $mdocvars{listtype} = "tag";
 263                     # YACK! Hack for ata(4)
 264                     if ($mdocvars{Nm} eq "ata") {
 265                         $mdocvars{listtype} = "tagHACK";
 266                     }
 267                 } elsif (/-bullet/) {
 268                     $mdocvars{listtype} = "bullet";
 269                 } elsif (/-column/) {
 270                     $mdocvars{listtype} = "column";
 271                 } else {
 272                     $mdocvars{listtype} = "unknown";
 273                 }
 274                 dlog(2, "Listtype set to $mdocvars{listtype}");
 275             } elsif (/^El/) {
 276                 if ($mdocvars{parabuf} ne "") {
 277                     add_listitem(\%mdocvars);
 278                 }
 279
 280                 add_sgmltag(\%mdocvars, "</itemizedlist>");
 281                 $mdocvars{isin_list} = 0;
 282             } elsif (/^Tn (.+)$/) {
 283                 # For now we print TradeName text as regular text.
 284                 my ($txt, $punct_str) = split_punct_chars($1);
 285
 286                 parabuf_addline(\%mdocvars, normalize($txt . $punct_str));
 287             } elsif (/^Xr ([^ ]+) (.+)$/) {
 288                 my ($xr_sect, $punct_str) = split_punct_chars($2);
 289                 my $txt;
 290
 291                 # We need to check if the manual page exist to avoid
 292                 # breaking the doc build just because of a broken
 293                 # reference.
 294                 #$txt = "&man.$1.$xr_sect;$punct_str";
 295                 $txt = "$1($xr_sect)$punct_str";
 296                 parabuf_addline(\%mdocvars, normalize($txt));
 297             } elsif (/^Dq (.+)$/) {
 298                 my ($txt, $punct_str) = split_punct_chars($1);
 299
 300                 parabuf_addline(\%mdocvars,
 301                                 normalize("<quote>$txt</quote>$punct_str"));
 302             } elsif (/^Sx (.+)$/) {
 303                 if ($mdocvars{isin_hwlist}) {
 304                     dlog(1, "Warning: Reference to another section in the " .
 305                          "$hwlist_sect section in " . $mdocvars{Nm} .
 306                          "(${cur_mansection})");
 307                 }
 308                 parabuf_addline(\%mdocvars, normalize($1));
 309             } elsif (/^Pa (.+)$/) {
 310                 my ($txt, $punct_str) = split_punct_chars($1);
 311
 312                 $txt = make_ulink($txt) . $punct_str;
 313                 parabuf_addline(\%mdocvars, normalize($txt));
 314             } elsif (/^Pp/) {
 315                 dlog(3, "Got Pp command - forcing new para");
 316                 flush_out(\%mdocvars);
 317             } elsif (/^Fx (.+)/) {
 318                 dlog(3, "Got Fx command");
 319                 parabuf_addline(\%mdocvars, "FreeBSD $1");
 320             } elsif (/^Fx/) {
 321                 dlog(3, "Got Fx command");
 322                 parabuf_addline(\%mdocvars, "FreeBSD");
 323             } else {
 324                 # Ignore all other commands.
 325                 dlog(3, "Ignoring unknown command $cmd");
 326             }
 327         } else {
 328             # This is then regular text
 329             parabuf_addline(\%mdocvars, normalize($_));
 330         }
 331     }
 332     close(MANPAGE) || die("$!: Could not close $manpage in ", __LINE__, ".\n");
 333     if (! $found_hwlist) {
 334         dlog(2, "Hardware list not found in $manpage");
 335     }
 336 }
 337
 338 sub dlog {
 339     my ($level, $txt) = @_;
 340
 341     if ($level <= $debuglevel) {
 342         print STDERR "$level: $txt\n";
 343     }
 344 }
 345
 346 # Output a SGML tag.
 347 sub add_sgmltag {
 348     my ($mdocvars, $txt) = (@_);
 349
 350     # We only care about the HW list for now.
 351     if (${$mdocvars}{isin_hwlist}) {
 352         push(@out_dev, $txt);
 353     }
 354 }
 355
 356 # Add a text entity, and return the used entity name.
 357 sub add_txt_ent {
 358     my ($itemtxt) = (@_);
 359     my ($entity_name);
 360
 361     # Convert mdoc(7) minus
 362     $itemtxt =~ s/\\-/-/g;
 363
 364     $itemtxt =~ s/'/&lsquo;/g;
 365
 366     $entity_name = "hwlist." . md5_hex($itemtxt);
 367     dlog(4, "Adding '$itemtxt' as entity $entity_name");
 368     push(@out_lines, "<!ENTITY $entity_name '$itemtxt'>");
 369
 370     return ($entity_name);
 371 }
 372 sub flush_out {
 373     my ($mdocvars) = (@_);
 374     my ($entity_name, $out);
 375     my $para_arch = "";
 376
 377     if (!${$mdocvars}{isin_hwlist} || ${$mdocvars}{parabuf} eq "") {
 378         return;
 379     }
 380
 381     $entity_name = add_txt_ent(${$mdocvars}{parabuf});
 382     ${$mdocvars}{parabuf} = "";
 383     if(defined($archlist{${$mdocvars}{Nm}})) {
 384         if ($compat_mode) {
 385             $para_arch = ' arch="' . $archlist{${$mdocvars}{Nm}} . '"';
 386         } else {
 387             $para_arch = '[' . $archlist{${$mdocvars}{Nm}} . '] ';
 388         }
 389     }
 390     if ($compat_mode) {
 391         $out = "<para".$para_arch.">&".$entity_name.";</para>";
 392     } else {
 393         if (${$mdocvars}{first_para}) {
 394             $out = "<para>".$para_arch."&".$entity_name.";</para>";
 395         } else {
 396             $out = "<para>&".$entity_name.";</para>";
 397         }
 398         ${$mdocvars}{first_para} = 0;
 399     }
 400
 401     dlog(4, "Flushing parabuf");
 402     add_sgmltag($mdocvars, $out);
 403 }
 404
 405 # Add a new list item from the "parabuf".
 406 sub add_listitem {
 407     my ($mdocvars) = (@_);
 408     my ($listitem, $entity_name);
 409     my $para_arch = "";
 410
 411     $entity_name = add_txt_ent(${$mdocvars}{parabuf});
 412     ${$mdocvars}{parabuf} = "";
 413
 414     if ($compat_mode) {
 415         if(defined($archlist{${$mdocvars}{Nm}})) {
 416             $para_arch = ' arch="' . $archlist{${$mdocvars}{Nm}} . '"';
 417         }
 418     }
 419     $listitem = "<listitem><para".$para_arch.">&".$entity_name.";</para></listitem>";
 420     dlog(4, "Adding '$listitem' to out_dev");
 421     push(@out_dev, $listitem);
 422
 423 }
 424
 425 # Add a line to the "paragraph buffer"
 426 sub parabuf_addline {
 427     my $mdocvars = shift;
 428     my ($txt) = (@_);
 429
 430     dlog(5, "Now in parabuf_addline for '$txt'");
 431
 432     # We only care about the HW list for now.
 433     if (!${$mdocvars}{isin_hwlist}) {
 434         dlog(6, "Exiting parabuf_addline due to: !\${\$mdocvars}{isin_hwlist}");
 435         return;
 436     }
 437     if ($txt eq "") {
 438         dlog(6, "Exiting parabuf_addline due to: \$txt eq \"\"");
 439         return;
 440     }
 441
 442     if ($only_list_out && !${$mdocvars}{isin_list}) {
 443         dlog(6, "Exiting parabuf_addline due to: ".
 444              "\$only_list_out && !\${\$mdocvars}{isin_list}");
 445         return;
 446     }
 447
 448     # We only add the first line for "tag" lists
 449     if (${$mdocvars}{parabuf} ne "" && ${$mdocvars}{isin_list} &&
 450         ${$mdocvars}{listtype} eq "tag") {
 451         dlog(6, "Exiting parabuf_addline due to: ".
 452              "\${\$mdocvars}{parabuf} ne \"\" && \${\$mdocvars}{isin_list} && ".
 453              "\${\$mdocvars}{listtype} eq \"tag\"");
 454         return;
 455     }
 456
 457     if (${$mdocvars}{parabuf} ne "") {
 458         ${$mdocvars}{parabuf} .= " ";
 459     }
 460
 461     dlog(4, "Adding '$txt' to parabuf");
 462
 463     ${$mdocvars}{parabuf} .= $txt;
 464 }
 465
 466 sub load_archlist {
 467     my ($file) = (@_);
 468
 469     my $lineno = 0;
 470
 471     dlog(2, "Parsing archlist $file");
 472
 473     open(FILE, "$file") || die("$!: Could not open archlist $file in ", __LINE__, ".\n");
 474     while(<FILE>) {
 475         chomp;
 476         $lineno++;
 477
 478         if (/^#/ || $_ eq "") {
 479             next;
 480         }
 481
 482         if (/(\w+)\t([\w,]+)/) {
 483             dlog(4, "For driver $1 setting arch to $2");
 484             $archlist{$1} = $2;
 485         } else {
 486             dlog(1, "Warning: Could not parse archlist line $lineno");
 487         }
 488     }
 489
 490     close(FILE);
 491 }
 492
 493 # Check if a character is a mdoc(7) punctuation character.
 494 sub is_punct_char {
 495     my ($str) = (@_);
 496
 497     return (length($str) == 1 && $str =~ /[\.,:;()\[\]\?!]/);
 498 }
 499
 500 # Split out the punctuation characters of a mdoc(7) line.
 501 sub split_punct_chars {
 502     my ($str) = (@_);
 503     my (@stritems, $stritem, $punct_str);
 504
 505     $punct_str = "";
 506     @stritems = split(/ /, $str);
 507
 508     while (defined($stritem = $stritems[$#stritems]) &&
 509            is_punct_char($stritem)) {
 510         $punct_str = $stritem . $punct_str;
 511         pop(@stritems);
 512     }
 513
 514     return (join(' ', @stritems), $punct_str);
 515 }
 516
 517 # Create a ulink, if the string contains an URL.
 518 sub make_ulink {
 519     my ($str) = (@_);
 520
 521     $str =~ s,(http://[^ ]+),<ulink url="$1"></ulink>,;
 522
 523     return $str;
 524 }