#!/usr/bin/perl
# Filename:	make_faq
# Author:	David Ljung Madison <DaveSource.com>
# See License:  http://MarginalHacks.com/License
  my $VERSION=  1.06;
# Description:	Convert a list of questions/sections to an HTML FAQ-like thingy
#
# Faq-maker, faq-maker, make me a faq.  Ask me an ask.  faq me a faq...
use strict;

umask 022;

my $PROGNAME = $0;
$PROGNAME =~ s|.*/||;

my $MARG = "http://MarginalHacks.com/";
my $URL = "${MARG}Hacks/make_faq/";

my $CONF	= "conf";
my %CONF;

my $DIFF	= "diff";

my $MADE_BY = "<p><font size='-1'><li> Created by <a href='$URL'>$PROGNAME</a> from <a href='$MARG'>Marginal Hacks</a></font><p>";

##################################################
# Read a configuration file
##################################################
sub read_conf {
  open(CONF,"<$CONF") || die("Couldn't read config file\n");
  while(<CONF>) {
    s/#.*//;	# Ignore comments
    next if (/^\s*$/);
    
    # var = "value"	<- value can be multiple lines if quotes are used
    my $var;
    if (/^\s*(\S+)\s*=\s*(["']?)/) {
      $var=$1;
      my ($quote,$line,$read) = ("$2;?",$.,$');
      while ($read !~ /(.*)$quote$/) {
        $CONF{$var}.=$read;
        die("Runaway quote [$quote] in conf file [$CONF, line $line]\n")
          unless ($read = <CONF>);
        #print "CONF: $read";
      }
      $read =~ /(.*)$quote$/;	# while () doesn't set it first pass :(
      # Tad kludgy, but simple
      $CONF{$var}.=$1;
      $CONF{$var} =~ s/include_file\(([^\)]+)\)/`cat $1`/eg;
    } else {
      die("Couldn't understand configuration line $. [$CONF]\n");
    }
  }
  close(CONF);
}

sub get_conf {
  my ($var,$optional,$replacements,$loop) = @_;
  my $val = $CONF{$var};

  # Expand 'conf(text)'

  return $val if ($loop>20);	# Avoid infinite loops

  $val =~ s/conf\(([^\)]+)\)/get_conf($1,0,$replacements,$loop+1)/eg;

  # Handle '$OTHER' in 'Long_Header, Long_Footer, etc..'
  if (!$loop && $var =~ /^(Long|Short)/) {
    my $other = $1 eq "Long" ? "Short" : "Long";
    $val =~ s/\$OTHER_HTML/get_conf("${other}_Index")/eg;
    $val =~ s/\$OTHER/$other/g;
  }

  # Do replacements
  foreach my $rep ( @$replacements ) {
    my ($s,$r) = @$rep;
    $val =~ s/$s/$r/mg;
  }

  # SPACE_OUT(text)
  $val =~ s/SPACE_OUT\(([^\)]+)\)/space_out($1)/eg;

  return $val if defined $val;
  return undef if ($optional);
  die("Couldn't find [$var] in configuration file [$CONF]\n");
}

##################################################
# HTML stuff
##################################################
sub html {
  return $_[0];	# Unneeded - most of it is in <pre> anyways..

  $_[0] =~ s/\&/&amp;/g;
  if ($_[0] !~ /<a href/) {	# Kludge
    $_[0] =~ s/</&lt;/g;
    $_[0] =~ s/>/&gt;/g;
  }
  $_[0];
}

sub strip_href {
  my ($str) = @_;
  return $str unless ($str =~ /^(.*)<a href=[^>]+>(.*)<\/a>(.*)$/);
  return strip_href("$1$2$3");
}

sub space_out {
  my ($a) = @_;
  $a =~ s/(.)/$1&nbsp;/g;
  $a;
}

# 1 -> one, 2 -> two, 456123400000 -> four hundred fifty six billion one hundred twenty three million four hundred  thousand zero
# A little buggy for the bigger numbers...
sub numify {
  my ($num,$post) = @_;
  return $post if (!$num && $post);
  return (qw(zero one two three four five six seven eight nine))[$num].$post
    if ($num<10);
  return (qw(ten eleven twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen))[$num-10].$post
    if ($num<20);
  return (qw(twenty thirty forty fifty sixty seventy eighty ninety))[int($num/10)-2]." ".numify($num-int($num/10)*10,$post)
    if ($num<100);
  return numify(int($num/100)," hundred ").numify($num-int($num/100)*100,$post)
    if ($num<1000);
  return numify(int($num/1000)," thousand ").numify($num-int($num/1000)*1000,$post)
    if ($num<1000000);
  return numify(int($num/1000000)," million ").numify($num-int($num/1000000)*1000000,$post)
    if ($num<10000000000);
  return numify(int($num/1000000000)," billion ").numify($num-int($num/1000000000)*1000000000,$post);
}

