[exim-cvs] cvs commit: exim/exim-doc/doc-scripts f2wiki

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-*-