#!/usr/bin/perl
#
# Script to convert Exim FAQ into wiki markup - moin flavour
#
use strict;
use integer;
use bytes;
use Data::Dumper;
use IO::File;

sub mkwikiname (@) {
    my @in = @_;

    my @bits;
    foreach my $str (@in) {
	$str =~ tr/0-9A-Za-z _//cd;
	push(@bits, $str);
    }
    return join('/', @bits);
}



sub mkwikifilename ($) {
    my $wn = shift;

    $wn =~ s/([^A-Za-z0-9])/sprintf("_%02x",ord($1))/eg;

    return $wn;
}



sub format_wiki_question_header ($) {
    my $lp = shift;

    my @lines = @{$lp};
    my $i;
    for($i =0; ($i <= $#lines); $i++) {
	unless (defined($lines[$i])) {
	    splice(@lines, $i);
	    last;
	}
	$lines[$i] =~ s/^\s+//;
    }
    return('= ' . join(' ', @lines) . ' =');
}



sub wikiref ($$) {
    my $meta = shift;
    my $qref = shift;

    my $qtag = $meta->qtags->{$qref};
    unless ($qtag) {
	warn "Unknown qtag $qref\n";
	return $qref;
    }

    return join(':', '[', $qref->{wikiname}, $qref . ']');
}



sub wiki_markup ($$) {
    my $meta = shift;
    my $s = shift;

    $s =~ s/@\\/\@\@backslash\@\@/g;		# @\ temporarily hidden

    $s =~ s/\\#/ /g;				 # \# is a hard space

    $s =~ s/\\\*\*([^*]*)\*\*\\/'''$1'''/g;	# \**...**\   => bold
    $s =~ s/\\\*([^*]*)\*\\/''$1''/g;		# \*.....*\   => italic
    $s =~ s/\\"([^"]*)"\\/`$1`/g;		# \"....."\   => fixed pitch
    $s =~ s/\\\$([^\$]*)\$\\/''\$$1''/g;	# \$.....$\   => $italic
    $s =~ s/\\\\([^\\]*)\\\\/<small>$1<\/small>/g; # \\.....\\   => small
    $s =~ s/\\\(([^)]*)\)\\/''$1''/g;		# \(.....)\   => italic
    $s =~ s/\\-([^\\]*)-\\/'''-$1'''/g;		# \-.....-\   => -bold
    $s =~ s/\\\[([^]]*)\]\\/''$1''/gx;		# \[.....]\   => <italic>
    $s =~ s/\\\?(.*?)\?\\/$1/g;			# \?.....?\   => URL
    $s =~ s/\\\^\^([^^]*)\^\^\\/''$1''/g;	# \^^...^^\   => italic
    $s =~ s/\\\^([^^]*)\^\\/''$1''/g;		# \^.....^\   => italic
    $s =~ s/\\%([^%]*)%\\/'''$1'''/g;		# \%.....%\   => bold
    $s =~ s/\\\/([^\/]*)\/\\/''$1''/g;		# \/...../\   => italic
    $s =~ s/\\([^\\]+)\\/`$1`/g;		# \.......\   => fixed pitch

    $s =~ s"//([^/\"]*)//"''$1</i>"g;		# //.....//   => italic
    $s =~ s/::([^:]*)::/''$1:''/g;		# ::.....::   => italic:

    $s =~ s/``(.*?)''/&#147;$1&#148;/g;                	  # ``.....''   => quoted text

    #$s =~ s/\s*\[\[br\]\]\s*/<br>/g;		# [[br]]      => <br>

    $s =~ s/\@\@backslash\@\@/\\/g;			# Put back single backslash

    $s =~ s/^(\s*\(\d\)\s)/$1&nbsp;/;		# Extra space after (1), etc.

    # Cross references within paragraphs

    $s =~ s/Q(\d{4})(?!:)/wikiref($meta, $1)/xg;

    # References to configuration samples

    ##$s =~ s/\b([CFLS]\d\d\d)\b/<a href="$1.txt">$1<\/a>/g;

    # Remove white space preceding a newline in the middle of paragraphs,
    # to keep the file smaller (and for human reading when debugging).

    ##$s =~ s/^\s+//mg;

    return $s;
}



