website/bin/fix-pod2html.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use HTML::Parser;
   5
   6 # fix pod2html output:
   7 # v1.0: defer </dd> and </dt> tags until
   8 # the next <dd>, <dt> or </dl>
   9
  10 # v1.1: don't nest any <a> elements;
  11 # end one before beginning another
  12
  13 # v1.2: insert <dd> tags if <dl> occurs
  14 # inside <dt>
  15
  16 # v1.3: <a> anchors must not start with a digit;
  17 # insert a letter "N" at the start if they do
  18
  19 # v1.4: insert the "N" letter into <a href="#xxx"> too.
  20
  21 my $p = HTML::Parser->new(api_version => 3);
  22 $p->handler(start => \&startsub, 'tagname, text');
  23 $p->handler(end => \&endsub, 'tagname, text');
  24 $p->handler(default => sub { print shift() }, 'text');
  25 $p->parse_file(shift||"-") or die("parse: $!");
  26
  27 my @ddstack;
  28 my @listack;
  29 my $a=0;
  30
  31 sub startsub {
  32         my $tag = shift;
  33         my $text = shift;
  34         if ($tag eq "dl") {
  35                 if (@ddstack and $ddstack[0] eq "dt") {
  36                         $ddstack[0] = "dd";
  37                         print "</dt><dd>";
  38                 }
  39                 unshift @ddstack, 0;
  40         }
  41         if ($tag =~ /^[uo]l$/) {
  42                 unshift @listack, 0;
  43         }
  44         if (($tag eq "dt" or $tag eq "dd") and $ddstack[0]) {
  45                 print "</$ddstack[0]>";
  46                 $ddstack[0] = 0;
  47         }
  48         if (($tag eq "li") and $listack[0]) {
  49                 print "</$listack[0]>";
  50                 $listack[0] = 0;
  51         }
  52         if ($tag eq "a") {
  53                 if ($a) {
  54                         print "</a>";
  55                 } else {
  56                         $a++;
  57                 }
  58                 $text =~ s/(name="|href="#)(\d)/$1N$2/;
  59         }
  60         print $text;
  61 }
  62
  63
  64 sub endsub {
  65         my $tag = shift;
  66         my $text = shift;
  67         if ($tag eq "dl") {
  68                 print "</$ddstack[0]>" if $ddstack[0];
  69                 shift @ddstack;
  70         } elsif ($tag =~ /^[uo]l$/) {
  71                 print "</$listack[0]>" if $listack[0];
  72                 shift @listack;
  73         }
  74
  75         if ($tag eq "a") {
  76                 if ($a) {
  77                         print "</a>";
  78                         $a--;
  79                 }
  80         } elsif ($tag eq "dd" or $tag eq "dt") {
  81                 $ddstack[0] = $tag;
  82         } elsif ($tag eq "li") {
  83                $listack[0] = $tag;
  84         } else {
  85                 print $text;
  86         }
  87 }