sub mv_if_changed {
  my ($new,$old) = @_;
  system("$DIFF \Q$new\E \Q$old\E > /dev/null 2>&1");
  if ($?) {
    rename($new, $old) || print STDERR "WARNING: Couldn't mv: $old -> $new\n";
  } else {
    unlink($new);
  }
}

sub make_section {
  my ($section) = @_;

  my $new_chunk = get_conf("New_Chunk",1) || "q:";

  open(IN,"<$section") || die("Couldn't read [$section]\n");

  my $num=$1 if ($section =~ /(\d+)/);
  return print STDERR "[WARNING] Need a section number? [$section]\n"
    unless $num;

  my (@contents,$toc,@text);

  my $out="Section_$num.html";
  open(OUT,">$out.new") || die("Couldn't write output [$out]\n");
  my $topic=<IN>;
  $topic=html($topic);
  $toc .= "<li value=$num><a href='$out'>$topic</a>\n<ol>\n";
  my $n = 1;
  while(<IN>) {
    if (/^$new_chunk\s+(.*)/) {
      my $line=$1; $line=html($line);
      my $name=$line;
      my $strip_line = strip_href($line);
      $name =~ s/'//g;
      $name =~ s/[\s\/]/_/g;
      $name =~ s/<[^>]+>//g;
      $name =~ s/[\?\!]//g;
      $name =~ s/^_+//; $name =~ s/_+$//;
      push(@contents,"<li> <a href='#$name'>$strip_line</a>\n");
      $toc .= "<li><a href='$out#$name'>$strip_line</a>\n";
      $a=sprintf("<a name='$name'>%-9s","$n:</a>");
      $_="<b>$a$line</b>\n";
      $n++;
      push(@text,$_);
    } else {
      push(@text,html($_));
    }
  }
  close IN;

  # Replacement strings
  my $number = ucfirst(numify($num));
  my $replace = [['\$NUMBER',$number], ['\$TOPIC',$topic], ['\$OUT',$out]];

  my $header = get_conf("Header",0,$replace);
  my $TOC = get_conf("Table_Of_Contents",1,$replace) || "Table Of Contents";

  print OUT $header;

  print OUT "\n<p><hr><p>\n";
  print OUT "<a href='.'>$TOC</a>\n";
  print OUT "<ol>@contents</ol><p><hr><p>\n\n";
  print OUT "\n<pre>\n";
  print OUT @text,"\n";
  print OUT "</pre>\n";
  print OUT $MADE_BY;
  print OUT get_conf("Footer",1,$replace);
  print OUT "<pre>\n";
  print OUT "\n     ^\n     |\n"x20;
  print OUT "</pre>\n";
  close(OUT);

  # Only write file if it's changed
  mv_if_changed("$out.new",$out);

  $toc .= "</ol>\n";

  return ($out, $num, $topic, $toc);
}

#########################
sub main {
  read_conf();
  my (@made,@num,@topics,$toc);

  # Read and handle all the text sections
  my $glob=get_conf("Text_Files");
  foreach my $txt ( glob($glob) ) {
    my ($made, $num, $topic, $newtoc) = make_section($txt);
    push(@made,$made);
    push(@num,$num);
    push(@topics,$topic);
    $toc .= $newtoc;
  }
  print "MADE: @made\n";

  # Write the short and long indexes
  my $index = get_conf("Short_Index",1);
  my $replace = [['\$TOPIC',"Short Index"], ['\$OUT',$index]];
  if ($index) {
    open(INDEX,">$index.new") || die("[$PROGNAME] Error:  Couldn't write [$index]\n");
    print INDEX get_conf("Short_Header",0,$replace);
    print INDEX "<ol>\n";
    for(my $i=0; $i<=$#topics; $i++) {
      print INDEX "<li value=$num[$i]> <a href='$made[$i]'>$topics[$i]</a>\n";
    }
    print INDEX "</ol>\n";
    print INDEX $MADE_BY;
    print INDEX get_conf("Short_Footer",1,$replace);
    close(INDEX);
    mv_if_changed("$index.new",$index);
  }

  my $index = get_conf("Long_Index",1,$replace);
  my $replace = [['\$TOPIC',"Long Index"], ['\$OUT',$index]];
  if ($index) {
    open(INDEX,">$index.new") || die("[$PROGNAME] Error:  Couldn't write [$index]\n");
    print INDEX get_conf("Long_Header",0,$replace);
    print INDEX "<ol>\n$toc\n</ol>\n";
    print INDEX $MADE_BY;
    print INDEX get_conf("Long_Footer",1,$replace);
    close(INDEX);
    mv_if_changed("$index.new",$index);
  }

} main();