2 # Emacs should use -*- cperl -*- mode
4 # Copyright (c) 2003-2006 Simon L. Nielsen <simon@FreeBSD.org>
7 # Redistribution and use in source and binary forms, with or without
8 # modification, are permitted provided that the following conditions
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.
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
31 # Parse the list of supported hardware out of section 4 manual pages
32 # and output it on stdout as SGML/DocBook entities.
34 # The script will look for the following line in the manual page:
36 # and make an entity of the content until the line containing:
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.
43 # man2hwnotes.pl [-cl] [-d 0-6] [-a <archlist file>] [-o <outputfile>]
44 # <manualpage> [<manualpage> ...]
48 use Digest::MD5 qw(md5_hex);
50 # Section from manual page to extract
51 my $hwlist_sect = "HARDWARE";
53 # Override default archtecture list for some devices:
54 my $archlist_file = "dev.archlist.txt";
58 my $compat_mode = 0; # Enable compat for old Hardware Notes style
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
66 if (!getopts("a:cd:lo:",\%options)) {
67 die("$!: Invalid command line arguments in ", __LINE__, "\n");
70 if (defined($options{c})) {
73 if (defined($options{d})) {
74 $debuglevel = $options{d};
76 if (defined($options{a})) {
77 $archlist_file = $options{a};
79 if (defined($options{l})) {
83 my $outputfile = $options{o};
85 if ($debuglevel > 0) {
86 # Don't do output buffering in debug mode.
90 load_archlist($archlist_file);
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");
99 These are automatically generated device lists for FreeBSD hardware notes.
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";
109 foreach my $page (@ARGV) {
110 if ($page !~ m/\.4$/) {
111 dlog(2, "Skipped $page (not *.4)");
114 dlog(2, "Parsing $page");
118 print join("\n", @out_lines), "\n";
121 print join("\n", @out_dev), "\n";
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");
136 foreach my $l (@lines) {
138 $l =~ s:([\x21-\x2f\x5b-\x60\x7b-\x7f]):sprintf("&\#\%d;", ord($1)):eg;
139 # Make sure ampersand is encoded as & since jade seems to
140 # be confused when it is encoded as & inside an entity.
141 $l =~ s/&/&/g;
143 return (wantarray) ? @lines : join "", @lines;
150 my $found_hwlist = 0;
152 $mdocvars{isin_hwlist} = 0;
153 $mdocvars{isin_list} = 0;
154 $mdocvars{parabuf} = "";
155 $mdocvars{listtype} = "";
156 $mdocvars{it_nr} = 0;
158 open(MANPAGE, "$manpage") || die("$!: Could not open $manpage in ", __LINE__, ".\n");
163 dlog(5, "Read '$line'");
166 if (s/^\.(.*)$/$1/) {
169 # Detect, and ignore, comment lines
170 if (s/^\\"(.*)$/$1/) {
174 $cmd =~ s/^([^ ]+).*$/$1/;
176 if (/^Nm "?(\w+)"?/ && !defined($mdocvars{Nm})) {
177 dlog(3, "Setting Nm to $1");
179 # "_" cannot be used for an entity name.
180 $mdocvars{EntNm} = $1;
181 $mdocvars{EntNm} =~ s,_,.,g;
184 if (defined($mdocvars{Nm}) && $mdocvars{Nm} ne "") {
185 parabuf_addline(\%mdocvars, "&man.".$mdocvars{EntNm}.".$cur_mansection;");
187 dlog(2, "Warning: Bad Nm call in $manpage");
190 } elsif (/^Sh (.+)$/) {
191 dlog(4, "Setting section to $1");
192 my $cur_section = $1;
194 flush_out(\%mdocvars);
196 if ($cur_section =~ /^${hwlist_sect}$/) {
197 dlog(2, "Found the device section ${hwlist_sect}");
198 $mdocvars{isin_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>");
206 } elsif ($mdocvars{isin_hwlist}) {
207 dlog(2, "Found a HWLIST STOP key!");
208 add_sgmltag(\%mdocvars, "'>");
209 $mdocvars{isin_hwlist} = 0;
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.
222 } elsif (/^Dt ([^ ]+) ([^ ]+)/) {
223 dlog(4, "Setting mansection to $2");
224 $mdocvars{cur_manname} = lc($1);
225 $cur_mansection = $2;
227 # "_" cannot be used for an entity name.
228 $mdocvars{cur_manname} =~ s,_,.,g;
230 } elsif (/^It ?(.*)$/) {
236 if ($mdocvars{parabuf} ne "") {
237 add_listitem(\%mdocvars);
240 # Remove quotes, if any.
241 $txt =~ s/"(.*)"/$1/;
243 if ($mdocvars{listtype} eq "column") {
244 # Ignore first item when it is likely to be a
246 if ($mdocvars{it_nr} == 1 && $txt =~ m/^(Em|Sy) /) {
247 dlog(2, "Skipping header line in column list");
250 # Only extract the first column.
252 $txt =~ s/([^\t]+)\t.*/$1/;
254 parabuf_addline(\%mdocvars, normalize($txt));
256 $mdocvars{isin_list} = 1;
257 flush_out(\%mdocvars);
258 add_sgmltag(\%mdocvars, "<itemizedlist>");
261 $mdocvars{listtype} = "tag";
262 # YACK! Hack for ata(4)
263 if ($mdocvars{Nm} eq "ata") {
264 $mdocvars{listtype} = "tagHACK";
266 } elsif (/-bullet/) {
267 $mdocvars{listtype} = "bullet";
268 } elsif (/-column/) {
269 $mdocvars{listtype} = "column";
271 $mdocvars{listtype} = "unknown";
273 dlog(2, "Listtype set to $mdocvars{listtype}");
275 if ($mdocvars{parabuf} ne "") {
276 add_listitem(\%mdocvars);
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);
285 parabuf_addline(\%mdocvars, normalize($txt . $punct_str));
286 } elsif (/^Xr ([^ ]+) (.+)$/) {
287 my ($xr_sect, $punct_str) = split_punct_chars($2);
290 # We need to check if the manual page exist to avoid
291 # breaking the doc build just because of a broken
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);
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})");
307 parabuf_addline(\%mdocvars, normalize($1));
308 } elsif (/^Pa (.+)$/) {
309 my ($txt, $punct_str) = split_punct_chars($1);
311 $txt = make_ulink($txt) . $punct_str;
312 parabuf_addline(\%mdocvars, normalize($txt));
314 # Ignore all other commands.
315 dlog(3, "Ignoring unknown command $cmd");
318 # This is then regular text
319 parabuf_addline(\%mdocvars, normalize($_));
322 close(MANPAGE) || die("$!: Could not close $manpage in ", __LINE__, ".\n");
323 if (! $found_hwlist) {
324 dlog(2, "Hardware list not found in $manpage");
329 my ($level, $txt) = @_;
331 if ($level <= $debuglevel) {
332 print STDERR "$level: $txt\n";
338 my ($mdocvars, $txt) = (@_);
340 # We only care about the HW list for now.
341 if (${$mdocvars}{isin_hwlist}) {
342 push(@out_dev, $txt);
346 # Add a text entity, and return the used entity name.
348 my ($itemtxt) = (@_);
351 # Convert mdoc(7) minus
352 $itemtxt =~ s/\\-/-/g;
354 $itemtxt =~ s/'/‘/g;
356 $entity_name = "hwlist." . md5_hex($itemtxt);
357 dlog(4, "Adding '$itemtxt' as entity $entity_name");
358 push(@out_lines, "<!ENTITY $entity_name '$itemtxt'>");
360 return ($entity_name);
363 my ($mdocvars) = (@_);
364 my ($entity_name, $out);
367 if (!${$mdocvars}{isin_hwlist} || ${$mdocvars}{parabuf} eq "") {
371 $entity_name = add_txt_ent(${$mdocvars}{parabuf});
372 ${$mdocvars}{parabuf} = "";
373 if(defined($archlist{${$mdocvars}{Nm}})) {
375 $para_arch = ' arch="' . $archlist{${$mdocvars}{Nm}} . '"';
377 $para_arch = '[' . $archlist{${$mdocvars}{Nm}} . '] ';
381 $out = "<para".$para_arch.">&".$entity_name.";</para>";
383 $out = "<para>".$para_arch."&".$entity_name.";</para>";
386 dlog(4, "Flushing parabuf");
387 add_sgmltag($mdocvars, $out);
390 # Add a new list item from the "parabuf".
392 my ($mdocvars) = (@_);
393 my ($listitem, $entity_name);
396 $entity_name = add_txt_ent(${$mdocvars}{parabuf});
397 ${$mdocvars}{parabuf} = "";
400 if(defined($archlist{${$mdocvars}{Nm}})) {
401 $para_arch = ' arch="' . $archlist{${$mdocvars}{Nm}} . '"';
404 $listitem = "<listitem><para>&".$entity_name.";</para></listitem>";
406 $listitem = "<listitem><para".$para_arch.">&".$entity_name.";</para></listitem>";
407 dlog(4, "Adding '$listitem' to out_dev");
408 push(@out_dev, $listitem);
412 # Add a line to the "paragraph buffer"
413 sub parabuf_addline {
414 my $mdocvars = shift;
417 dlog(5, "Now in parabuf_addline for '$txt'");
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}");
425 dlog(6, "Exiting parabuf_addline due to: \$txt eq \"\"");
429 if ($only_list_out && !${$mdocvars}{isin_list}) {
430 dlog(6, "Exiting parabuf_addline due to: ".
431 "\$only_list_out && !\${\$mdocvars}{isin_list}");
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\"");
444 if (${$mdocvars}{parabuf} ne "") {
445 ${$mdocvars}{parabuf} .= " ";
448 dlog(4, "Adding '$txt' to parabuf");
450 ${$mdocvars}{parabuf} .= $txt;
458 dlog(2, "Parsing archlist $file");
460 open(FILE, "$file") || die("$!: Could not open archlist $file in ", __LINE__, ".\n");
465 if (/^#/ || $_ eq "") {
469 if (/(\w+)\t([\w,]+)/) {
470 dlog(4, "For driver $1 setting arch to $2");
473 dlog(1, "Warning: Could not parse archlist line $lineno");
480 # Check if a character is a mdoc(7) punctuation character.
484 return (length($str) == 1 && $str =~ /[\.,:;()\[\]\?!]/);
487 # Split out the punctuation characters of a mdoc(7) line.
488 sub split_punct_chars {
490 my (@stritems, $stritem, $punct_str);
493 @stritems = split(/ /, $str);
495 while (defined($stritem = $stritems[$#stritems]) &&
496 is_punct_char($stritem)) {
497 $punct_str = $stritem . $punct_str;
501 return (join(' ', @stritems), $punct_str);
504 # Create a ulink, if the string contains an URL.
508 $str =~ s,(http://[^ ]+),<ulink url="$1"></ulink>,;