Markus Armbruster
e9a69b6bc9
Mark obsolete pages with '+' in subject pages. Drop the separate
"Obsolete" subject page: move "info Innards" to subject "Server", and
"info update" to "Updates" (where it came from in commit a5764534,
v4.3.10).
168 lines
4.5 KiB
Perl
168 lines
4.5 KiB
Perl
#!/usr/bin/perl
|
|
#
|
|
# Empire - A multi-player, client/server Internet based war game.
|
|
# Copyright (C) 1986-2013, Dave Pare, Jeff Bailey, Thomas Ruschak,
|
|
# Ken Stevens, Steve McClure, Markus Armbruster
|
|
#
|
|
# Empire is free software: you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation, either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
#
|
|
# ---
|
|
#
|
|
# See files README, COPYING and CREDITS in the root of the source
|
|
# tree for related information and legal notices. It is expected
|
|
# that future projects/authors will amend these files as needed.
|
|
#
|
|
# ---
|
|
#
|
|
# mksubj.pl: Create the index for a subject
|
|
#
|
|
# Known contributors to this file:
|
|
# Ken Stevens (when it was still info.pl)
|
|
# Markus Armbruster, 2006
|
|
#
|
|
|
|
# Usage: mksubj.pl OUTFILE INFILE...
|
|
# The INFILE... contain all the topics belonging to a subject. Read
|
|
# and check the information required for the index from them, write
|
|
# the index to OUTFILE.
|
|
|
|
use strict;
|
|
use warnings;
|
|
use File::stat;
|
|
|
|
# The chapters, in order
|
|
my @Chapters = qw/Introduction Concept Command Server/;
|
|
|
|
my @Levels = qw/Basic Expert Obsolete/;
|
|
|
|
my $filename;
|
|
my (%subject, %level, %desc, %long, %cnt);
|
|
my $largest = "";
|
|
|
|
my $out = shift @ARGV;
|
|
$out =~ /([^\/]*)\.t$/
|
|
or die "Strange subject file name $out";
|
|
my $subj = $1;
|
|
|
|
for (@ARGV) {
|
|
my ($topic, $chap, $lvl, $desc, $long) = parse_file($_);
|
|
$largest = $topic if length $topic > length $largest;
|
|
$subject{$chap} .= "$topic\n";
|
|
$level{$topic} = $lvl;
|
|
$cnt{$lvl}++;
|
|
$desc{$topic} = $desc;
|
|
$long{$topic} = $long;
|
|
$cnt{'long'}++ if $long;
|
|
}
|
|
|
|
open(SUBJ, ">$out")
|
|
or die "Can't open $out for writing: $!";
|
|
|
|
print SUBJ '.\" DO NOT EDIT THIS FILE. It was automatically generated by mksubj.pl'."\n";
|
|
print SUBJ ".TH Subject \U$subj\n";
|
|
$largest =~ s/-/M/g;
|
|
print SUBJ ".in \\w'$largest", "XX\\0\\0\\0\\0'u\n";
|
|
|
|
for my $chap (@Chapters) {
|
|
next unless exists $subject{$chap};
|
|
print SUBJ ".s1\n";
|
|
for (split(/\n/, $subject{$chap})) {
|
|
my $flags = "";
|
|
$flags .= "*" if $level{$_} eq 'Basic';
|
|
$flags .= "+" if $level{$_} eq 'Obsolete';
|
|
$flags .= "!" if $long{$_};
|
|
$flags = sprintf("%-2s", $flags);
|
|
print SUBJ ".L \"$_ $flags\"\n";
|
|
print SUBJ "$desc{$_}\n";
|
|
}
|
|
}
|
|
|
|
print SUBJ <<EOF;
|
|
.s1
|
|
.in 0
|
|
For info on a particular subject, type "info <subject>" where <subject> is
|
|
one of the subjects listed above.
|
|
EOF
|
|
print SUBJ <<EOF if $cnt{'Basic'};
|
|
Subjects marked by * are the most important and should be read by new
|
|
players.
|
|
EOF
|
|
print SUBJ <<EOF if $cnt{'Obsolete'};
|
|
Subjects marked by + are obsolete.
|
|
EOF
|
|
print SUBJ <<EOF if $cnt{'long'};
|
|
Unusually long subjects are marked with a !.
|
|
EOF
|
|
close SUBJ;
|
|
|
|
|
|
sub parse_file {
|
|
($filename) = @_;
|
|
my ($topic, $chap, $lvl, $desc, $long, $st);
|
|
|
|
$topic = $filename;
|
|
$topic =~ s,.*/([^/]*)\.t$,$1,;
|
|
|
|
$st = stat $filename
|
|
or die "Can't stat $filename: $!";
|
|
$long = $st->size > 9999;
|
|
|
|
open(F, "<$filename")
|
|
or die "Can't open $filename: $!";
|
|
|
|
$_ = <F>;
|
|
if (/^\.TH (\S+) (\S.+\S)$/) {
|
|
if (!grep(/^$1$/, @Chapters)) {
|
|
error("First argument to .TH was '$1', which is not a known chapter");
|
|
}
|
|
$chap = $1;
|
|
if ($1 eq "Command" && $2 ne "\U$topic") {
|
|
error("Second argument to .TH was '$2' but it should be '\U$topic'");
|
|
}
|
|
} else {
|
|
error("The first line in the file must be a .TH request");
|
|
}
|
|
|
|
$_ = <F>;
|
|
if (/^\.NA (\S+) "(\S.+\S)"$/) {
|
|
if ($topic ne $1) {
|
|
error("First argument to .NA was '$1' but it should be '$topic'");
|
|
}
|
|
$desc = $2;
|
|
} else {
|
|
error("The second line in the file must be a .NA request");
|
|
}
|
|
|
|
$_ = <F>;
|
|
if (/^\.LV (\S+)$/) {
|
|
if (!grep(/^$1$/, @Levels)) {
|
|
error("The argument to .LV was '$1', which is not a known level");
|
|
}
|
|
$lvl = $1;
|
|
} else {
|
|
error("The third line in the file must be a .LV request");
|
|
}
|
|
|
|
close F;
|
|
|
|
return ($topic, $chap, $lvl, $desc, $long);
|
|
}
|
|
|
|
# Print an integrity error message and exit with code 1
|
|
sub error {
|
|
my ($error) = @_;
|
|
|
|
print STDERR "mksubj.pl:$filename:$.: $error\n";
|
|
exit 1;
|
|
}
|