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 subject index pages
  29 #
  30 #   Known contributors to this file:
  31 #      Ken Stevens (when it was still info.pl)
  32 #      Markus Armbruster, 2006-2013
  33 #
  34 # Usage: mksubj.pl INFO-FILE...
  35 #
  36 # Read the INFO-FILE..., read and update subjects.mk, create
  37 # info/SUBJECT.t for each SUBJECT.
  38
  39 use strict;
  40 use warnings;
  41 use File::stat;
  42
  43 use Errno qw(ENOENT);
  44 use Fcntl qw(O_WRONLY O_EXCL O_CREAT);
  45
  46 # The chapters, in order
  47 my @Chapters = qw/Introduction Concept Command Server/;
  48
  49 my @Levels = qw/Basic Expert Obsolete/;
  50 my @Subjects;
  51
  52 # $filename{TOPIC} is TOPIC's file name
  53 my %filename;
  54 # $long{TOPIC} is true when TOPIC's page is "long"
  55 my %long;
  56 # $chapter{TOPIC} is TOPIC's chapter (first arg to .TH)
  57 my %chapter;
  58 # $desc{TOPIC} is a one line description of TOPIC (second arg to .NA)
  59 my %desc;
  60 # $level{TOPIC} is TOPIC's difficulty level (arg to .LV)
  61 my %level;
  62 # $see_also{TOPIC} is TOPIC's list of SEE ALSO items (.SA argument)
  63 my %see_also;
  64 # $sanr{TOPIC} is the line number of TOPIC's .SA request
  65 my %sanr;
  66
  67 # current info file
  68 my $filename;
  69
  70 # $subject{$subj}{$chap} = "item1\nitem2\n..."
  71 #                 Topics in that subject organized by chapter.
  72 my %subject;
  73 # $largest{$sub}  The largest topic name in that subject (used for
  74 #                 column formatting)
  75 my %largest;
  76
  77 @Subjects = split(' ', read_make_var("subjects", "subjects.mk", ""));
  78
  79 for (@ARGV) {
  80     parse_file($_);
  81 }
  82
  83 for my $t (sort keys %desc) {
  84     parse_see_also($t);
  85 }
  86
  87 @Subjects = create_subjects();
  88
  89 open(F, ">subjects.mk")
  90     or die "Can't open subjects.mk for writing: $!";
  91 print F "subjects := " . join(' ', @Subjects) . "\n";
  92 close(F);
  93
  94 exit 0;
  95
  96 # Read a variable value from a makefile
  97 sub read_make_var {
  98     my ($var, $fname, $dflt) = @_;
  99     my $val;
 100
 101     unless (open(F, "<$fname")) {
 102         return $dflt if $! == ENOENT and defined $dflt;
 103         die "Can't open $fname: $!";
 104     }
 105     while (<F>) {
 106         if (/^[ \t]*\Q$var\E[ \t]*:?=[ \t]*(.*)/) {
 107             $val = $1;
 108             last;
 109         }
 110     }
 111     close(F);
 112     defined($val) or die "Can't find $var in $fname";
 113     return $val;
 114 }
 115
 116 # Parse an info file
 117 # Set $filename, $filename{TOPIC}, $long{TOPIC}, $chapter{TOPIC},
 118 # $desc{TOPIC}, $level{TOPIC}, $see_also{TOPIC}, $sanr{TOPIC}
 119 sub parse_file {
 120     ($filename) = @_;
 121     my ($topic, $st);
 122
 123     $topic = $filename;
 124     $topic =~ s,.*/([^/]*)\.t$,$1,;
 125     $filename{$topic} = $filename;
 126
 127     $st = stat $filename
 128         or die "Can't stat $filename: $!";
 129     $long{$topic} = $st->size > 9999;
 130
 131     open(F, "<$filename")
 132         or die "Can't open $filename: $!";
 133
 134     $_ = <F>;
 135     if (/^\.TH (\S+) (\S.+\S)$/) {
 136         if (!grep(/^$1$/, @Chapters)) {
 137             error("First argument to .TH was '$1', which is not a known chapter");
 138         }
 139         $chapter{$topic} = $1;
 140         if ($1 eq "Command" && $2 ne "\U$topic") {
 141             error("Second argument to .TH was '$2' but it should be '\U$topic'");
 142         }
 143     } else {
 144         error("The first line in the file must be a .TH request");
 145     }
 146
 147     $_ = <F>;
 148     if (/^\.NA (\S+) "(\S.+\S)"$/) {
 149         if ($topic ne $1) {
 150             error("First argument to .NA was '$1' but it should be '$topic'");
 151         }
 152         $desc{$topic} = $2;
 153     } else {
 154         error("The second line in the file must be a .NA request");
 155     }
 156
 157     $_ = <F>;
 158     if (/^\.LV (\S+)$/) {
 159         if (!grep(/^$1$/, @Levels)) {
 160             error("The argument to .LV was '$1', which is not a known level");
 161         }
 162         $level{$topic} = $1;
 163     } else {
 164         error("The third line in the file must be a .LV request");
 165     }
 166
 167     while (<F>) {
 168         last if /^\.SA/;
 169     }
 170
 171     if ($_) {
 172         if (/^\.SA "([^\"]*)"/) {
 173             $see_also{$topic} = $1;
 174             $sanr{$topic} = $.;
 175         } else {
 176             error("Incorrect .SA Syntax.  Syntax should be '.SA \"item1, item2\"'");
 177         }
 178
 179         while (<F>) {
 180             error("Multiple .SA requests.  Each file may contain at most one.") if /^\.SA/;
 181         }
 182     } else {
 183         error(".SA request is missing");
 184     }
 185
 186     close F;
 187 }
 188
 189 # Create %subject and %largest from %see_also
 190 sub parse_see_also {
 191     my ($topic) = @_;
 192     my @see_also = split(/, /, $see_also{$topic});
 193     my $wanted = $chapter{$topic};
 194     my $found;                 # found a subject?
 195
 196     $wanted = undef if $wanted eq 'Concept' or $wanted eq 'Command';
 197
 198     for (@see_also) {
 199         if (!exists $desc{$_}) { # is this entry a subject?
 200             set_subject($_, $topic);
 201             $found = 1;
 202         }
 203         if ($wanted && $_ eq $wanted) {
 204             $wanted = undef;
 205         }
 206     }
 207
 208     $filename = $filename{$topic};
 209     $. = $sanr{$topic};
 210     error("No subject listed in .SA") unless $found;
 211     error("Chapter $wanted not listed in .SA") if $wanted;
 212 }
 213
 214 # Add a new entry to %subject and possibly to %largest
 215 sub set_subject {
 216     my ($sub, $topic) = @_;
 217     my $chap = $chapter{$topic};
 218     $subject{$sub}{$chap} .= "$topic\n";
 219     $largest{$sub} = "" unless defined $largest{$_};
 220     $largest{$sub} = $topic if length $topic > length $largest{$sub};
 221 }
 222
 223 # Create a Subject.t file
 224 sub create_subj {
 225     my ($subj) = @_;
 226     my $fname = "info/$subj.t";
 227     my ($any_basic, $any_obsolete, $any_long);
 228
 229     print "WARNING: $subj is a NEW subject\n"
 230         unless grep(/^$subj$/, @Subjects);
 231     sysopen(SUBJ, $fname, O_WRONLY | O_EXCL | O_CREAT)
 232         or die "Unable to create $fname: $!\n";
 233
 234     print SUBJ '.\" DO NOT EDIT THIS FILE.  It was automatically generated by mksubj.pl'."\n";
 235     print SUBJ ".TH Subject \U$subj\n";
 236     $largest{$subj} =~ s/-/M/g;
 237     print SUBJ ".in \\w'$largest{$subj}XX\\0\\0\\0\\0'u\n";
 238     for my $chap (@Chapters) {
 239         next unless exists $subject{$subj}{$chap};
 240         print SUBJ ".s1\n";
 241         for my $topic (split(/\n/, $subject{$subj}{$chap})) {
 242             my $flags = "";
 243             if ($level{$topic} eq 'Basic') {
 244                 $flags .= "*";
 245                 $any_basic = 1;
 246             }
 247             if ($level{$topic} eq 'Obsolete') {
 248                 $flags .= "+";
 249                 $any_obsolete = 1;
 250             }
 251             if ($long{$topic}) {
 252                 $flags .= "!";
 253                 $any_long = 1;
 254             }
 255             $flags = sprintf("%-2s", $flags);
 256             print SUBJ ".L \"$topic $flags\"\n";
 257             print SUBJ "$desc{$topic}\n";
 258         }
 259     }
 260     print SUBJ ".s1\n"
 261         . ".in 0\n"
 262         . "For info on a particular subject, type \"info <subject>\" where <subject> is\n"
 263         . "one of the subjects listed above.\n";
 264     print SUBJ "Subjects marked by * are the most important and should be read by new players.\n"
 265         if $any_basic;
 266     print SUBJ "Subjects marked by + are obsolete.\n"
 267         if $any_obsolete;
 268     print SUBJ "Unusually long subjects are marked with a !.\n"
 269         if $any_long;
 270     close SUBJ;
 271 }
 272
 273 # Remove the old Subject.t files and create new ones
 274 sub create_subjects {
 275     my (@subj);
 276
 277     for (@Subjects) {
 278         unlink "info/$_.t";
 279     }
 280
 281     @subj = sort keys %subject;
 282
 283     for my $subj (@Subjects) {
 284         print "WARNING: The subject $subj has been removed.\n"
 285             unless grep (/^$subj$/, @subj);
 286     }
 287
 288     for my $subj (@subj) {
 289         create_subj($subj);
 290     }
 291     return @subj;
 292 }
 293
 294 # Print an integrity error message and exit with code 1
 295 sub error {
 296     my ($error) = @_;
 297
 298     print STDERR "mksubj.pl:$filename:$.: $error\n";
 299     exit 1;
 300 }