release/doc/share/misc/man2hwnotes.pl

   1 #!/usr/bin/perl -w
   2 # Emacs should use -*- cperl -*- mode
   3 #
   4 # Copyright (c) 2003-2005 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 [-l] [-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 $debuglevel = 0;
  59 my $only_list_out = 0; # Should only lists be generated in the output?
  60 my @out_lines; # Single lines
  61 my @out_dev;   # Device entities
  62
  63 # Getopt
  64 my %options = ();
  65 if (!getopts("a:d:lo:",\%options)) {
  66     die("$!: Invalid command line arguments in ", __LINE__, "\n");
  67 }
  68
  69 if (defined($options{d})) {
  70     $debuglevel = $options{d};
  71 }
  72 if (defined($options{a})) {
  73     $archlist_file = $options{a};
  74 }
  75 if (defined($options{l})) {
  76     $only_list_out = 1;
  77 }
  78
  79 my $outputfile = $options{o};
  80
  81 if ($debuglevel > 0) {
  82     # Don't do output buffering in debug mode.
  83     $| = 1;
  84 }
  85
  86 load_archlist($archlist_file);
  87
  88 if (defined($outputfile)) {
  89     open(OLDOUT, ">&STDOUT") || die("$!: Could not open STDOUT in ", __LINE__, ".\n");
  90     open(STDOUT, ">$outputfile") || die("$!: Could not open $outputfile in ", __LINE__, ".\n");
  91 }
  92
  93 print <<EOT;
  94 <!--
  95  These are automatically generated device lists for FreeBSD hardware notes.
  96 -->
  97 EOT
  98
  99 if ($only_list_out) {
 100     # Print the default device preamble entities
 101     print "<!ENTITY hwlist.preamble.pre 'The'>\n";
 102     print "<!ENTITY hwlist.preamble.post 'driver supports:'>\n";
 103 }
 104
 105 foreach my $page (@ARGV) {
 106     if ($page !~ m/\.4$/) {
 107         dlog(2, "Skipped $page (not *.4)");
 108         next;
 109     }
 110     dlog(2, "Parsing $page");
 111     parse($page);
 112
 113     if (@out_lines) {
 114         print join("\n", @out_lines), "\n";
 115     }
 116     if (@out_dev) {
 117         print join("\n", @out_dev), "\n";
 118     }
 119
 120     @out_lines = ();
 121     @out_dev = ();
 122 }
 123
 124 if (defined($outputfile)) {
 125     open(STDOUT, ">&OLDOUT") || die("$!: Could not open STDOUT in ", __LINE__, ".\n");
 126     close(OLDOUT) || die("$!: Could not close OLDOUT in ", __LINE__, ".\n");
 127 }
 128
 129 sub normalize (@) {
 130     my @lines = @_;
 131
 132     foreach my $l (@lines) {
 133         $l =~ s/\\&//g;
 134         $l =~ s:([\x21-\x2f\x5b-\x60\x7b-\x7f]):sprintf("&\#\%d;", ord($1)):eg;
 135         # Make sure ampersand is encoded as &amp; since jade seems to
 136         # be confused when it is encoded as &#38; inside an entity.
 137         $l =~ s/&#38;/&amp;/g;
 138     }
 139     return (wantarray) ? @lines : join "", @lines;
 140 }
 141
 142 sub parse {
 143     my ($manpage) = @_;
 144
 145     my $cur_mansection;
 146     my $found_hwlist = 0;
 147     my %mdocvars;
 148     $mdocvars{isin_hwlist} = 0;
 149     $mdocvars{isin_list} = 0;
 150     $mdocvars{parabuf} = "";
 151     $mdocvars{listtype} = "";
 152     $mdocvars{it_nr} = 0;
 153
 154     open(MANPAGE, "$manpage") || die("$!: Could not open $manpage in ", __LINE__, ".\n");
 155     while(<MANPAGE>) {
 156         chomp;
 157         my $line = $_;
 158
 159         dlog(5, "Read '$line'");
 160
 161         # Find commands
 162         if (s/^\.(.*)$/$1/) {
 163             my $cmd = $1;
 164
 165             # Detect, and ignore, comment lines
 166             if (s/^\\"(.*)$/$1/) {
 167                 next;
 168             }
 169
 170             $cmd =~ s/^([^ ]+).*$/$1/;
 171
 172             if (/^Nm "?(\w+)"?/ && !defined($mdocvars{Nm})) {
 173                 dlog(3, "Setting Nm to $1");
 174                 $mdocvars{Nm} = $1;
 175                 # "_" cannot be used for an entity name.
 176                 $mdocvars{EntNm} = $1;
 177                 $mdocvars{EntNm} =~ s,_,.,g;
 178
 179             } elsif (/^Nm$/) {
 180                 if (defined($mdocvars{Nm}) && $mdocvars{Nm} ne "") {
 181                     parabuf_addline(\%mdocvars, "&man.".$mdocvars{EntNm}.".$cur_mansection;");
 182                 } else {
 183                     dlog(2, "Warning: Bad Nm call in $manpage");
 184                 }
 185
 186             } elsif (/^Sh (.+)$/) {
 187                 dlog(4, "Setting section to $1");
 188                 my $cur_section = $1;
 189
 190                 flush_out(\%mdocvars);
 191
 192                 if ($cur_section =~ /^${hwlist_sect}$/) {
 193                     dlog(2, "Found the device section ${hwlist_sect}");
 194                     $mdocvars{isin_hwlist} = 1;
 195                     $found_hwlist = 1;
 196                     add_sgmltag(\%mdocvars, "<!ENTITY hwlist.".$mdocvars{cur_manname}." '");
 197                     if ($only_list_out) {
 198                         add_sgmltag("<para>&hwlist.preamble.pre; " .
 199                                     "&man.".$mdocvars{EntNm}.".$cur_mansection; " .
 200                                     "&hwlist.preamble.post;</para>");
 201                     }
 202                 } elsif ($mdocvars{isin_hwlist}) {
 203                     dlog(2, "Found a HWLIST STOP key!");
 204                     add_sgmltag(\%mdocvars, "'>");
 205                     $mdocvars{isin_hwlist} = 0;
 206                 }
 207
 208             } elsif (/^Dt ([^ ]+) ([^ ]+)/) {
 209                 dlog(4, "Setting mansection to $2");
 210                 $mdocvars{cur_manname} = lc($1);
 211                 $cur_mansection = $2;
 212
 213                 # "_" cannot be used for an entity name.
 214                 $mdocvars{cur_manname} =~ s,_,.,g;
 215
 216             } elsif (/^It ?(.*)$/) {
 217                 my $txt = $1;
 218
 219                 $mdocvars{it_nr}++;
 220
 221                 # Flush last item
 222                 if ($mdocvars{parabuf} ne "") {
 223                     add_listitem(\%mdocvars);
 224                 }
 225
 226                 # Remove quotes, if any.
 227                 $txt =~ s/"(.*)"/$1/;
 228
 229                 if ($mdocvars{listtype} eq "column") {
 230                     # Ignore first item when it is likely to be a
 231                     # header.
 232                     if ($mdocvars{it_nr} == 1 && $txt =~ m/^(Em|Sy) /) {
 233                         dlog(2, "Skipping header line in column list");
 234                         next;
 235                     }
 236                     # Only extract the first column.
 237                     $txt =~ s/ Ta /\t/g;
 238                     $txt =~ s/([^\t]+)\t.*/$1/;
 239                 }
 240                 parabuf_addline(\%mdocvars, normalize($txt));
 241             } elsif (/^Bl/) {
 242                 $mdocvars{isin_list} = 1;
 243                 flush_out(\%mdocvars);
 244                 add_sgmltag(\%mdocvars, "<itemizedlist>");
 245
 246                 if (/-tag/) {
 247                     $mdocvars{listtype} = "tag";
 248                     # YACK! Hack for ata(4)
 249                     if ($mdocvars{Nm} eq "ata") {
 250                         $mdocvars{listtype} = "tagHACK";
 251                     }
 252                 } elsif (/-bullet/) {
 253                     $mdocvars{listtype} = "bullet";
 254                 } elsif (/-column/) {
 255                     $mdocvars{listtype} = "column";
 256                 } else {
 257                     $mdocvars{listtype} = "unknown";
 258                 }
 259                 dlog(2, "Listtype set to $mdocvars{listtype}");
 260             } elsif (/^El/) {
 261                 if ($mdocvars{parabuf} ne "") {
 262                     add_listitem(\%mdocvars);
 263                 }
 264
 265                 add_sgmltag(\%mdocvars, "</itemizedlist>");
 266                 $mdocvars{isin_list} = 0;
 267             } elsif (/^Tn (.+)$/) {
 268                 # For now we print TradeName text as regular text.
 269                 my ($txt, $punct_str) = split_punct_chars($1);
 270
 271                 parabuf_addline(\%mdocvars, normalize($txt . $punct_str));
 272             } elsif (/^Xr ([^ ]+) (.+)$/) {
 273                 my ($xr_sect, $punct_str) = split_punct_chars($2);
 274                 my $txt;
 275
 276                 # We need to check if the manual page exist to avoid
 277                 # breaking the doc build just because of a broken
 278                 # reference.
 279                 #$txt = "&man.$1.$xr_sect;$punct_str";
 280                 $txt = "$1($xr_sect)$punct_str";
 281                 parabuf_addline(\%mdocvars, normalize($txt));
 282             } elsif (/^Dq (.+)$/) {
 283                 my ($txt, $punct_str) = split_punct_chars($1);
 284
 285                 parabuf_addline(\%mdocvars,
 286                                 normalize("<quote>$txt</quote>$punct_str"));
 287             } elsif (/^Sx (.+)$/) {
 288                 if ($mdocvars{isin_hwlist}) {
 289                     dlog(1, "Warning: Reference to another section in the " .
 290                          "$hwlist_sect section in " . $mdocvars{Nm} .
 291                          "(${cur_mansection})");
 292                 }
 293                 parabuf_addline(\%mdocvars, normalize($1));
 294             } elsif (/^Pa (.+)$/) {
 295                 my ($txt, $punct_str) = split_punct_chars($1);
 296
 297                 $txt = make_ulink($txt) . $punct_str;
 298                 parabuf_addline(\%mdocvars, normalize($txt));
 299             } else {
 300                 # Ignore all other commands.
 301                 dlog(3, "Ignoring unknown command $cmd");
 302             }
 303         } else {
 304             # This is then regular text
 305             parabuf_addline(\%mdocvars, normalize($_));
 306         }
 307     }
 308     close(MANPAGE) || die("$!: Could not close $manpage in ", __LINE__, ".\n");
 309     if (! $found_hwlist) {
 310         dlog(2, "Hardware list not found in $manpage");
 311     }
 312 }
 313
 314 sub dlog {
 315     my ($level, $txt) = @_;
 316
 317     if ($level <= $debuglevel) {
 318         print STDERR "$level: $txt\n";
 319     }
 320 }
 321
 322 # Output a SGML tag.
 323 sub add_sgmltag {
 324     my ($mdocvars, $txt) = (@_);
 325
 326     # We only care about the HW list for now.
 327     if (${$mdocvars}{isin_hwlist}) {
 328         push(@out_dev, $txt);
 329     }
 330 }
 331
 332 # Add a text entity, and return the used entity name.
 333 sub add_txt_ent {
 334     my ($itemtxt) = (@_);
 335     my ($entity_name);
 336
 337     # Convert mdoc(7) minus
 338     $itemtxt =~ s/\\-/-/g;
 339
 340     $itemtxt =~ s/'/&lsquo;/g;
 341
 342     $entity_name = "hwlist." . md5_hex($itemtxt);
 343     dlog(4, "Adding '$itemtxt' as entity $entity_name");
 344     push(@out_lines, "<!ENTITY $entity_name '$itemtxt'>");
 345
 346     return ($entity_name);
 347 }
 348 sub flush_out {
 349     my ($mdocvars) = (@_);
 350     my ($entity_name, $out);
 351     my $para_arch = "";
 352
 353     if (!${$mdocvars}{isin_hwlist} || ${$mdocvars}{parabuf} eq "") {
 354         return;
 355     }
 356
 357     $entity_name = add_txt_ent(${$mdocvars}{parabuf});
 358     ${$mdocvars}{parabuf} = "";
 359     if(defined($archlist{${$mdocvars}{Nm}})) {
 360         $para_arch = ' arch="' . $archlist{${$mdocvars}{Nm}} . '"';
 361     }
 362     $out = "<para".$para_arch.">&".$entity_name.";</para>";
 363
 364     dlog(4, "Flushing parabuf");
 365     add_sgmltag($mdocvars, $out);
 366 }
 367
 368 # Add a new list item from the "parabuf".
 369 sub add_listitem {
 370     my ($mdocvars) = (@_);
 371     my ($listitem, $entity_name);
 372     my $para_arch = "";
 373
 374     $entity_name = add_txt_ent(${$mdocvars}{parabuf});
 375     ${$mdocvars}{parabuf} = "";
 376
 377     if(defined($archlist{${$mdocvars}{Nm}})) {
 378         $para_arch = ' arch="' . $archlist{${$mdocvars}{Nm}} . '"';
 379     }
 380     $listitem = "<listitem><para".$para_arch.">&".$entity_name.";</para></listitem>";
 381     dlog(4, "Adding '$listitem' to out_dev");
 382     push(@out_dev, $listitem);
 383
 384 }
 385
 386 # Add a line to the "paragraph buffer"
 387 sub parabuf_addline {
 388     my $mdocvars = shift;
 389     my ($txt) = (@_);
 390
 391     dlog(5, "Now in parabuf_addline");
 392
 393     # We only care about the HW list for now.
 394     if (!${$mdocvars}{isin_hwlist}) {
 395         return;
 396     }
 397     if ($txt eq "") {
 398         return;
 399     }
 400
 401     if ($only_list_out && !${$mdocvars}{isin_list}) {
 402         return;
 403     }
 404
 405     # We only add the first line for "tag" lists
 406     if (${$mdocvars}{parabuf} ne "" && ${$mdocvars}{isin_list} &&
 407         ${$mdocvars}{listtype} eq "tag") {
 408         return;
 409     }
 410
 411     if (${$mdocvars}{parabuf} ne "") {
 412         ${$mdocvars}{parabuf} .= " ";
 413     }
 414
 415     dlog(4, "Adding '$txt' to parabuf");
 416
 417     ${$mdocvars}{parabuf} .= $txt;
 418 }
 419
 420 sub load_archlist {
 421     my ($file) = (@_);
 422
 423     my $lineno = 0;
 424
 425     dlog(2, "Parsing archlist $file");
 426
 427     open(FILE, "$file") || die("$!: Could not open archlist $file in ", __LINE__, ".\n");
 428     while(<FILE>) {
 429         chomp;
 430         $lineno++;
 431
 432         if (/^#/ || $_ eq "") {
 433             next;
 434         }
 435
 436         if (/(\w+)\t([\w,]+)/) {
 437             dlog(4, "For driver $1 setting arch to $2");
 438             $archlist{$1} = $2;
 439         } else {
 440             dlog(1, "Warning: Could not parse archlist line $lineno");
 441         }
 442     }
 443
 444     close(FILE);
 445 }
 446
 447 # Check if a character is a mdoc(7) punctuation character.
 448 sub is_punct_char {
 449     my ($str) = (@_);
 450
 451     return (length($str) == 1 && $str =~ /[\.,:;()\[\]\?!]/);
 452 }
 453
 454 # Split out the punctuation characters of a mdoc(7) line.
 455 sub split_punct_chars {
 456     my ($str) = (@_);
 457     my (@stritems, $stritem, $punct_str);
 458
 459     $punct_str = "";
 460     @stritems = split(/ /, $str);
 461
 462     while (defined($stritem = $stritems[$#stritems]) &&
 463            is_punct_char($stritem)) {
 464         $punct_str = $stritem . $punct_str;
 465         pop(@stritems);
 466     }
 467
 468     return (join(' ', @stritems), $punct_str);
 469 }
 470
 471 # Create a ulink, if the string contains an URL.
 472 sub make_ulink {
 473     my ($str) = (@_);
 474
 475     $str =~ s,(http://[^ ]+),<ulink url="$1"></ulink>,;
 476
 477     return $str;
 478 }