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