nm4 2004/11/12 14:48:08 GMT
Added files:
exim-doc/doc-scripts f2wiki
Log:
initial FAQ 2 wiki script
Revision Changes Path
1.1 +457 -0 exim/exim-doc/doc-scripts/f2wiki (new)
Index: f2wiki
====================================================================
#!/usr/bin/perl
#
# Script to convert Exim FAQ into wiki markup - moin flavour
#
# $Cambridge: exim/exim-doc/doc-scripts/f2wiki,v 1.1 2004/11/12 14:48:08 nm4 Exp $
#
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');
foreach my $sect (values %{$meta->{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-*-
