doc/doc-scripts/f2wiki

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