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-2013, Dave Pare, Jeff Bailey, Thomas Ruschak,
   5 #                 Ken Stevens, Steve McClure, Markus Armbruster
   6 #
   7 #   Empire 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 3 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, see <http://www.gnu.org/licenses/>.
  19 #
  20 #   ---
  21 #
  22 #   See files README, COPYING and CREDITS in the root of the source
  23 #   tree for related information and legal notices.  It is expected
  24 #   that future projects/authors will amend these files as needed.
  25 #
  26 #   ---
  27 #
  28 #   mksubj.pl: Create the index for a subject
  29 #
  30 #   Known contributors to this file:
  31 #      Ken Stevens (when it was still info.pl)
  32 #      Markus Armbruster, 2006
  33 #
  34
  35 # Usage: mksubj.pl OUTFILE INFILE...
  36 # The INFILE... contain all the topics belonging to a subject.  Read
  37 # and check the information required for the index from them, write
  38 # the index to OUTFILE.
  39
  40 use strict;
  41 use warnings;
  42 use File::stat;
  43
  44 # The chapters, in order
  45 my @Chapters = qw/Introduction Concept Command Server/;
  46
  47 my @Levels = qw/Basic Expert Obsolete/;
  48
  49 my $filename;
  50 my (%subject, %level, %desc, %long, %cnt);
  51 my $largest = "";
  52
  53 my $out = shift @ARGV;
  54 $out =~ /([^\/]*)\.t$/
  55     or die "Strange subject file name $out";
  56 my $subj = $1;
  57
  58 for (@ARGV) {
  59     my ($topic, $chap, $lvl, $desc, $long) = parse_file($_);
  60     $largest = $topic if length $topic > length $largest;
  61     $subject{$chap} .= "$topic\n";
  62     $level{$topic} = $lvl;
  63     $cnt{$lvl}++;
  64     $desc{$topic} = $desc;
  65     $long{$topic} = $long;
  66     $cnt{'long'}++ if $long;
  67 }
  68
  69 open(SUBJ, ">$out")
  70     or die "Can't open $out for writing: $!";
  71
  72 print SUBJ '.\" DO NOT EDIT THIS FILE.  It was automatically generated by mksubj.pl'."\n";
  73 print SUBJ ".TH Subject \U$subj\n";
  74 $largest =~ s/-/M/g;
  75 print SUBJ ".in \\w'$largest", "XX\\0\\0\\0\\0'u\n";
  76
  77 for my $chap (@Chapters) {
  78     next unless exists $subject{$chap};
  79     print SUBJ ".s1\n";
  80     for (split(/\n/, $subject{$chap})) {
  81         my $flags = "";
  82         $flags .= "*" if $level{$_} eq 'Basic';
  83         $flags .= "+" if $level{$_} eq 'Obsolete';
  84         $flags .= "!" if $long{$_};
  85         $flags = sprintf("%-2s", $flags);
  86         print SUBJ ".L \"$_ $flags\"\n";
  87         print SUBJ "$desc{$_}\n";
  88     }
  89 }
  90
  91 print SUBJ <<EOF;
  92 .s1
  93 .in 0
  94 For info on a particular subject, type "info <subject>" where <subject> is
  95 one of the subjects listed above.
  96 EOF
  97 print SUBJ <<EOF if $cnt{'Basic'};
  98 Subjects marked by * are the most important and should be read by new
  99 players.
 100 EOF
 101 print SUBJ <<EOF if $cnt{'Obsolete'};
 102 Subjects marked by + are obsolete.
 103 EOF
 104 print SUBJ <<EOF if $cnt{'long'};
 105 Unusually long subjects are marked with a !.
 106 EOF
 107 close SUBJ;
 108
 109
 110 sub parse_file {
 111     ($filename) = @_;
 112     my ($topic, $chap, $lvl, $desc, $long, $st);
 113
 114     $topic = $filename;
 115     $topic =~ s,.*/([^/]*)\.t$,$1,;
 116
 117     $st = stat $filename
 118         or die "Can't stat $filename: $!";
 119     $long = $st->size > 9999;
 120
 121     open(F, "<$filename")
 122         or die "Can't open $filename: $!";
 123
 124     $_ = <F>;
 125     if (/^\.TH (\S+) (\S.+\S)$/) {
 126         if (!grep(/^$1$/, @Chapters)) {
 127             error("First argument to .TH was '$1', which is not a known chapter");
 128         }
 129         $chap = $1;
 130         if ($1 eq "Command" && $2 ne "\U$topic") {
 131             error("Second argument to .TH was '$2' but it should be '\U$topic'");
 132         }
 133     } else {
 134         error("The first line in the file must be a .TH request");
 135     }
 136
 137     $_ = <F>;
 138     if (/^\.NA (\S+) "(\S.+\S)"$/) {
 139         if ($topic ne $1) {
 140             error("First argument to .NA was '$1' but it should be '$topic'");
 141         }
 142         $desc = $2;
 143     } else {
 144         error("The second line in the file must be a .NA request");
 145     }
 146
 147     $_ = <F>;
 148     if (/^\.LV (\S+)$/) {
 149         if (!grep(/^$1$/, @Levels)) {
 150             error("The argument to .LV was '$1', which is not a known level");
 151         }
 152         $lvl = $1;
 153     } else {
 154         error("The third line in the file must be a .LV request");
 155     }
 156
 157     close F;
 158
 159     return ($topic, $chap, $lvl, $desc, $long);
 160 }
 161
 162 # Print an integrity error message and exit with code 1
 163 sub error {
 164     my ($error) = @_;
 165
 166     print STDERR "mksubj.pl:$filename:$.: $error\n";
 167     exit 1;
 168 }