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{parabuf} = "";
 155     $mdocvars{listtype} = "";
 156     $mdocvars{it_nr} = 0;
 157
 158     open(MANPAGE, "$manpage") || die("$!: Could not open $manpage in ", __LINE__, ".\n");
 159     while(<MANPAGE>) {
 160         chomp;
 161         my $line = $_;
 162
 163         dlog(5, "Read '$line'");
 164
 165         # Find commands
 166         if (s/^\.(.*)$/$1/) {
 167             my $cmd = $1;
 168
 169             # Detect, and ignore, comment lines
 170             if (s/^\\"(.*)$/$1/) {
 171                 next;
 172             }
 173
 174             $cmd =~ s/^([^ ]+).*$/$1/;
 175
 176             if (/^Nm "?(\w+)"?/ && !defined($mdocvars{Nm})) {
 177                 dlog(3, "Setting Nm to $1");
 178                 $mdocvars{Nm} = $1;
 179                 # "_" cannot be used for an entity name.
 180                 $mdocvars{EntNm} = $1;
 181                 $mdocvars{EntNm} =~ s,_,.,g;
 182
 183             } elsif (/^Nm$/) {
 184                 if (defined($mdocvars{Nm}) && $mdocvars{Nm} ne "") {
 185                     parabuf_addline(\%mdocvars, "&man.".$mdocvars{EntNm}.".$cur_mansection;");
 186                 } else {
 187                     dlog(2, "Warning: Bad Nm call in $manpage");
 188                 }
 189
 190             } elsif (/^Sh (.+)$/) {
 191                 dlog(4, "Setting section to $1");
 192                 my $cur_section = $1;
 193
 194                 flush_out(\%mdocvars);
 195
 196                 if ($cur_section =~ /^${hwlist_sect}$/) {
 197                     dlog(2, "Found the device section ${hwlist_sect}");
 198                     $mdocvars{isin_hwlist} = 1;
 199                     $found_hwlist = 1;
 200                     add_sgmltag(\%mdocvars, "<!ENTITY hwlist.".$mdocvars{cur_manname}." '");
 201                     if ($only_list_out) {
 202                         add_sgmltag("<para>&hwlist.preamble.pre; " .
 203                                     "&man.".$mdocvars{EntNm}.".$cur_mansection; " .
 204                                     "&hwlist.preamble.post;</para>");
 205                     }
 206                 } elsif ($mdocvars{isin_hwlist}) {
 207                     dlog(2, "Found a HWLIST STOP key!");
 208                     add_sgmltag(\%mdocvars, "'>");
 209                     $mdocvars{isin_hwlist} = 0;
 210                 }
 211                 if ($mdocvars{isin_list}) {
 212                     dlog(1, "Warning: Still in list, but just entered new " .
 213                          "section.  This is probably due to missing .El; " .
 214                          "check manual page for errors.");
 215                     # If we try to recover from this we will probably
 216                     # just end with bad SGML output and it really
 217                     # should be fixed in the manual page so we don't
 218                     # even try to "fix" this.
 219                 }
 220
 221
 222             } elsif (/^Dt ([^ ]+) ([^ ]+)/) {
 223                 dlog(4, "Setting mansection to $2");
 224                 $mdocvars{cur_manname} = lc($1);
 225                 $cur_mansection = $2;
 226
 227                 # "_" cannot be used for an entity name.
 228                 $mdocvars{cur_manname} =~ s,_,.,g;
 229
 230             } elsif (/^It ?(.*)$/) {
 231                 my $txt = $1;
 232
 233                 $mdocvars{it_nr}++;
 234
 235                 # Flush last item
 236                 if ($mdocvars{parabuf} ne "") {
 237                     add_listitem(\%mdocvars);
 238                 }
 239
 240                 # Remove quotes, if any.
 241                 $txt =~ s/"(.*)"/$1/;
 242
 243                 if ($mdocvars{listtype} eq "column") {
 244                     # Ignore first item when it is likely to be a
 245                     # header.
 246                     if ($mdocvars{it_nr} == 1 && $txt =~ m/^(Em|Sy) /) {
 247                         dlog(2, "Skipping header line in column list");
 248                         next;
 249                     }
 250                     # Only extract the first column.
 251                     $txt =~ s/ Ta /\t/g;
 252                     $txt =~ s/([^\t]+)\t.*/$1/;
 253                 }
 254                 parabuf_addline(\%mdocvars, normalize($txt));
 255             } elsif (/^Bl/) {
 256                 $mdocvars{isin_list} = 1;
 257                 flush_out(\%mdocvars);
 258                 add_sgmltag(\%mdocvars, "<itemizedlist>");
 259
 260                 if (/-tag/) {
 261                     $mdocvars{listtype} = "tag";
 262                     # YACK! Hack for ata(4)
 263                     if ($mdocvars{Nm} eq "ata") {
 264                         $mdocvars{listtype} = "tagHACK";
 265                     }
 266                 } elsif (/-bullet/) {
 267                     $mdocvars{listtype} = "bullet";
 268                 } elsif (/-column/) {
 269                     $mdocvars{listtype} = "column";
 270                 } else {
 271                     $mdocvars{listtype} = "unknown";
 272                 }
 273                 dlog(2, "Listtype set to $mdocvars{listtype}");
 274             } elsif (/^El/) {
 275                 if ($mdocvars{parabuf} ne "") {
 276                     add_listitem(\%mdocvars);
 277                 }
 278
 279                 add_sgmltag(\%mdocvars, "</itemizedlist>");
 280                 $mdocvars{isin_list} = 0;
 281             } elsif (/^Tn (.+)$/) {
 282                 # For now we print TradeName text as regular text.
 283                 my ($txt, $punct_str) = split_punct_chars($1);
 284
 285                 parabuf_addline(\%mdocvars, normalize($txt . $punct_str));
 286             } elsif (/^Xr ([^ ]+) (.+)$/) {
 287                 my ($xr_sect, $punct_str) = split_punct_chars($2);
 288                 my $txt;
 289
 290                 # We need to check if the manual page exist to avoid
 291                 # breaking the doc build just because of a broken
 292                 # reference.
 293                 #$txt = "&man.$1.$xr_sect;$punct_str";
 294                 $txt = "$1($xr_sect)$punct_str";
 295                 parabuf_addline(\%mdocvars, normalize($txt));
 296             } elsif (/^Dq (.+)$/) {
 297                 my ($txt, $punct_str) = split_punct_chars($1);
 298
 299                 parabuf_addline(\%mdocvars,
 300                                 normalize("<quote>$txt</quote>$punct_str"));
 301             } elsif (/^Sx (.+)$/) {
 302                 if ($mdocvars{isin_hwlist}) {
 303                     dlog(1, "Warning: Reference to another section in the " .
 304                          "$hwlist_sect section in " . $mdocvars{Nm} .
 305                          "(${cur_mansection})");
 306                 }
 307                 parabuf_addline(\%mdocvars, normalize($1));
 308             } elsif (/^Pa (.+)$/) {
 309                 my ($txt, $punct_str) = split_punct_chars($1);
 310
 311                 $txt = make_ulink($txt) . $punct_str;
 312                 parabuf_addline(\%mdocvars, normalize($txt));
 313             } else {
 314                 # Ignore all other commands.
 315                 dlog(3, "Ignoring unknown command $cmd");
 316             }
 317         } else {
 318             # This is then regular text
 319             parabuf_addline(\%mdocvars, normalize($_));
 320         }
 321     }
 322     close(MANPAGE) || die("$!: Could not close $manpage in ", __LINE__, ".\n");
 323     if (! $found_hwlist) {
 324         dlog(2, "Hardware list not found in $manpage");
 325     }
 326 }
 327
 328 sub dlog {
 329     my ($level, $txt) = @_;
 330
 331     if ($level <= $debuglevel) {
 332         print STDERR "$level: $txt\n";
 333     }
 334 }
 335
 336 # Output a SGML tag.
 337 sub add_sgmltag {
 338     my ($mdocvars, $txt) = (@_);
 339
 340     # We only care about the HW list for now.
 341     if (${$mdocvars}{isin_hwlist}) {
 342         push(@out_dev, $txt);
 343     }
 344 }
 345
 346 # Add a text entity, and return the used entity name.
 347 sub add_txt_ent {
 348     my ($itemtxt) = (@_);
 349     my ($entity_name);
 350
 351     # Convert mdoc(7) minus
 352     $itemtxt =~ s/\\-/-/g;
 353
 354     $itemtxt =~ s/'/&lsquo;/g;
 355
 356     $entity_name = "hwlist." . md5_hex($itemtxt);
 357     dlog(4, "Adding '$itemtxt' as entity $entity_name");
 358     push(@out_lines, "<!ENTITY $entity_name '$itemtxt'>");
 359
 360     return ($entity_name);
 361 }
 362 sub flush_out {
 363     my ($mdocvars) = (@_);
 364     my ($entity_name, $out);
 365     my $para_arch = "";
 366
 367     if (!${$mdocvars}{isin_hwlist} || ${$mdocvars}{parabuf} eq "") {
 368         return;
 369     }
 370
 371     $entity_name = add_txt_ent(${$mdocvars}{parabuf});
 372     ${$mdocvars}{parabuf} = "";
 373     if(defined($archlist{${$mdocvars}{Nm}})) {
 374         if ($compat_mode) {
 375             $para_arch = ' arch="' . $archlist{${$mdocvars}{Nm}} . '"';
 376         } else {
 377             $para_arch = '[' . $archlist{${$mdocvars}{Nm}} . '] ';
 378         }
 379     }
 380     if ($compat_mode) {
 381         $out = "<para".$para_arch.">&".$entity_name.";</para>";
 382     } else {
 383         $out = "<para>".$para_arch."&".$entity_name.";</para>";
 384     }
 385
 386     dlog(4, "Flushing parabuf");
 387     add_sgmltag($mdocvars, $out);
 388 }
 389
 390 # Add a new list item from the "parabuf".
 391 sub add_listitem {
 392     my ($mdocvars) = (@_);
 393     my ($listitem, $entity_name);
 394     my $para_arch = "";
 395
 396     $entity_name = add_txt_ent(${$mdocvars}{parabuf});
 397     ${$mdocvars}{parabuf} = "";
 398
 399     if ($compat_mode) {
 400         if(defined($archlist{${$mdocvars}{Nm}})) {
 401             $para_arch = ' arch="' . $archlist{${$mdocvars}{Nm}} . '"';
 402         }
 403     } else {
 404         $listitem = "<listitem><para>&".$entity_name.";</para></listitem>";
 405     }
 406     $listitem = "<listitem><para".$para_arch.">&".$entity_name.";</para></listitem>";
 407     dlog(4, "Adding '$listitem' to out_dev");
 408     push(@out_dev, $listitem);
 409
 410 }
 411
 412 # Add a line to the "paragraph buffer"
 413 sub parabuf_addline {
 414     my $mdocvars = shift;
 415     my ($txt) = (@_);
 416
 417     dlog(5, "Now in parabuf_addline for '$txt'");
 418
 419     # We only care about the HW list for now.
 420     if (!${$mdocvars}{isin_hwlist}) {
 421         dlog(6, "Exiting parabuf_addline due to: !\${\$mdocvars}{isin_hwlist}");
 422         return;
 423     }
 424     if ($txt eq "") {
 425         dlog(6, "Exiting parabuf_addline due to: \$txt eq \"\"");
 426         return;
 427     }
 428
 429     if ($only_list_out && !${$mdocvars}{isin_list}) {
 430         dlog(6, "Exiting parabuf_addline due to: ".
 431              "\$only_list_out && !\${\$mdocvars}{isin_list}");
 432         return;
 433     }
 434
 435     # We only add the first line for "tag" lists
 436     if (${$mdocvars}{parabuf} ne "" && ${$mdocvars}{isin_list} &&
 437         ${$mdocvars}{listtype} eq "tag") {
 438         dlog(6, "Exiting parabuf_addline due to: ".
 439              "\${\$mdocvars}{parabuf} ne \"\" && \${\$mdocvars}{isin_list} && ".
 440              "\${\$mdocvars}{listtype} eq \"tag\"");
 441         return;
 442     }
 443
 444     if (${$mdocvars}{parabuf} ne "") {
 445         ${$mdocvars}{parabuf} .= " ";
 446     }
 447
 448     dlog(4, "Adding '$txt' to parabuf");
 449
 450     ${$mdocvars}{parabuf} .= $txt;
 451 }
 452
 453 sub load_archlist {
 454     my ($file) = (@_);
 455
 456     my $lineno = 0;
 457
 458     dlog(2, "Parsing archlist $file");
 459
 460     open(FILE, "$file") || die("$!: Could not open archlist $file in ", __LINE__, ".\n");
 461     while(<FILE>) {
 462         chomp;
 463         $lineno++;
 464
 465         if (/^#/ || $_ eq "") {
 466             next;
 467         }
 468
 469         if (/(\w+)\t([\w,]+)/) {
 470             dlog(4, "For driver $1 setting arch to $2");
 471             $archlist{$1} = $2;
 472         } else {
 473             dlog(1, "Warning: Could not parse archlist line $lineno");
 474         }
 475     }
 476
 477     close(FILE);
 478 }
 479
 480 # Check if a character is a mdoc(7) punctuation character.
 481 sub is_punct_char {
 482     my ($str) = (@_);
 483
 484     return (length($str) == 1 && $str =~ /[\.,:;()\[\]\?!]/);
 485 }
 486
 487 # Split out the punctuation characters of a mdoc(7) line.
 488 sub split_punct_chars {
 489     my ($str) = (@_);
 490     my (@stritems, $stritem, $punct_str);
 491
 492     $punct_str = "";
 493     @stritems = split(/ /, $str);
 494
 495     while (defined($stritem = $stritems[$#stritems]) &&
 496            is_punct_char($stritem)) {
 497         $punct_str = $stritem . $punct_str;
 498         pop(@stritems);
 499     }
 500
 501     return (join(' ', @stritems), $punct_str);
 502 }
 503
 504 # Create a ulink, if the string contains an URL.
 505 sub make_ulink {
 506     my ($str) = (@_);
 507
 508     $str =~ s,(http://[^ ]+),<ulink url="$1"></ulink>,;
 509
 510     return $str;
 511 }