#! /usr/bin/perl

=pod
This is a silly little program for generating the libc FAQ.

The input format is:
top boilerplate
^L
? section name (one line)
?? question...
...
{ID} answer...
...
^L
{ID} name <email@address>
...

which gets mapped to:

top boilerplate
^L
1. section 1...
1.1. q1.1
1.2. q1.2
...
^L
1. section 1...

1.1. q1.1

answer 1.1....


^L
Answers were provided by:
...

=cut

# We slurp the whole file into a pair of assoc arrays indexed by
# the 'section.question' number.
%questions = ();
%answers = ();
$question = 0;

# These arrays and counter keep track of the sections.
@sectcount = ();
@sections = ();
$section = 0;

# Cross reference list.
%refs = ();

# Separators.
$sepmaj = "<p><hr>\n";
$sepmin = "<p><hr>\n";

print "<html>\n",
  "<head>\n",
  "<title>Frequently Asked Questions about the GNU C Library </title>\n",
  "</head>\n",
  "<body text=\"#000000\" bgcolor=\"white\" link=\"#0000EE\" vlink=\"#551A8B\" alink=\"#FF0000\">\n";


# Pass through the top boilerplate.
while(<>)
{
  if (/Frequently Asked Questions about the GNU C Library/) {
    print "<h1>Frequently Asked Questions about the GNU C Library</h1>\n";
  }
  print '<p>' if $_ eq "\n";
  last if $_ eq "\f\n";
  $_ = escapeHTML ($_);
  # Hack
  s/--drepper\@cygnus.com/--<a href="mailto:drepper\@cygnus.com">drepper\@cygnus.com<\/a>/;
  print ;
}

