3 # Empire - A multi-player, client/server Internet based war game.
4 # Copyright (C) 1986-2015, 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: Update the subject index pages
30 # Known contributors to this file:
31 # Ken Stevens (when it was still info.pl)
32 # Markus Armbruster, 2006-2014
34 # Usage: mksubj.pl SUBJECT... INFO-FILE...
36 # Read the INFO-FILE..., update info/SUBJECT.t for each SUBJECT.
41 # The chapters, in order
42 my @Chapters = qw/Introduction Concept Command Server/;
44 my @Levels = qw/Basic Expert Obsolete/;
46 # $Subjects{SUBJECT} is a reference to an an anonymous array
47 # containing SUBJECT's topics
50 # $filename{TOPIC} is TOPIC's file name
52 # $lines{TOPIC} is the number of lines in $filename{TOPIC}
54 # $chapter{TOPIC} is TOPIC's chapter (first arg to .TH)
56 # $desc{TOPIC} is a one line description of TOPIC (second arg to .NA)
58 # $level{TOPIC} is TOPIC's difficulty level (arg to .LV)
64 while ($#ARGV >= 0 && $ARGV[0] !~ /\.t$/) {
65 $Subjects{shift @ARGV} = [];
69 $filename{fn2topic($_)} = $_;
76 for (keys %Subjects) {
84 $fn =~ s,.*/([^/]*)\.t$,$1,;
89 # Set $filename, $lines{TOPIC}, $chapter{TOPIC}, $desc{TOPIC},
94 my $topic = fn2topic($filename);
97 or die "Can't open $filename: $!";
100 if (/^\.TH (\S+) (\S.+\S)$/) {
101 if (!grep(/^$1$/, @Chapters)) {
102 error("First argument to .TH was '$1', which is not a known chapter");
104 $chapter{$topic} = $1;
105 if ($1 eq "Command" && $2 ne "\U$topic") {
106 error("Second argument to .TH was '$2' but it should be '\U$topic'");
109 error("The first line in the file must be a .TH request");
113 if (/^\.NA (\S+) "(\S.+\S)"$/) {
115 error("First argument to .NA was '$1' but it should be '$topic'");
119 error("The second line in the file must be a .NA request");
123 if (/^\.LV (\S+)$/) {
124 if (!grep(/^$1$/, @Levels)) {
125 error("The argument to .LV was '$1', which is not a known level");
129 error("The third line in the file must be a .LV request");
137 if (/^\.SA "([^\"]*)"/) {
138 parse_see_also($topic, $1);
140 error("Incorrect .SA argument, expecting '.SA \"item1, item2\"'");
143 error(".SA request is missing");
147 error(".SA request must be the last line");
155 my ($topic, $sa) = @_;
156 my $wanted = $chapter{$topic};
157 my $found; # found a subject?
159 $wanted = undef if $wanted eq 'Concept' or $wanted eq 'Command';
161 for (split(/, /, $sa)) {
162 next if exists $filename{$_};
163 error("Unknown topic $_ in .SA") unless exists $Subjects{$_};
164 push @{$Subjects{$_}}, $topic;
166 if ($wanted && $_ eq $wanted) {
171 error("No subject listed in .SA") unless $found;
172 error("Chapter $wanted not listed in .SA") if $wanted;
175 # Update a Subject.t file
178 my $fname = "info/$subj.t";
179 my @topics = @{$Subjects{$subj}};
181 my ($any_topic, $any_basic, $any_obsolete, $any_long);
184 for my $topic (@topics) {
185 $largest = $topic if length $topic > length $largest;
188 $out .= '.\" DO NOT EDIT THIS FILE. It was automatically generated by mksubj.pl'."\n";
189 $out .= ".TH Subject \U$subj\n";
191 $out .= ".in \\w'$largest" . "XX\\0\\0\\0\\0'u\n";
193 for my $chap (@Chapters) {
195 for my $topic (@topics) {
197 next if $chapter{$topic} ne $chap;
198 $out .= ".s1\n" if $empty;
201 if ($level{$topic} eq 'Basic') {
205 if ($level{$topic} eq 'Obsolete') {
209 if ($lines{$topic} > 300) {
210 # TODO use formatted line count
214 $flags = sprintf("%-2s", $flags);
215 $out .= ".L \"$topic $flags\"\n";
216 $out .= "$desc{$topic}\n";
219 unless ($any_topic) {
220 print STDERR "$0: Subject $subj has no topics\n";
225 . "For info on a particular topic, type \"info <topic>\" where <topic> is\n"
226 . "one of the topics listed above.\n";
227 $out .= "Topics marked by * are the most important and should be read by new players.\n"
229 $out .= "Topics marked by + are obsolete.\n"
231 $out .= "Topics with unusually long info are marked with a !.\n"
234 return if (same_contents($fname, $out));
235 open(SUBJ, ">$fname")
236 or die "Can't open $fname for writing: $!";
242 my ($fname, $contents) = @_;
245 if (!open(SUBJ, "<$fname")) {
246 return 0 if ($!{ENOENT});
247 die "Can't open $fname for reading: $!";
251 return $contents eq $old;
256 for (keys %chapter) {
257 push @toc, "$chapter{$_} $_";
259 open(TOC, ">info/toc")
260 or die "Can't open info/toc for writing: $!";
261 print TOC join("\n", sort @toc);
265 # Print an integrity error message and exit with code 1
269 print STDERR "mksubj.pl:$filename:$.: $error\n";