git.pond.sub.org Git - empserver/blob - info/mksubj.pl

   1 #!/usr/bin/perl
   2 #
   3 #  Empire - A multi-player, client/server Internet based war game.
   4 #  Copyright (C) 1986-2010, Dave Pare, Jeff Bailey, Thomas Ruschak,
   5 #                           Ken Stevens, Steve McClure
   6 #
   7 #  This program is free software; you can redistribute it and/or modify
   8 #  it under the terms of the GNU General Public License as published by
   9 #  the Free Software Foundation; either version 2 of the License, or
  10 #  (at your option) any later version.
  11 #
  12 #  This program is distributed in the hope that it will be useful,
  13 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 #  GNU General Public License for more details.
  16 #
  17 #  You should have received a copy of the GNU General Public License
  18 #  along with this program; if not, write to the Free Software
  19 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  20 #
  21 #  ---
  22 #
  23 #  See files README, COPYING and CREDITS in the root of the source
  24 #  tree for related information and legal notices.  It is expected
  25 #  that future projects/authors will amend these files as needed.
  26 #
  27 #  ---
  28 #
  29 #  mksubj.pl: Create the index for a subject
  30 #
  31 #  Known contributors to this file:
  32 #     Ken Stevens (when it was still info.pl)
  33 #     Markus Armbruster, 2006
  34 #
  35
  36 # Usage: mksubj.pl OUTFILE INFILE...
  37 # The INFILE... contain all the topics belonging to a subject.  Read
  38 # and check the information required for the index from them, write
  39 # the index to OUTFILE.
  40
  41 use strict;
  42 use warnings;
  43
  44 # The chapters, in order
  45 our @Chapters = qw/Introduction Concept Command Server/;
  46
  47 our $filename;
  48 my (%subject, %level, %desc);
  49 my $largest = "";
  50
  51 my $out = shift @ARGV;
  52 $out =~ /([^\/]*)\.t$/
  53     or die "Strange subject file name $out";
  54 my $subj = $1;
  55
  56 for (@ARGV) {
  57     my ($topic, $chap, $lvl, $desc) = parse_file($_);
  58     $largest = $topic if length $topic > length $largest;
  59     $subject{$chap} .= "$topic\n";
  60     $level{$topic} = $lvl;
  61     $desc{$topic} = $desc;
  62 }
  63
  64 open(SUBJ, ">$out")
  65     or die "Can't open $out for writing: $!";
  66
  67 print SUBJ '.\" DO NOT EDIT THIS FILE.  It was automatically generated by mksubj.pl'."\n";
  68 print SUBJ ".TH Subject \U$subj\n";
  69 $largest =~ s/-/M/g;
  70 print SUBJ ".in \\w'$largest", "XX\\0\\0\\0\\0'u\n";
  71
  72 for my $chap (@Chapters) {
  73     next unless exists $subject{$chap};
  74     print SUBJ ".s1\n";
  75     for (split(/\n/, $subject{$chap})) {
  76         print SUBJ ".L \"$_ ";
  77         if ($level{$_} eq 'Basic') {
  78             print SUBJ "* \"\n";
  79         } else {
  80             print SUBJ "  \"\n";
  81         }
  82         print SUBJ "$desc{$_}\n";
  83     }
  84 }
  85
  86 print SUBJ <<EOF;
  87 .s1
  88 .in 0
  89 For info on a particular subject, type "info <subject>" where <subject> is
  90 one of the subjects listed above.  Subjects marked by * are the most
  91 important and should be read by new players.
  92 EOF
  93 close SUBJ;
  94
  95
  96 sub parse_file {
  97     ($filename) = @_;
  98     my ($topic, $chap, $lvl, $desc);
  99
 100     $topic = $filename;
 101     $topic =~ s,.*/([^/]*)\.t$,$1,;
 102
 103     open(F, "<$filename")
 104         or die "Can't open $filename: $!";
 105
 106     $_ = <F>;
 107     if (/^\.TH (\S+) (\S.+\S)$/) {
 108         if (!grep(/^$1$/, @Chapters)) {
 109             error("First argument to .TH was '$1', which is not a known chapter");
 110         }
 111         $chap = $1;
 112         if ($1 eq "Command" && $2 ne "\U$topic") {
 113             error("Second argument to .TH was '$2' but it should be '\U$topic'");
 114         }
 115     } else {
 116         error("The first line in the file must be a .TH request");
 117     }
 118
 119     $_ = <F>;
 120     if (/^\.NA (\S+) "(\S.+\S)"$/) {
 121         if ($topic ne $1) {
 122             error("First argument to .NA was '$1' but it should be '$topic'");
 123         }
 124         $desc = $2;
 125     } else {
 126         error("The second line in the file must be a .NA request");
 127     }
 128
 129     $_ = <F>;
 130     if (/^\.LV (\S+)$/) {
 131         if ($1 ne 'Basic' && $1 ne 'Expert') {
 132             error("The argument to .LV was '$1' but it must be either 'Basic' or 'Expert'");
 133         }
 134         $lvl = $1;
 135     } else {
 136         error("The third line in the file must be a .LV request");
 137     }
 138
 139     close F;
 140
 141     return ($topic, $chap, $lvl, $desc);
 142 }
 143
 144 # Print an integrity error message and exit with code 1
 145 sub error {
 146     my ($error) = @_;
 147
 148     print STDERR "mksubj.pl:$filename:$.: $error\n";
 149     exit 1;
 150 }