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
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.
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.
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/>.
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.
28 # mksubj.pl: Create the subject index pages
30 # Known contributors to this file:
31 # Ken Stevens (when it was still info.pl)
32 # Markus Armbruster, 2006-2013
34 # Usage: mksubj.pl INFO-FILE...
36 # Read the INFO-FILE..., read and update subjects.mk, create
37 # info/SUBJECT.t for each SUBJECT.
44 use Fcntl qw(O_WRONLY O_EXCL O_CREAT);
46 # The chapters, in order
47 my @Chapters = qw/Introduction Concept Command Server/;
49 my @Levels = qw/Basic Expert Obsolete/;
52 # $filename{TOPIC} is TOPIC's file name
54 # $long{TOPIC} is true when TOPIC's page is "long"
56 # $chapter{TOPIC} is TOPIC's chapter (first arg to .TH)
58 # $desc{TOPIC} is a one line description of TOPIC (second arg to .NA)
60 # $level{TOPIC} is TOPIC's difficulty level (arg to .LV)
62 # $see_also{TOPIC} is TOPIC's list of SEE ALSO items (.SA argument)
64 # $sanr{TOPIC} is the line number of TOPIC's .SA request
70 # $subject{$subj}{$chap} = "item1\nitem2\n..."
71 # Topics in that subject organized by chapter.
73 # $largest{$sub} The largest topic name in that subject (used for
77 @Subjects = split(' ', read_make_var("subjects", "subjects.mk", ""));
83 for my $t (sort keys %desc) {
87 @Subjects = create_subjects();
89 open(F, ">subjects.mk")
90 or die "Can't open subjects.mk for writing: $!";
91 print F "subjects := " . join(' ', @Subjects) . "\n";
96 # Read a variable value from a makefile
98 my ($var, $fname, $dflt) = @_;
101 unless (open(F, "<$fname")) {
102 return $dflt if $! == ENOENT and defined $dflt;
103 die "Can't open $fname: $!";
106 if (/^[ \t]*\Q$var\E[ \t]*:?=[ \t]*(.*)/) {
112 defined($val) or die "Can't find $var in $fname";
117 # Set $filename, $filename{TOPIC}, $long{TOPIC}, $chapter{TOPIC},
118 # $desc{TOPIC}, $level{TOPIC}, $see_also{TOPIC}, $sanr{TOPIC}
124 $topic =~ s,.*/([^/]*)\.t$,$1,;
125 $filename{$topic} = $filename;
128 or die "Can't stat $filename: $!";
129 $long{$topic} = $st->size > 9999;
131 open(F, "<$filename")
132 or die "Can't open $filename: $!";
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");
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'");
144 error("The first line in the file must be a .TH request");
148 if (/^\.NA (\S+) "(\S.+\S)"$/) {
150 error("First argument to .NA was '$1' but it should be '$topic'");
154 error("The second line in the file must be a .NA request");
158 if (/^\.LV (\S+)$/) {
159 if (!grep(/^$1$/, @Levels)) {
160 error("The argument to .LV was '$1', which is not a known level");
164 error("The third line in the file must be a .LV request");
172 if (/^\.SA "([^\"]*)"/) {
173 $see_also{$topic} = $1;
176 error("Incorrect .SA Syntax. Syntax should be '.SA \"item1, item2\"'");
180 error("Multiple .SA requests. Each file may contain at most one.") if /^\.SA/;
183 error(".SA request is missing");
189 # Create %subject and %largest from %see_also
192 my @see_also = split(/, /, $see_also{$topic});
193 my $wanted = $chapter{$topic};
194 my $found; # found a subject?
196 $wanted = undef if $wanted eq 'Concept' or $wanted eq 'Command';
199 if (!exists $desc{$_}) { # is this entry a subject?
200 set_subject($_, $topic);
203 if ($wanted && $_ eq $wanted) {
208 $filename = $filename{$topic};
210 error("No subject listed in .SA") unless $found;
211 error("Chapter $wanted not listed in .SA") if $wanted;
214 # Add a new entry to %subject and possibly to %largest
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};
223 # Create a Subject.t file
226 my $fname = "info/$subj.t";
227 my ($any_basic, $any_obsolete, $any_long);
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";
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};
241 for my $topic (split(/\n/, $subject{$subj}{$chap})) {
243 if ($level{$topic} eq 'Basic') {
247 if ($level{$topic} eq 'Obsolete') {
255 $flags = sprintf("%-2s", $flags);
256 print SUBJ ".L \"$topic $flags\"\n";
257 print SUBJ "$desc{$topic}\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"
266 print SUBJ "Subjects marked by + are obsolete.\n"
268 print SUBJ "Unusually long subjects are marked with a !.\n"
273 # Remove the old Subject.t files and create new ones
274 sub create_subjects {
281 @subj = sort keys %subject;
283 for my $subj (@Subjects) {
284 print "WARNING: The subject $subj has been removed.\n"
285 unless grep (/^$subj$/, @subj);
288 for my $subj (@subj) {
294 # Print an integrity error message and exit with code 1
298 print STDERR "mksubj.pl:$filename:$.: $error\n";