faq2html.pl

   1 #! /usr/bin/perl -w
   2 use strict;
   3 require 5.000;
   4 use lib qw(.);
   5 use Style qw(html_header html_footer);
   6
   7 # The AFE FAQ HTMLizer
   8 # Perl version written by Kamion; based on a sed script by Aquarius
   9
  10 sub usage ()
  11 {
  12     print STDERR <<"EOF";
  13 Usage: $0 index-filename [up-URL] < faq-document
  14
  15 URLs may be absolute or relative.
  16
  17 EOF
  18     exit 1;
  19 }
  20
  21 sub html_escape (\$)
  22 {
  23     my $line = shift;
  24     return unless defined $$line;
  25     $$line =~ s/\&/&amp;/g;
  26     $$line =~ s/</&lt;/g;
  27     $$line =~ s/>/&gt;/g;
  28     $$line =~ s/"/&quot;/g;
  29     $$line =~ s/æ/&aelig;/g;
  30     return $$line;
  31 }
  32
  33 #my $sts_link = "http://riva.ucam.org/~kamion/archive-bin/" .
  34 #               "article.pl?msgid=5n0qq5\$d9p\@mercury.dur.ac.uk";
  35 my $sts_link = 'http://groups.google.com/groups?' .
  36                'q=Easter+Egg&ic=1&selm=5n0qq5%24d9p%40mercury.dur.ac.uk';
  37
  38 # Paragraph to format and undefine, followed optionally by open and close tags.
  39 sub print_paragraph (\$;$$)
  40 {
  41     my $para = shift;
  42     return unless defined $$para && $$para !~ /^\s*$/;
  43     my $open_tags = shift;
  44     my $close_tags = shift;
  45
  46     # Make URLs links
  47     $$para =~ s#(http:(?:[^\ \&<]|\&(?!gt;))*)
  48                #<A TARGET="_top" HREF="$1">$1</A>#gx;
  49
  50     # Make all text within pairs of underscores outside URLs emphasized
  51     $$para =~ s[_((?:[^_.-])+\.?)_
  52                 (?![^"]*">|[^<]*</A>)][<EM>$1</EM>]gx;
  53
  54     # Similarly, strengthen bold text within asterisks
  55     $$para =~ s[\*((?:[^*.])+\.?)\*
  56                 (?![^"]*">|[^<]*</A>)][<STRONG>$1</STRONG>]gx;
  57
  58     # Easter egg
  59     $$para =~ s|(Sephrenia the Styric)|<A HREF="$sts_link">$1</A>|g;
  60
  61     $$para = "$open_tags$$para" if defined $open_tags;
  62     $$para .= $close_tags if defined $close_tags;
  63
  64     print "$$para\n";
  65     undef $$para;
  66 }
  67
  68 my $index_file = shift or usage;
  69 my $up_url = shift;
  70
  71 open CONTROL, ">control.html" or die "Can't write to control.html: $!";
  72 select CONTROL;
  73
  74 html_header "Revision information", $index_file;
  75 print "\n";
  76
  77 my $changes_done = 0;
  78
  79 print "<PRE>\n";
  80 while (<>)
  81 {
  82     $changes_done = 1 if (/^Archive-name:/);
  83     next unless $changes_done;
  84     chomp;
  85     html_escape $_;
  86     last if (/^\s*$/);
  87     unless (/^([^:]+:)\s*(.+)$/)
  88     {
  89         warn "Non-header line found in control section: $_";
  90         next;
  91     }
  92     print "$_\n";
  93 }
  94 print "</PRE>\n\n";
  95
  96 html_footer $index_file;
  97
  98 open INDEX, ">$index_file" or die "Can't write to $index_file: $!";
  99 select INDEX;
 100
 101 html_header "Contents", $up_url;
 102 print "\n";
 103
 104 print "<H1 ALIGN=\"center\">\n";
 105 while (<>)
 106 {
 107     last if /^\s*$/;
 108     html_escape $_;
 109     print;
 110 }
 111 print "</H1>\n\n";
 112
 113 print "<P><A HREF=\"control.html\">Revision information</A></P>\n";
 114
 115 my $paragraph;
 116 my $listentry = 0;
 117 my $level = 0;
 118 my @lastvalues = ();
 119
 120 while (<>)
 121 {
 122     chomp;
 123     s/^\s*//;
 124     html_escape $_;
 125     # Stop at TOC-body separator
 126     if (/--------/)
 127     {
 128         print_paragraph $paragraph, "", $listentry ? "</A>" : "";
 129         last;
 130     }
 131     # Convert headings to links
 132     my $line = $_;
 133     if ($line =~ /([0-9]+)((?:.[0-9]+)*)[\)\s]/)
 134     {
 135         my $firstcomp = $1;
 136         my $heading = "$1$2";
 137         my @components = split /\./, $heading;
 138         if (@components > 0)
 139         {
 140             $line =~ /\s+(.*)$/g;
 141             my $linetail = $1;
 142             print_paragraph $paragraph, "", $listentry ? "</A>" : "";
 143
 144             # Change level of ordered list if necessary
 145             if (@components > $level)
 146             {
 147                 print "<OL>\n" x (@components - $level);
 148             }
 149             elsif (@components < $level)
 150             {
 151                 print "</OL>\n" x ($level - @components);
 152             }
 153             #print "</P>\n\n" if @components == 1 && $level > 0;
 154             print "\n<BR>\n\n" if @components == 1 && $level > 0;
 155             $level = @components;
 156             $#lastvalues = $level;
 157             #print "<P>\n" if $level == 1;
 158
 159             # Reformat the current line
 160             my $value = $components[$#components];
 161             if (defined $lastvalues[$level] &&
 162                 $lastvalues[$level] + 1 != $value)
 163             {
 164                 warn "Missing item in contents before $heading";
 165                 print "<LI VALUE=\"$value\">";
 166             }
 167             elsif ($value != 1)
 168             {
 169                 print "<LI VALUE=\"$value\">";
 170             }
 171             else
 172             {
 173                 print "<LI>";
 174             }
 175             $lastvalues[$level] = $value;
 176             print "<A HREF=\"part$firstcomp.html#sec$heading\">\n";
 177             $paragraph = $linetail;
 178             $listentry = 1;
 179             next;
 180         }
 181     }
 182     elsif (/^[A-Z][^a-z]+$/)
 183     {
 184         print_paragraph $paragraph, "", $listentry ? "</A>" : "";
 185         if ($level == 0)
 186         {
 187             print "\n<H2>$_</H2>\n\n";
 188         }
 189         else
 190         {
 191             #print "</P>\n\n";
 192             print "</OL>\n\n" x ($level - 1);
 193             print "\n" if $level == 1;
 194             print "<H3>$_</H3>\n\n";
 195             print "<OL>\n" x ($level - 1);
 196             #print "<P>\n";
 197             $#lastvalues = 0;
 198         }
 199         $listentry = 0;
 200         next;
 201     }
 202     elsif (/^$/)
 203     {
 204         print_paragraph $paragraph, "", $listentry ? "</A>" : "";
 205         $listentry = 0;
 206         next;
 207     }
 208     print_paragraph $paragraph;
 209     $paragraph = $_;
 210 }
 211
 212 # Do all the necessary end tags
 213 #print "</P>\n" if $level > 0;
 214 print "\n<BR>\n" if $level > 0;
 215 print "\n";
 216 print "</OL>\n\n" x $level;
 217
 218 html_footer $up_url;
 219 select STDOUT;
 220 close INDEX;
 221
 222 $paragraph = <>;
 223 my $oldsection;
 224 my $section;
 225 my $section_open = 0;
 226 my $num_sections = $lastvalues[1];
 227 my $in_heading = 0;
 228 my $in_h2 = 0;
 229 $level = 0;
 230 $#lastvalues = -1;
 231
 232 my $heading_pat = qr/^\s*([0-9]+(?:.[0-9]+)*)\)\s+/;
 233
 234 while (<>)
 235 {
 236     s/\s+\n/\n/;
 237     html_escape $_;
 238
 239     if (/^\s*([0-9]+)\)\s/)
 240     {
 241         chomp $paragraph if defined $paragraph;
 242         if ($section_open)
 243         {
 244             if ($in_heading)
 245             {
 246                 print_paragraph $paragraph, "", "</STRONG></A>";
 247             }
 248             else
 249             {
 250                 print_paragraph $paragraph, "<P>\n", "\n</P>";
 251             }
 252         }
 253         $in_heading = $in_h2 = 0;
 254         $oldsection = $section;
 255         $section = $1;
 256         print "\n" if $section_open;
 257         print "</OL>\n\n" x $level if $section_open;
 258         html_footer $index_file,
 259                     ($oldsection > 1) ?
 260                         ("part" . ($oldsection - 1) . ".html") :
 261                         undef,
 262                     "part" . ($oldsection + 1) . ".html"
 263             if $section_open;
 264         open SECTION, ">part$section.html" or
 265             die "Couldn't write to part$section.html: $!";
 266         select SECTION;
 267         html_header "section $section",
 268                     $index_file,
 269                     "part" . ($section - 1) . ".html",
 270                     ($section < $num_sections) ?
 271                         ("part" . ($section + 1) . ".html") :
 272                         undef;
 273         $section_open = 1;
 274         $level = 0;
 275         $#lastvalues = -1;
 276     }
 277
 278     # Convert headings to anchors in list items
 279     if (/$heading_pat/)
 280     {
 281         my $heading = $1;
 282         my @components = split /\./, $heading;
 283         chomp $paragraph if defined $paragraph;
 284         if ($in_heading)
 285         {
 286             print_paragraph $paragraph, "", "</STRONG></A>\n";
 287         }
 288         else
 289         {
 290             print_paragraph $paragraph, "<P>\n", "\n</P>\n";
 291         }
 292         $in_h2 = 0;
 293
 294         # Change level of ordered list if necessary
 295         if (@components > $level)
 296         {
 297             print "<OL>\n\n" x (@components - $level);
 298         }
 299         elsif (@components < $level)
 300         {
 301             print "</OL>\n\n" x ($level - @components);
 302         }
 303         $level = @components;
 304         $#lastvalues = $level;
 305
 306         my $value = $components[$#components];
 307         if (@components == 1)
 308         {
 309             chomp;
 310             s|$heading_pat|<LI><H2><A NAME="sec$1">|;
 311             $in_h2 = 1;
 312         }
 313         elsif (defined $lastvalues[$level] &&
 314                $lastvalues[$level] + 1 != $value)
 315         {
 316             warn "Missing item in main document before $heading";
 317             s|$heading_pat|<LI VALUE="$value"><A NAME="sec$1"><STRONG>|;
 318         }
 319         elsif ($value != 1)
 320         {
 321             s|$heading_pat|<LI VALUE="$value"><A NAME="sec$1"><STRONG>|;
 322         }
 323         else
 324         {
 325             s|$heading_pat|<LI><A NAME="sec$1"><STRONG>|;
 326         }
 327         $lastvalues[$level] = $value;
 328
 329         warn "Heading $heading encountered outside a section"
 330             unless defined $section;
 331         warn "Heading $heading encountered in section $section"
 332             if defined $section && $heading !~ /^$section(?:\.|$)/;
 333
 334         $in_heading = 1;
 335     }
 336
 337     # Mark unnumbered headings
 338     if (/^([A-Z][^a-z]*[A-Z])\n/)
 339     {
 340         chomp;
 341         $paragraph = $_;
 342
 343         print "\n</OL>\n" x ($level - 1);
 344         print "\n" if $level != 1;
 345         print_paragraph $paragraph, "<H3>", "</H3>";
 346         $in_heading = $in_h2 = 0;
 347         print "\n<OL>\n" x ($level - 1);
 348         $#lastvalues = 0;
 349
 350         $_ = "";
 351     }
 352
 353     # If this is a paragraph delimiter of some kind (usually a blank line),
 354     # print the preceding paragraph, handling things we recognize as tables.
 355     if (defined $paragraph &&
 356         (/^\n/ || ($in_heading && $paragraph =~ /<A NAME[^>]*>.{0,40}$/)))
 357     {
 358         if (($paragraph =~ /ISBN +[0-9]-/ &&
 359              $paragraph =~ /\((?:hc|pb|trade pb)\)/)
 360             || $paragraph =~ /c\/o Del Rey Books/
 361             || $paragraph =~ /esper\.net$/m)
 362         {
 363             $paragraph =~ s/\n/<BR>\n/g;
 364         }
 365         else
 366         {
 367             # We have to split up the paragraph and work line-by-line here;
 368             # multi-line regexps are really hard to get right.
 369             my @parlines = split /\n/, $paragraph;
 370             my $prevline;
 371             foreach my $parline (@parlines)
 372             {
 373                 unless (defined $prevline)
 374                 {
 375                     $prevline = \$parline;
 376                     next;
 377                 }
 378                 if ($parline =~ /^(\s*)((?:\w\)|
 379                                  \[\w\]|
 380                                  \w+(?:\s+\w+)?:\s*http).*|
 381                                  \&lt;http(?:[^&]|\&(?!gt;))*\&gt;)$/x)
 382                 {
 383                     $parline = "$1$2<BR>";
 384                     $$prevline .= "<BR>" if $$prevline !~ /<BR>$/;
 385                 }
 386                 $prevline = \$parline;
 387             }
 388             $paragraph = (join "\n", @parlines) . "\n";
 389             $paragraph =~ s/:$/:<BR>/gm;
 390         }
 391         chomp $paragraph;
 392         $paragraph =~ s/(\S)  +/$1 /g unless /<BR>/;
 393         if ($in_h2)
 394         {
 395             print_paragraph $paragraph, "", "</A></H2>\n";
 396             $in_h2 = 0;
 397         }
 398         else
 399         {
 400             if ($in_heading)
 401             {
 402                 print_paragraph $paragraph, "", "</STRONG></A>";
 403             }
 404             else
 405             {
 406                 print_paragraph $paragraph, "<P>\n", "\n</P>";
 407             }
 408         }
 409         $in_heading = 0;
 410         $paragraph = "$_" unless /^\n?$/;
 411     }
 412     elsif (defined $paragraph)
 413     {
 414         $paragraph .= "$_";
 415     }
 416     else
 417     {
 418         $paragraph = "$_" unless /^\n?$/;
 419     }
 420 }
 421
 422 if ($section_open)
 423 {
 424     chomp $paragraph if defined $paragraph;
 425     if ($in_heading)
 426     {
 427         print_paragraph $paragraph, "", "</STRONG></A>";
 428     }
 429     else
 430     {
 431         print_paragraph $paragraph, "<P>\n", "\n</P>";
 432     }
 433     print "\n";
 434     print "</OL>\n\n" x $level;
 435
 436     html_footer $index_file,
 437                 ($section > 1) ? ("part" . ($section - 1) . ".html") : undef,
 438                 undef;
 439     close SECTION if $section_open;
 440 }
 441 else
 442 {
 443     warn "No sections encountered";
 444 }
 445