doc/doc-scripts/f2wiki

   1 #!/usr/bin/perl
   2 #
   3 # Script to convert Exim FAQ into wiki markup - moin flavour
   4 #
   5 use strict;
   6 use integer;
   7 use bytes;
   8 use Data::Dumper;
   9 use IO::File;
  10
  11 sub mkwikiname (@) {
  12     my @in = @_;
  13
  14     my @bits;
  15     foreach my $str (@in) {
  16         $str =~ tr/0-9A-Za-z _//cd;
  17         push(@bits, $str);
  18     }
  19     return join('/', @bits);
  20 }
  21
  22 \f
  23
  24 sub mkwikifilename ($) {
  25     my $wn = shift;
  26
  27     $wn =~ s/([^A-Za-z0-9])/sprintf("_%02x",ord($1))/eg;
  28
  29     return $wn;
  30 }
  31
  32 \f
  33
  34 sub format_wiki_question_header ($) {
  35     my $lp = shift;
  36
  37     my @lines = @{$lp};
  38     my $i;
  39     for($i =0; ($i <= $#lines); $i++) {
  40         unless (defined($lines[$i])) {
  41             splice(@lines, $i);
  42             last;
  43         }
  44         $lines[$i] =~ s/^\s+//;
  45     }
  46     return('= ' . join(' ', @lines) . ' =');
  47 }
  48
  49 \f
  50
  51 sub wikiref ($$) {
  52     my $meta = shift;
  53     my $qref = shift;
  54
  55     my $qtag = $meta->qtags->{$qref};
  56     unless ($qtag) {
  57         warn "Unknown qtag $qref\n";
  58         return $qref;
  59     }
  60
  61     return join(':', '[', $qref->{wikiname}, $qref . ']');
  62 }
  63
  64 \f
  65
  66 sub wiki_markup ($$) {
  67     my $meta = shift;
  68     my $s = shift;
  69
  70     $s =~ s/@\\/\@\@backslash\@\@/g;            # @\ temporarily hidden
  71
  72     $s =~ s/\\#/ /g;                             # \# is a hard space
  73
  74     $s =~ s/\\\*\*([^*]*)\*\*\\/'''$1'''/g;     # \**...**\   => bold
  75     $s =~ s/\\\*([^*]*)\*\\/''$1''/g;           # \*.....*\   => italic
  76     $s =~ s/\\"([^"]*)"\\/`$1`/g;               # \"....."\   => fixed pitch
  77     $s =~ s/\\\$([^\$]*)\$\\/''\$$1''/g;        # \$.....$\   => $italic
  78     $s =~ s/\\\\([^\\]*)\\\\/<small>$1<\/small>/g; # \\.....\\   => small
  79     $s =~ s/\\\(([^)]*)\)\\/''$1''/g;           # \(.....)\   => italic
  80     $s =~ s/\\-([^\\]*)-\\/'''-$1'''/g;         # \-.....-\   => -bold
  81     $s =~ s/\\\[([^]]*)\]\\/''$1''/gx;          # \[.....]\   => <italic>
  82     $s =~ s/\\\?(.*?)\?\\/$1/g;                 # \?.....?\   => URL
  83     $s =~ s/\\\^\^([^^]*)\^\^\\/''$1''/g;       # \^^...^^\   => italic
  84     $s =~ s/\\\^([^^]*)\^\\/''$1''/g;           # \^.....^\   => italic
  85     $s =~ s/\\%([^%]*)%\\/'''$1'''/g;           # \%.....%\   => bold
  86     $s =~ s/\\\/([^\/]*)\/\\/''$1''/g;          # \/...../\   => italic
  87     $s =~ s/\\([^\\]+)\\/`$1`/g;                # \.......\   => fixed pitch
  88
  89     $s =~ s"//([^/\"]*)//"''$1</i>"g;           # //.....//   => italic
  90     $s =~ s/::([^:]*)::/''$1:''/g;              # ::.....::   => italic:
  91
  92     $s =~ s/``(.*?)''/&#147;$1&#148;/g;                   # ``.....''   => quoted text
  93
  94     #$s =~ s/\s*\[\[br\]\]\s*/<br>/g;           # [[br]]      => <br>
  95
  96     $s =~ s/\@\@backslash\@\@/\\/g;                     # Put back single backslash
  97
  98     $s =~ s/^(\s*\(\d\)\s)/$1&nbsp;/;           # Extra space after (1), etc.
  99
 100     # Cross references within paragraphs
 101
 102     $s =~ s/Q(\d{4})(?!:)/wikiref($meta, $1)/xg;
 103
 104     # References to configuration samples
 105
 106     ##$s =~ s/\b([CFLS]\d\d\d)\b/<a href="$1.txt">$1<\/a>/g;
 107
 108     # Remove white space preceding a newline in the middle of paragraphs,
 109     # to keep the file smaller (and for human reading when debugging).
 110
 111     ##$s =~ s/^\s+//mg;
 112
 113     return $s;
 114 }
 115
 116 \f
 117
 118 sub clip_paragraph ($) {
 119     my $lines = shift;
 120
 121     my $ret;
 122     my $flags;
 123     my $offlen;
 124
 125     # split off and throw initial para breaks
 126     while (($#{$lines} >= 0) && (!defined($lines->[0]))) {
 127         shift @{$lines};
 128     }
 129
 130     # if nothing else return
 131     return('', 'empty')
 132       unless ($#{$lines} >= 0);
 133
 134     # deal with example chunks
 135     if ($lines->[0] =~ /^(\=\=\>\s+)\S/) {
 136         $offlen = length($1);
 137         while (($#{$lines} >= 0) && (defined($lines->[0]))) {
 138             my $txt = substr(shift @{$lines}, $offlen);
 139             $ret .= (defined($ret)) ? "\n$txt" : $txt;
 140         }
 141         return ($ret, 'code');
 142     }
 143
 144     my $skipone;
 145     # deal with rest - numeric lines first
 146     if ($lines->[0] =~ /^(\s+\(\d+\)\s*)/) {
 147         $offlen = length($1);
 148         $flags = 'numlist';
 149         $skipone = 0;
 150     } elsif ($lines->[0] =~ /^(\s+)\S/) {
 151         $offlen = length($1);
 152         $flags = 'normal';
 153         $skipone = 0;
 154     } else {
 155         $offlen = 7;
 156         $flags = 'normal';
 157         $skipone = 1;
 158     }
 159
 160     while (($#{$lines} >= 0) && (defined($lines->[0]))) {
 161         my $txt = $skipone ?
 162           shift @{$lines} :
 163             substr(shift @{$lines}, $offlen);
 164         $ret .= $txt;
 165         $ret .= ' ';
 166         $skipone = 0;
 167     }
 168     return ($ret, $flags);
 169 }
 170
 171 \f
 172
 173 sub format_wiki_text ($$) {
 174     my $meta = shift;
 175     my $lp = shift;
 176
 177     my @lines = @{$lp};
 178
 179     my $out;
 180     while ($#lines >= 0) {
 181         my($para, $flags) = clip_paragraph(\@lines);
 182         if ($flags eq 'code') {
 183             $out .= "{{{\n" . $para . "\n}}}\n";
 184         } elsif ($flags eq 'numlist') {
 185             $out .= ' 1. ' . wiki_markup($meta, $para) . "\n";
 186         } elsif ($flags eq 'empty') {
 187         } else {
 188             $out .= wiki_markup($meta, $para) . "\n";
 189         }
 190     }
 191     return $out;
 192 }
 193
 194 \f
 195
 196 sub output_wiki_header ($$$) {
 197     my $fh = shift;
 198     my $meta = shift;
 199     my $qset = shift;
 200
 201     $fh->print(join("\n",
 202                     '##language:en',
 203                     '#pragma section-numbers off',
 204                     '## Autogenerated by f2wiki',
 205                     join('', '["FAQ"] / [:',
 206                          $qset->{section}->{wikiname},
 207                          ':',
 208                          $qset->{section}->{title},
 209                          '] / ',
 210                          $qset->{qtag}),
 211                     '----',
 212                     '[[Navigation(siblings)]]',
 213                     '----',
 214                     ''));
 215 }
 216
 217 \f
 218
 219 sub output_wiki_question ($$$$) {
 220     my $fh = shift;
 221     my $meta = shift;
 222     my $qset = shift;
 223     my $lines = shift;
 224
 225     $fh->print(join("\n",
 226                     ('= ' . $qset->{qtag} . ' ='),
 227                     '',
 228                     '=== Question ===',
 229                     '##qstart',
 230                     format_wiki_text($meta, $lines),
 231                     '##qend',
 232                     ''));
 233 }
 234
 235 \f
 236
 237 sub output_wiki_answer ($$$$) {
 238     my $fh = shift;
 239     my $meta = shift;
 240     my $qset = shift;
 241     my $lines = shift;
 242
 243     $fh->print(join("\n",
 244                     '=== Answer ===',
 245                     format_wiki_text($meta, $lines),
 246                     ''));
 247 }
 248
 249 \f
 250
 251 sub output_wiki_trailer ($$$) {
 252     my $fh = shift;
 253     my $meta = shift;
 254     my $qset = shift;
 255
 256     $fh->print(join("\n",
 257                     '----',
 258                     '[[Navigation(siblings)]]',
 259                     '----',
 260                     join('', '["FAQ"] / [:',
 261                          $qset->{section}->{wikiname},
 262                          ':',
 263                          $qset->{section}->{title},
 264                          '] / ',
 265                          $qset->{qtag}),
 266                     '----',
 267                     'CategoryFrequentlyAskedQuestions',
 268                     ''));
 269 }
 270
 271 \f
 272
 273 sub build_tocs ($) {
 274     my $meta = shift;
 275
 276     my $tfh = IO::File->new('FAQ', 'w');
 277     my @sections = sort { $a->{num} <=> $b->{num} }
 278       values %{$meta->{sections}};
 279     foreach my $sect (@sections) {
 280         my $fh = IO::File->new($sect->{wikifile}, 'w');
 281         $fh->print(join("\n",
 282                         '##language:en',
 283                         '#pragma section-numbers off',
 284                         '## Autogenerated by f2wiki',
 285                         join('', '["FAQ"] / [:',
 286                              $sect->{wikiname},
 287                              ':',
 288                              $sect->{title},
 289                              '] '),
 290                         '----',
 291                         '[[Navigation(siblings,1)]]',
 292                         '----',
 293                         '[[Navigation(children)]]',
 294                         '----',
 295                         '',
 296                         '',
 297                        '= ' . $sect->{title} . ' =',
 298                        '',
 299                        join('',
 300                             '[[Include(^',
 301                             $sect->{wikiname},
 302                             '/.*,,2,from="##qstart",to="##qend")]]'),
 303                         '',
 304                         '----',
 305                         '[[Navigation(siblings,1)]]',
 306                         '----',
 307                         '[[Navigation(children)]]',
 308                         '----',
 309                         join('', '["FAQ"] / [:',
 310                              $sect->{wikiname},
 311                              ':',
 312                              $sect->{title},
 313                              '] '),
 314                         '----',
 315                         'CategoryFrequentlyAskedQuestions',
 316                         ''));
 317
 318         $tfh->print(' * [:', $sect->{wikiname}, ':', $sect->{title}, "]\n");
 319     }
 320 }
 321
 322 \f
 323
 324 sub process_qset ($$$$) {
 325     my $meta = shift;
 326     my $qset = shift;
 327     my $qlines = shift;
 328     my $alines = shift;
 329
 330     unless ($qset->{wikifile}) {
 331         print(join("\n#",
 332                    $qset->{qtag},
 333                    $qset->{wikiname},
 334                    $qset->{wikifile}),
 335               "\n");
 336         return;
 337     }
 338     my $fh = IO::File->new($qset->{wikifile}, 'w') ||
 339       die "$qset->{wikifile} OUT $!";
 340     output_wiki_header($fh, $meta, $qset);
 341     output_wiki_question($fh, $meta, $qset, $qlines);
 342     output_wiki_answer($fh, $meta, $qset, $alines);
 343     output_wiki_trailer($fh, $meta, $qset);
 344 }
 345
 346 \f
 347
 348 sub parse_faqsrc ($$) {
 349     my $fh = shift;
 350     my $meta = shift;
 351
 352     my $section;
 353     my $sect;
 354
 355     while(<$fh>) {
 356         chomp;
 357         unless(defined($section)) {
 358             unless (/^\d+\.\s/) {
 359                 if (/^\s+\d+\./) {
 360                     my($junk,
 361                        $secnum,
 362                        $sectitle) = split(/\s+/, $_, 3);
 363                     $secnum =~ tr/0-9//cd;
 364                     my $wikiname = mkwikiname('FAQ', $sectitle);
 365                     my $wikifile = mkwikifilename($wikiname);
 366                     $meta->{sections}->{$secnum} =
 367                       {title    => $sectitle,
 368                        num      => $secnum,
 369                        wikiname => $wikiname,
 370                        wikifile => $wikifile,
 371                        qtags    => []};
 372                 }
 373                 next;
 374             }
 375         }
 376         if (/^(\d+)\.\s/) {
 377             $section = $1;
 378             $sect = $meta->{sections}->{$section};
 379             $sect->{seen}++;
 380         } elsif (/^(Q\d+):/) {
 381             my $qtag = $1;
 382             my $wikiname = mkwikiname('FAQ', $sect->{title}, $qtag);
 383             my $wikifile = mkwikifilename($wikiname);
 384             my $qset = {section         => $sect,
 385                         qtag            => $qtag,
 386                         wikiname        => $wikiname,
 387                         wikifile        => $wikifile};
 388             $meta->{qtags}->{$qtag} = $qset;
 389             push(@{$sect->{qtags}}, $qset);
 390         }
 391     }
 392 }
 393
 394 \f
 395
 396 sub process_faqsrc ($$) {
 397     my $fh = shift;
 398     my $meta = shift;
 399
 400     my $qset;
 401     my $qlines = [];
 402     my $alines = [];
 403     my $clines = $qlines;
 404
 405     while(<$fh>) {
 406         chomp;
 407         next if (/^#/);
 408         # skip preceding stuff....
 409         unless(defined($qset)) {
 410             next unless (/^Q\d+/);
 411         }
 412
 413         if (/^(\d+)\.\s/) {
 414             # just skip section boundaries - we have done those before
 415             next;
 416         } elsif (/^([QA]\d+):\s+(.+)$/) {
 417             my $qtag = $1;
 418             my $line = $2;
 419             if (substr($1, 0, 1) eq 'Q') {
 420                 process_qset($meta, $qset, $qlines, $alines);
 421                 $qlines = [];
 422                 $alines = [];
 423                 $clines = $qlines;
 424                 $qset = $meta->{qtags}->{$qtag};
 425             } else {
 426                 $clines = $alines;
 427             }
 428             push(@{$clines}, $line);
 429         } elsif (/^\s*$/) {
 430             push(@{$clines}, undef);
 431         } else {
 432             push(@{$clines}, $_);
 433         }
 434     }
 435     # mop up last q&a
 436     process_qset($meta, $qset, $qlines, $alines);
 437
 438     # now build the tocs
 439     build_tocs($meta);
 440 }
 441
 442 \f
 443
 444 # main
 445 {
 446     my $section;
 447
 448     my $fh = IO::File->new(shift, 'r') || die $!;
 449     my $state = {};
 450     parse_faqsrc($fh, $state);
 451     $fh->seek(0,0);
 452 #    print Dumper($state);
 453     process_faqsrc($fh, $state);
 454
 455 }
 456
 457 # -*-perl-*-