#!/usr/bin/perl
#
# Empire - A multi-player, client/server Internet based war game.
-# Copyright (C) 1986-2013, Dave Pare, Jeff Bailey, Thomas Ruschak,
+# Copyright (C) 1986-2014, Dave Pare, Jeff Bailey, Thomas Ruschak,
# Ken Stevens, Steve McClure, Markus Armbruster
#
# Empire is free software: you can redistribute it and/or modify
#
# ---
#
-# mksubj.pl: Create the subject index pages
+# mksubj.pl: Update the subject index pages
#
# Known contributors to this file:
# Ken Stevens (when it was still info.pl)
# Markus Armbruster, 2006-2013
#
-# Usage: mksubj.pl INFO-FILE...
+# Usage: mksubj.pl SUBJECT... INFO-FILE...
#
-# Read the INFO-FILE..., read and update subjects.mk, create
-# info/SUBJECT.t for each SUBJECT.
+# Read the INFO-FILE..., update info/SUBJECT.t for each SUBJECT.
use strict;
use warnings;
-use File::stat;
-
-use Errno qw(ENOENT);
-use Fcntl qw(O_WRONLY O_EXCL O_CREAT);
# The chapters, in order
my @Chapters = qw/Introduction Concept Command Server/;
my @Levels = qw/Basic Expert Obsolete/;
-my @Subjects;
+
+# $Subjects{SUBJECT} is a reference to an an anonymous array
+# containing SUBJECT's topics
+my %Subjects;
# $filename{TOPIC} is TOPIC's file name
my %filename;
-# $long{TOPIC} is true when TOPIC's page is "long"
-my %long;
+# $lines{TOPIC} is the number of lines in $filename{TOPIC}
+my %lines;
# $chapter{TOPIC} is TOPIC's chapter (first arg to .TH)
my %chapter;
# $desc{TOPIC} is a one line description of TOPIC (second arg to .NA)
my %desc;
# $level{TOPIC} is TOPIC's difficulty level (arg to .LV)
my %level;
-# $see_also{TOPIC} is TOPIC's list of SEE ALSO items (.SA argument)
-my %see_also;
-# $sanr{TOPIC} is the line number of TOPIC's .SA request
-my %sanr;
# current info file
my $filename;
-# $subject{$subj}{$chap} = "item1\nitem2\n..."
-# Topics in that subject organized by chapter.
-my %subject;
-# $largest{$sub} The largest topic name in that subject (used for
-# column formatting)
-my %largest;
+while ($#ARGV >= 0 && $ARGV[0] !~ /\.t$/) {
+ $Subjects{shift @ARGV} = [];
+}
-@Subjects = split(' ', read_make_var("subjects", "subjects.mk", ""));
+for (@ARGV) {
+ $filename{fn2topic($_)} = $_;
+}
for (@ARGV) {
parse_file($_);
}
-for my $t (sort keys %desc) {
- parse_see_also($t);
+for (keys %Subjects) {
+ update_subj($_);
}
-@Subjects = create_subjects();
-
-open(F, ">subjects.mk")
- or die "Can't open subjects.mk for writing: $!";
-print F "subjects := " . join(' ', @Subjects) . "\n";
-close(F);
-
-exit 0;
-
-# Read a variable value from a makefile
-sub read_make_var {
- my ($var, $fname, $dflt) = @_;
- my $val;
-
- unless (open(F, "<$fname")) {
- return $dflt if $! == ENOENT and defined $dflt;
- die "Can't open $fname: $!";
- }
- while (<F>) {
- if (/^[ \t]*\Q$var\E[ \t]*:?=[ \t]*(.*)/) {
- $val = $1;
- last;
- }
- }
- close(F);
- defined($val) or die "Can't find $var in $fname";
- return $val;
+sub fn2topic {
+ my ($fn) = @_;
+ $fn =~ s,.*/([^/]*)\.t$,$1,;
+ return $fn;
}
# Parse an info file
-# Set $filename, $filename{TOPIC}, $long{TOPIC}, $chapter{TOPIC},
-# $desc{TOPIC}, $level{TOPIC}, $see_also{TOPIC}, $sanr{TOPIC}
+# Set $filename, $lines{TOPIC}, $chapter{TOPIC}, $desc{TOPIC},
+# $level{TOPIC}.
+# Update %Subjects.
sub parse_file {
($filename) = @_;
- my ($topic, $st);
-
- $topic = $filename;
- $topic =~ s,.*/([^/]*)\.t$,$1,;
- $filename{$topic} = $filename;
-
- $st = stat $filename
- or die "Can't stat $filename: $!";
- $long{$topic} = $st->size > 9999;
+ my $topic = fn2topic($filename);
open(F, "<$filename")
or die "Can't open $filename: $!";
if ($_) {
if (/^\.SA "([^\"]*)"/) {
- $see_also{$topic} = $1;
- $sanr{$topic} = $.;
+ parse_see_also($topic, $1);
} else {
- error("Incorrect .SA Syntax. Syntax should be '.SA \"item1, item2\"'");
- }
-
- while (<F>) {
- error("Multiple .SA requests. Each file may contain at most one.") if /^\.SA/;
+ error("Incorrect .SA argument, expecting '.SA \"item1, item2\"'");
}
} else {
error(".SA request is missing");
}
+ if (<F>) {
+ error(".SA request must be the last line");
+ }
+
+ $lines{$topic} = $.;
close F;
}
-# Create %subject and %largest from %see_also
sub parse_see_also {
- my ($topic) = @_;
- my @see_also = split(/, /, $see_also{$topic});
+ my ($topic, $sa) = @_;
my $wanted = $chapter{$topic};
my $found; # found a subject?
$wanted = undef if $wanted eq 'Concept' or $wanted eq 'Command';
- for (@see_also) {
- if (!exists $desc{$_}) { # is this entry a subject?
- set_subject($_, $topic);
- $found = 1;
- }
+ for (split(/, /, $sa)) {
+ next if exists $filename{$_};
+ error("Unknown topic $_ in .SA") unless exists $Subjects{$_};
+ push @{$Subjects{$_}}, $topic;
+ $found = 1;
if ($wanted && $_ eq $wanted) {
$wanted = undef;
}
}
- $filename = $filename{$topic};
- $. = $sanr{$topic};
error("No subject listed in .SA") unless $found;
error("Chapter $wanted not listed in .SA") if $wanted;
}
-# Add a new entry to %subject and possibly to %largest
-sub set_subject {
- my ($sub, $topic) = @_;
- my $chap = $chapter{$topic};
- $subject{$sub}{$chap} .= "$topic\n";
- $largest{$sub} = "" unless defined $largest{$_};
- $largest{$sub} = $topic if length $topic > length $largest{$sub};
-}
-
-# Create a Subject.t file
-sub create_subj {
+# Update a Subject.t file
+sub update_subj {
my ($subj) = @_;
my $fname = "info/$subj.t";
- my ($any_basic, $any_obsolete, $any_long);
+ my @topics = @{$Subjects{$subj}};
+ my $out = "";
+ my ($any_topic, $any_basic, $any_obsolete, $any_long);
+
+ my $largest = "";
+ for my $topic (@topics) {
+ $largest = $topic if length $topic > length $largest;
+ }
- print "WARNING: $subj is a NEW subject\n"
- unless grep(/^$subj$/, @Subjects);
- sysopen(SUBJ, $fname, O_WRONLY | O_EXCL | O_CREAT)
- or die "Unable to create $fname: $!\n";
+ $out .= '.\" DO NOT EDIT THIS FILE. It was automatically generated by mksubj.pl'."\n";
+ $out .= ".TH Subject \U$subj\n";
+ $largest =~ s/-/M/g;
+ $out .= ".in \\w'$largest" . "XX\\0\\0\\0\\0'u\n";
- print SUBJ '.\" DO NOT EDIT THIS FILE. It was automatically generated by mksubj.pl'."\n";
- print SUBJ ".TH Subject \U$subj\n";
- $largest{$subj} =~ s/-/M/g;
- print SUBJ ".in \\w'$largest{$subj}XX\\0\\0\\0\\0'u\n";
for my $chap (@Chapters) {
- next unless exists $subject{$subj}{$chap};
- print SUBJ ".s1\n";
- for my $topic (split(/\n/, $subject{$subj}{$chap})) {
+ my $empty = 1;
+ for my $topic (@topics) {
+ $any_topic = 1;
+ next if $chapter{$topic} ne $chap;
+ $out .= ".s1\n" if $empty;
+ $empty = 0;
my $flags = "";
if ($level{$topic} eq 'Basic') {
$flags .= "*";
$flags .= "+";
$any_obsolete = 1;
}
- if ($long{$topic}) {
+ if ($lines{$topic} > 300) {
+ # TODO use formatted line count
$flags .= "!";
$any_long = 1;
}
$flags = sprintf("%-2s", $flags);
- print SUBJ ".L \"$topic $flags\"\n";
- print SUBJ "$desc{$topic}\n";
+ $out .= ".L \"$topic $flags\"\n";
+ $out .= "$desc{$topic}\n";
}
}
- print SUBJ ".s1\n"
+ unless ($any_topic) {
+ print STDERR "$0: Subject $subj has no topics\n";
+ exit 1;
+ }
+ $out .= ".s1\n"
. ".in 0\n"
- . "For info on a particular subject, type \"info <subject>\" where <subject> is\n"
- . "one of the subjects listed above.\n";
- print SUBJ "Subjects marked by * are the most important and should be read by new players.\n"
+ . "For info on a particular topic, type \"info <topic>\" where <topic> is\n"
+ . "one of the topics listed above.\n";
+ $out .= "Topics marked by * are the most important and should be read by new players.\n"
if $any_basic;
- print SUBJ "Subjects marked by + are obsolete.\n"
+ $out .= "Topics marked by + are obsolete.\n"
if $any_obsolete;
- print SUBJ "Unusually long subjects are marked with a !.\n"
+ $out .= "Topics with unusually long info are marked with a !.\n"
if $any_long;
+
+ return if (same_contents($fname, $out));
+ open(SUBJ, ">$fname")
+ or die "Can't open $fname for writing: $!";
+ print SUBJ $out;
close SUBJ;
}
-# Remove the old Subject.t files and create new ones
-sub create_subjects {
- my (@subj);
-
- for (@Subjects) {
- unlink "info/$_.t";
- }
-
- @subj = sort keys %subject;
-
- for my $subj (@Subjects) {
- print "WARNING: The subject $subj has been removed.\n"
- unless grep (/^$subj$/, @subj);
- }
+sub same_contents {
+ my ($fname, $contents) = @_;
+ local $/;
- for my $subj (@subj) {
- create_subj($subj);
+ if (!open(SUBJ, "<$fname")) {
+ return 0 if ($!{ENOENT});
+ die "Can't open $fname for reading: $!";
}
- return @subj;
+ my $old = <SUBJ>;
+ close SUBJ;
+ return $contents eq $old;
}
# Print an integrity error message and exit with code 1