+#! /usr/bin/perl -w
+use strict;
+require 5.000;
+use lib qw(.);
+use Style qw(html_header html_footer);
+
+# The AFE FAQ HTMLizer
+# Perl version written by Kamion; based on a sed script by Aquarius
+
+sub usage ()
+{
+ print STDERR <<"EOF";
+Usage: $0 index-filename [up-URL] < faq-document
+
+URLs may be absolute or relative.
+
+EOF
+ exit 1;
+}
+
+sub html_escape (\$)
+{
+ my $line = shift;
+ return unless defined $$line;
+ $$line =~ s/\&/&/g;
+ $$line =~ s/</</g;
+ $$line =~ s/>/>/g;
+ $$line =~ s/"/"/g;
+ $$line =~ s/æ/æ/g;
+ return $$line;
+}
+
+#my $sts_link = "http://riva.ucam.org/~kamion/archive-bin/" .
+# "article.pl?msgid=5n0qq5\$d9p\@mercury.dur.ac.uk";
+my $sts_link = 'http://groups.google.com/groups?' .
+ 'q=Easter+Egg&ic=1&selm=5n0qq5%24d9p%40mercury.dur.ac.uk';
+
+# Paragraph to format and undefine, followed optionally by open and close tags.
+sub print_paragraph (\$;$$)
+{
+ my $para = shift;
+ return unless defined $$para && $$para !~ /^\s*$/;
+ my $open_tags = shift;
+ my $close_tags = shift;
+
+ # Make URLs links
+ $$para =~ s#(http:(?:[^\ \&<]|\&(?!gt;))*)
+ #<A TARGET="_top" HREF="$1">$1</A>#gx;
+
+ # Make all text within pairs of underscores outside URLs emphasized
+ $$para =~ s[_((?:[^_.-])+\.?)_
+ (?![^"]*">|[^<]*</A>)][<EM>$1</EM>]gx;
+
+ # Similarly, strengthen bold text within asterisks
+ $$para =~ s[\*((?:[^*.])+\.?)\*
+ (?![^"]*">|[^<]*</A>)][<STRONG>$1</STRONG>]gx;
+
+ # Easter egg
+ $$para =~ s|(Sephrenia the Styric)|<A HREF="$sts_link">$1</A>|g;
+
+ $$para = "$open_tags$$para" if defined $open_tags;
+ $$para .= $close_tags if defined $close_tags;
+
+ print "$$para\n";
+ undef $$para;
+}
+
+my $index_file = shift or usage;
+my $up_url = shift;
+
+open CONTROL, ">control.html" or die "Can't write to control.html: $!";
+select CONTROL;
+
+html_header "Revision information", $index_file;
+print "\n";
+
+my $changes_done = 0;
+
+print "<PRE>\n";
+while (<>)
+{
+ $changes_done = 1 if (/^Archive-name:/);
+ next unless $changes_done;
+ chomp;
+ html_escape $_;
+ last if (/^\s*$/);
+ unless (/^([^:]+:)\s*(.+)$/)
+ {
+ warn "Non-header line found in control section: $_";
+ next;
+ }
+ print "$_\n";
+}
+print "</PRE>\n\n";
+
+html_footer $index_file;
+
+open INDEX, ">$index_file" or die "Can't write to $index_file: $!";
+select INDEX;
+
+html_header "Contents", $up_url;
+print "\n";
+
+print "<H1 ALIGN=\"center\">\n";
+while (<>)
+{
+ last if /^\s*$/;
+ html_escape $_;
+ print;
+}
+print "</H1>\n\n";
+
+print "<P><A HREF=\"control.html\">Revision information</A></P>\n";
+
+my $paragraph;
+my $listentry = 0;
+my $level = 0;
+my @lastvalues = ();
+
+while (<>)
+{
+ chomp;
+ s/^\s*//;
+ html_escape $_;
+ # Stop at TOC-body separator
+ if (/--------/)
+ {
+ print_paragraph $paragraph, "", $listentry ? "</A>" : "";
+ last;
+ }
+ # Convert headings to links
+ my $line = $_;
+ if ($line =~ /([0-9]+)((?:.[0-9]+)*)[\)\s]/)
+ {
+ my $firstcomp = $1;
+ my $heading = "$1$2";
+ my @components = split /\./, $heading;
+ if (@components > 0)
+ {
+ $line =~ /\s+(.*)$/g;
+ my $linetail = $1;
+ print_paragraph $paragraph, "", $listentry ? "</A>" : "";
+
+ # Change level of ordered list if necessary
+ if (@components > $level)
+ {
+ print "<OL>\n" x (@components - $level);
+ }
+ elsif (@components < $level)
+ {
+ print "</OL>\n" x ($level - @components);
+ }
+ #print "</P>\n\n" if @components == 1 && $level > 0;
+ print "\n<BR>\n\n" if @components == 1 && $level > 0;
+ $level = @components;
+ $#lastvalues = $level;
+ #print "<P>\n" if $level == 1;
+
+ # Reformat the current line
+ my $value = $components[$#components];
+ if (defined $lastvalues[$level] &&
+ $lastvalues[$level] + 1 != $value)
+ {
+ warn "Missing item in contents before $heading";
+ print "<LI VALUE=\"$value\">";
+ }
+ elsif ($value != 1)
+ {
+ print "<LI VALUE=\"$value\">";
+ }
+ else
+ {
+ print "<LI>";
+ }
+ $lastvalues[$level] = $value;
+ print "<A HREF=\"part$firstcomp.html#sec$heading\">\n";
+ $paragraph = $linetail;
+ $listentry = 1;
+ next;
+ }
+ }
+ elsif (/^[A-Z][^a-z]+$/)
+ {
+ print_paragraph $paragraph, "", $listentry ? "</A>" : "";
+ if ($level == 0)
+ {
+ print "\n<H2>$_</H2>\n\n";
+ }
+ else
+ {
+ #print "</P>\n\n";
+ print "</OL>\n\n" x ($level - 1);
+ print "\n" if $level == 1;
+ print "<H3>$_</H3>\n\n";
+ print "<OL>\n" x ($level - 1);
+ #print "<P>\n";
+ $#lastvalues = 0;
+ }
+ $listentry = 0;
+ next;
+ }
+ elsif (/^$/)
+ {
+ print_paragraph $paragraph, "", $listentry ? "</A>" : "";
+ $listentry = 0;
+ next;
+ }
+ print_paragraph $paragraph;
+ $paragraph = $_;
+}
+
+# Do all the necessary end tags
+#print "</P>\n" if $level > 0;
+print "\n<BR>\n" if $level > 0;
+print "\n";
+print "</OL>\n\n" x $level;
+
+html_footer $up_url;
+select STDOUT;
+close INDEX;
+
+$paragraph = <>;
+my $oldsection;
+my $section;
+my $section_open = 0;
+my $num_sections = $lastvalues[1];
+my $in_heading = 0;
+my $in_h2 = 0;
+$level = 0;
+$#lastvalues = -1;
+
+my $heading_pat = qr/^\s*([0-9]+(?:.[0-9]+)*)\)\s+/;
+
+while (<>)
+{
+ s/\s+\n/\n/;
+ html_escape $_;
+
+ if (/^\s*([0-9]+)\)\s/)
+ {
+ chomp $paragraph if defined $paragraph;
+ if ($section_open)
+ {
+ if ($in_heading)
+ {
+ print_paragraph $paragraph, "", "</STRONG></A>";
+ }
+ else
+ {
+ print_paragraph $paragraph, "<P>\n", "\n</P>";
+ }
+ }
+ $in_heading = $in_h2 = 0;
+ $oldsection = $section;
+ $section = $1;
+ print "\n" if $section_open;
+ print "</OL>\n\n" x $level if $section_open;
+ html_footer $index_file,
+ ($oldsection > 1) ?
+ ("part" . ($oldsection - 1) . ".html") :
+ undef,
+ "part" . ($oldsection + 1) . ".html"
+ if $section_open;
+ open SECTION, ">part$section.html" or
+ die "Couldn't write to part$section.html: $!";
+ select SECTION;
+ html_header "section $section",
+ $index_file,
+ "part" . ($section - 1) . ".html",
+ ($section < $num_sections) ?
+ ("part" . ($section + 1) . ".html") :
+ undef;
+ $section_open = 1;
+ $level = 0;
+ $#lastvalues = -1;
+ }
+
+ # Convert headings to anchors in list items
+ if (/$heading_pat/)
+ {
+ my $heading = $1;
+ my @components = split /\./, $heading;
+ chomp $paragraph if defined $paragraph;
+ if ($in_heading)
+ {
+ print_paragraph $paragraph, "", "</STRONG></A>\n";
+ }
+ else
+ {
+ print_paragraph $paragraph, "<P>\n", "\n</P>\n";
+ }
+ $in_h2 = 0;
+
+ # Change level of ordered list if necessary
+ if (@components > $level)
+ {
+ print "<OL>\n\n" x (@components - $level);
+ }
+ elsif (@components < $level)
+ {
+ print "</OL>\n\n" x ($level - @components);
+ }
+ $level = @components;
+ $#lastvalues = $level;
+
+ my $value = $components[$#components];
+ if (@components == 1)
+ {
+ chomp;
+ s|$heading_pat|<LI><H2><A NAME="sec$1">|;
+ $in_h2 = 1;
+ }
+ elsif (defined $lastvalues[$level] &&
+ $lastvalues[$level] + 1 != $value)
+ {
+ warn "Missing item in main document before $heading";
+ s|$heading_pat|<LI VALUE="$value"><A NAME="sec$1"><STRONG>|;
+ }
+ elsif ($value != 1)
+ {
+ s|$heading_pat|<LI VALUE="$value"><A NAME="sec$1"><STRONG>|;
+ }
+ else
+ {
+ s|$heading_pat|<LI><A NAME="sec$1"><STRONG>|;
+ }
+ $lastvalues[$level] = $value;
+
+ warn "Heading $heading encountered outside a section"
+ unless defined $section;
+ warn "Heading $heading encountered in section $section"
+ if defined $section && $heading !~ /^$section(?:\.|$)/;
+
+ $in_heading = 1;
+ }
+
+ # Mark unnumbered headings
+ if (/^([A-Z][^a-z]*[A-Z])\n/)
+ {
+ chomp;
+ $paragraph = $_;
+
+ print "\n</OL>\n" x ($level - 1);
+ print "\n" if $level != 1;
+ print_paragraph $paragraph, "<H3>", "</H3>";
+ $in_heading = $in_h2 = 0;
+ print "\n<OL>\n" x ($level - 1);
+ $#lastvalues = 0;
+
+ $_ = "";
+ }
+
+ # If this is a paragraph delimiter of some kind (usually a blank line),
+ # print the preceding paragraph, handling things we recognize as tables.
+ if (defined $paragraph &&
+ (/^\n/ || ($in_heading && $paragraph =~ /<A NAME[^>]*>.{0,40}$/)))
+ {
+ if (($paragraph =~ /ISBN +[0-9]-/ &&
+ $paragraph =~ /\((?:hc|pb|trade pb)\)/)
+ || $paragraph =~ /c\/o Del Rey Books/
+ || $paragraph =~ /esper\.net$/m)
+ {
+ $paragraph =~ s/\n/<BR>\n/g;
+ }
+ else
+ {
+ # We have to split up the paragraph and work line-by-line here;
+ # multi-line regexps are really hard to get right.
+ my @parlines = split /\n/, $paragraph;
+ my $prevline;
+ foreach my $parline (@parlines)
+ {
+ unless (defined $prevline)
+ {
+ $prevline = \$parline;
+ next;
+ }
+ if ($parline =~ /^(\s*)((?:\w\)|
+ \[\w\]|
+ \w+(?:\s+\w+)?:\s*http).*|
+ \<http(?:[^&]|\&(?!gt;))*\>)$/x)
+ {
+ $parline = "$1$2<BR>";
+ $$prevline .= "<BR>" if $$prevline !~ /<BR>$/;
+ }
+ $prevline = \$parline;
+ }
+ $paragraph = (join "\n", @parlines) . "\n";
+ $paragraph =~ s/:$/:<BR>/gm;
+ }
+ chomp $paragraph;
+ $paragraph =~ s/(\S) +/$1 /g unless /<BR>/;
+ if ($in_h2)
+ {
+ print_paragraph $paragraph, "", "</A></H2>\n";
+ $in_h2 = 0;
+ }
+ else
+ {
+ if ($in_heading)
+ {
+ print_paragraph $paragraph, "", "</STRONG></A>";
+ }
+ else
+ {
+ print_paragraph $paragraph, "<P>\n", "\n</P>";
+ }
+ }
+ $in_heading = 0;
+ $paragraph = "$_" unless /^\n?$/;
+ }
+ elsif (defined $paragraph)
+ {
+ $paragraph .= "$_";
+ }
+ else
+ {
+ $paragraph = "$_" unless /^\n?$/;
+ }
+}
+
+if ($section_open)
+{
+ chomp $paragraph if defined $paragraph;
+ if ($in_heading)
+ {
+ print_paragraph $paragraph, "", "</STRONG></A>";
+ }
+ else
+ {
+ print_paragraph $paragraph, "<P>\n", "\n</P>";
+ }
+ print "\n";
+ print "</OL>\n\n" x $level;
+
+ html_footer $index_file,
+ ($section > 1) ? ("part" . ($section - 1) . ".html") : undef,
+ undef;
+ close SECTION if $section_open;
+}
+else
+{
+ warn "No sections encountered";
+}
+