# Now the body.
while(<>)
{
    /\f/ && do
    {
	$sectcount[$section] = $question;
	last;
    };

    s/^\?\s+// && do
    {
	chomp;
	$sectcount[$section] = $question if $section > 0;
	$section++;
	$sections[$section] = $_;
	$question = 0;
	next;
    };
    s/^\?\?(\w*?)\s+// && do
    {
	$cur = \%questions;
	$question++;
	$questions{$section,$question} = $_;
	$refs{$1} = "$section.$question" if $1 ne "";
	next;
    };
    /^\{/ && do
    {
	$cur = \%answers;
	$answers{$section,$question} .= $_;
	next;
    };

    ${$cur}{$section,$question} .= $_;
}

# Now we have to clean up the newlines and deal with cross references.
foreach(keys %questions) 
  { 
    $questions{$_} =~ s/\n+$//; 
    $questions{$_} = escapeHTML ($questions{$_});
  }
foreach(keys %answers)
{
  $answers{$_} = escapeHTML ($answers{$_});

  $answers{$_} =~ s/\n+$//;
  $answers{$_} =~ /(\s)\?(\w+)\b/;
  $answers{$_} =~ s/(&lt;)?(http:\/\/[^& ]+)(&gt;)?/<a href=\2>\2<\/a>/g;
  $answers{$_} =~ s/&lt;(ftp:\/\/[^& ]+)&gt;/<a href=\1>\1<\/a>/g;
#    $answers{$_} =~ s/(http:\/\/\S+)/<a href=\1>\1<\/a>/g;
  if (exists $refs{$2}) {
    $answers{$_} =~ s/(\s)\?(\w+)\b/$1 . "question <a href=\"#s-" . $refs{$2} . "\">" . $refs{$2} . "<\/a>" /eg;
  } else {
    $answers{$_} =~ s/(\s)\?(\w+)\b/$1 . "question" . (badref($2,$_), "!!$2")/eg;
  }
}

# Now output the formatted FAQ.
# Table of contents
print $sepmaj;
for($i = 1; $i <= $section; $i++)
{
    print "<a href=\"#s-$i\"> $i. $sections[$i]</a>\n\n";
    print "<p>\n";
    for($j = 1; $j <= $sectcount[$i]; $j++)
    {
	print "<a href=\"#s-$i.$j\"> $i.$j. $questions{$i,$j}</a>\n";
	print "<p>\n";
    }
    print "\n";
}

# Q&A
print $sepmaj;
for($i = 1; $i <= $section; $i++)
{
    print "<h3><a name=\"s-$i\"> $i.</a> $sections[$i]</h3>\n\n";
    for($j = 1; $j <= $sectcount[$i]; $j++)
    {
	print "<h4><a name=\"s-$i.$j\">$i.$j.</a> $questions{$i,$j}</h4>\n\n";
	&output_answer ($answers{$i,$j});
	#	print $answers{$i,$j}, "<p>\n\n";
	print "\n" if $j < $sectcount[$i];
    }
    print $sepmin if $i < $section;
}

print $sepmaj;

# Pass through the trailer.
@trailer = <>;
$trailer = join ('', @trailer);
$trailer =~ s/Local Variables:.*End://s;
$trailer =~ s/\f//g;
$trailer = &escapeHTML ($trailer);
$trailer =~ s/\n/<br>\n/gs;
print $trailer;


$date = localtime (time);
print "<hr>
Please note that the original version doesn't use HTML and this page is generated 
automatically with a simple script to just add a few HTML tags.
I know that the HTML is not perfect. <p>
    <address><a href=\"mailto:aj\@suse.de\">Andreas Jaeger</a></address>
Last modified: $date
  </body>
</html>";

sub badref
{
    my($ref,$quest) = @_;
    $quest =~ s/$;/./;
    print STDERR "Undefined reference to $ref in answer to Q$quest\n";
}

sub escapeHTML 
{
  my($toencode) = @_;
  return undef unless defined($toencode);
  
  $toencode=~s/&/&amp;/g;
  $toencode=~s/\"/&quot;/g;
  $toencode=~s/>/&gt;/g;
  $toencode=~s/</&lt;/g;
  #&lt;<a href="mailto:geoffk@ozemail.com.au">geoffk@ozemail.com.au</a>&gt;
  $toencode=~ s/&lt;(.*@.*)&gt;/&lt;<a href="mailto:$1">$1<\/a>&gt;/g;
  return $toencode;
}

sub output_answer 
{
  my ($answer) = @_;
  my (@lines) = split (/\n/,$answer);
  my ($pre) = 0;
  my ($item) = 0;
  my ($code) = 0;

  foreach (@lines) {
    if (/^\s*$/) {
      # empty lines
      if ($pre) {
	print "</pre>";
	$pre = 0;
      }
      print "<p>\n";
      next;
    }
    # Special treatment
    if (/^(passwd|group|shadow).*:.*(compat|nis)$/) {
      unless ($pre) {
	print "<pre>";
	$pre = 1;
      }
      print "$_\n";
      next;
    }
    # Handling of sed script in Q 2.10
    if (/^\#/ || /^\/\^/ || /^\}$/) {
      unless ($pre) {
	print "<pre>";
	$pre = 1;
      }
      print "$_\n";
      next;
    }
    if (/^~{50,}/) {
      unless ($code) {
	print "<pre>\n" if (!$pre);
	print "$_\n";
	$pre = 1;
	$code = 1;
      }
      else {
	print "$_\n";
	print "</pre>\n";
	$pre = 0;
	$code = 0;
      }
      next;
    }
    if (/^\s{3,}/ || (/^\s/ && !$item) || /^~{50,}/) {
      unless ($pre) {
	print "<pre>";
	$pre = 1;
      }
    } elsif ($pre && !$code) {
      print "</pre>";
      $pre = 0;
    }
    # itemize
    if (/^[*-]\s/) {
      print "<ul>\n" unless $item;
      $item = 1;
      s /^[*-]/<li> /;
    } elsif ($item && ! /^\s/) {
      $item = 0;
      print "</ul>\n";
    }
    if (/^-*$/) {
      print "<hr>\n";
      next;
    }
    print "$_\n";
    if (/^\#/) {
      print "<p>";
    }
  }
  print "</ul>\n" if $item;
  print "</pre>\n" if $pre;
}