sub clip_paragraph ($) {
    my $lines = shift;

    my $ret;
    my $flags;
    my $offlen;

    # split off and throw initial para breaks
    while (($#{$lines} >= 0) && (!defined($lines->[0]))) {
	shift @{$lines};
    }

    # if nothing else return
    return('', 'empty')
      unless ($#{$lines} >= 0);

    # deal with example chunks
    if ($lines->[0] =~ /^(\=\=\>\s+)\S/) {
	$offlen = length($1);
	while (($#{$lines} >= 0) && (defined($lines->[0]))) {
	    my $txt = substr(shift @{$lines}, $offlen);
	    $ret .= (defined($ret)) ? "\n$txt" : $txt;
	}
	return ($ret, 'code');
    }

    my $skipone;
    # deal with rest - numeric lines first
    if ($lines->[0] =~ /^(\s+\(\d+\)\s*)/) {
	$offlen = length($1);
	$flags = 'numlist';
	$skipone = 0;
    } elsif ($lines->[0] =~ /^(\s+)\S/) {
	$offlen = length($1);
	$flags = 'normal';
	$skipone = 0;
    } else {
	$offlen = 7;
	$flags = 'normal';
	$skipone = 1;
    }

    while (($#{$lines} >= 0) && (defined($lines->[0]))) {
	my $txt = $skipone ?
	  shift @{$lines} :
	    substr(shift @{$lines}, $offlen);
	$ret .= $txt;
	$ret .= ' ';
	$skipone = 0;
    }
    return ($ret, $flags);
}



sub format_wiki_text ($$) {
    my $meta = shift;
    my $lp = shift;

    my @lines = @{$lp};

    my $out;
    while ($#lines >= 0) {
	my($para, $flags) = clip_paragraph(\@lines);
	if ($flags eq 'code') {
	    $out .= "{{{\n" . $para . "\n}}}\n";
	} elsif ($flags eq 'numlist') {
	    $out .= ' 1. ' . wiki_markup($meta, $para) . "\n";
	} elsif ($flags eq 'empty') {
	} else {
	    $out .= wiki_markup($meta, $para) . "\n";
	}
    }
    return $out;
}



sub output_wiki_header ($$$) {
    my $fh = shift;
    my $meta = shift;
    my $qset = shift;

    $fh->print(join("\n",
		    '##language:en',
		    '#pragma section-numbers off',
		    '## Autogenerated by f2wiki',
		    join('', '["FAQ"] / [:', 
			 $qset->{section}->{wikiname},
			 ':',
			 $qset->{section}->{title},
			 '] / ',
			 $qset->{qtag}),
		    '----',
		    '[[Navigation(siblings)]]',
		    '----',
		    ''));
}



sub output_wiki_question ($$$$) {
    my $fh = shift;
    my $meta = shift;
    my $qset = shift;
    my $lines = shift;

    $fh->print(join("\n",
		    ('= ' . $qset->{qtag} . ' ='),
		    '',
		    '=== Question ===',
		    '##qstart',
		    format_wiki_text($meta, $lines),
		    '##qend',
		    ''));
}



sub output_wiki_answer ($$$$) {
    my $fh = shift;
    my $meta = shift;
    my $qset = shift;
    my $lines = shift;

    $fh->print(join("\n",
		    '=== Answer ===',
		    format_wiki_text($meta, $lines),
		    ''));
}



sub output_wiki_trailer ($$$) {
    my $fh = shift;
    my $meta = shift;
    my $qset = shift;

    $fh->print(join("\n",
		    '----',
		    '[[Navigation(siblings)]]',
		    '----',
		    join('', '["FAQ"] / [:', 
			 $qset->{section}->{wikiname},
			 ':',
			 $qset->{section}->{title},
			 '] / ',
			 $qset->{qtag}),
		    '----',
		    'CategoryFrequentlyAskedQuestions',
		    ''));
}



sub build_tocs ($) {
    my $meta = shift;

    my $tfh = IO::File->new('FAQ', 'w');
    my @sections = sort { $a->{num} <=> $b->{num} }
      values %{$meta->{sections}};
    foreach my $sect (@sections) {
	my $fh = IO::File->new($sect->{wikifile}, 'w');
	$fh->print(join("\n",
			'##language:en',
			'#pragma section-numbers off',
			'## Autogenerated by f2wiki',
			join('', '["FAQ"] / [:', 
			     $sect->{wikiname},
			     ':',
			     $sect->{title},
			     '] '),
			'----',
			'[[Navigation(siblings,1)]]',
			'----',
			'[[Navigation(children)]]',
			'----',
			'',
			'',
		       '= ' . $sect->{title} . ' =',
		       '',
		       join('',
			    '[[Include(^',
			    $sect->{wikiname},
			    '/.*,,2,from="##qstart",to="##qend")]]'),
			'',
			'----',
			'[[Navigation(siblings,1)]]',
			'----',
			'[[Navigation(children)]]',
			'----',
			join('', '["FAQ"] / [:', 
			     $sect->{wikiname},
			     ':',
			     $sect->{title},
			     '] '),
			'----',
			'CategoryFrequentlyAskedQuestions',
			''));

	$tfh->print(' * [:', $sect->{wikiname}, ':', $sect->{title}, "]\n");
    }
}



sub process_qset ($$$$) {
    my $meta = shift;
    my $qset = shift;
    my $qlines = shift;
    my $alines = shift;

    unless ($qset->{wikifile}) {
	print(join("\n#",
		   $qset->{qtag},
		   $qset->{wikiname},
		   $qset->{wikifile}),
	      "\n");
	return;
    }
    my $fh = IO::File->new($qset->{wikifile}, 'w') ||
      die "$qset->{wikifile} OUT $!";
    output_wiki_header($fh, $meta, $qset);
    output_wiki_question($fh, $meta, $qset, $qlines);
    output_wiki_answer($fh, $meta, $qset, $alines);
    output_wiki_trailer($fh, $meta, $qset);
}



sub parse_faqsrc ($$) {
    my $fh = shift;
    my $meta = shift;

    my $section;
    my $sect;

    while(<$fh>) {
	chomp;
	unless(defined($section)) {
	    unless (/^\d+\.\s/) {
		if (/^\s+\d+\./) {
		    my($junk,
		       $secnum,
		       $sectitle) = split(/\s+/, $_, 3);
		    $secnum =~ tr/0-9//cd;
		    my $wikiname = mkwikiname('FAQ', $sectitle);
		    my $wikifile = mkwikifilename($wikiname);
		    $meta->{sections}->{$secnum} =
		      {title	=> $sectitle,
		       num	=> $secnum,
		       wikiname	=> $wikiname,
		       wikifile	=> $wikifile,
		       qtags	=> []};
		}
		next;
	    }
	}
	if (/^(\d+)\.\s/) {
	    $section = $1;
	    $sect = $meta->{sections}->{$section};
	    $sect->{seen}++;
	} elsif (/^(Q\d+):/) {
	    my $qtag = $1;
	    my $wikiname = mkwikiname('FAQ', $sect->{title}, $qtag);
	    my $wikifile = mkwikifilename($wikiname);
	    my $qset = {section		=> $sect,
			qtag		=> $qtag,
			wikiname	=> $wikiname,
			wikifile	=> $wikifile};
	    $meta->{qtags}->{$qtag} = $qset;
	    push(@{$sect->{qtags}}, $qset);
	}
    }
}



sub process_faqsrc ($$) {
    my $fh = shift;
    my $meta = shift;

    my $qset;
    my $qlines = [];
    my $alines = [];
    my $clines = $qlines;

    while(<$fh>) {
	chomp;
	next if (/^#/);
	# skip preceding stuff....
	unless(defined($qset)) {
	    next unless (/^Q\d+/);
	}

	if (/^(\d+)\.\s/) {
	    # just skip section boundaries - we have done those before
	    next;
	} elsif (/^([QA]\d+):\s+(.+)$/) {
	    my $qtag = $1;
	    my $line = $2;
	    if (substr($1, 0, 1) eq 'Q') {
		process_qset($meta, $qset, $qlines, $alines);
		$qlines = [];
		$alines = [];
		$clines = $qlines;
		$qset = $meta->{qtags}->{$qtag};
	    } else {
		$clines = $alines;
	    }
	    push(@{$clines}, $line);
	} elsif (/^\s*$/) {
	    push(@{$clines}, undef);
	} else {
	    push(@{$clines}, $_);
	}
    }
    # mop up last q&a
    process_qset($meta, $qset, $qlines, $alines);

    # now build the tocs
    build_tocs($meta);
}



# main
{
    my $section;

    my $fh = IO::File->new(shift, 'r') || die $!;
    my $state = {};
    parse_faqsrc($fh, $state);
    $fh->seek(0,0);
#    print Dumper($state);
    process_faqsrc($fh, $state);

}

# -*-perl-*-