#!/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/``(.*?)''/“$1”/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 /; # 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-*-