info: New Common-Fever, Hvy-Fever

[empserver] / info / mksubj.pl

diff --git a/info/mksubj.pl b/info/mksubj.pl
index cc4bfbcbcc7969509db1c7b80f60e59c89f8ac2a..2394ce26faccc1413be54dba53494343228a09f0 100644 (file)
--- a/info/mksubj.pl
+++ b/info/mksubj.pl
@@ -1,7 +1,7 @@
 #!/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-2021, Dave Pare, Jeff Bailey, Thomas Ruschak,
 #                 Ken Stevens, Steve McClure, Markus Armbruster
 #
 #   Empire is free software: you can redistribute it and/or modify
@@ -29,7 +29,7 @@
 #
 #   Known contributors to this file:
 #      Ken Stevens (when it was still info.pl)
-#      Markus Armbruster, 2006-2013
+#      Markus Armbruster, 2006-2016
 #
 # Usage: mksubj.pl SUBJECT... INFO-FILE...
 #
@@ -37,21 +37,20 @@
 
 use strict;
 use warnings;
-use File::stat;
 
 # The chapters, in order
 my @Chapters = qw/Introduction Concept Command Server/;
 
 my @Levels = qw/Basic Expert Obsolete/;
 
-# $Subjects{SUBJECT} is a reference to an an anonymous array
+# $Subjects{SUBJECT} is a reference to 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)
@@ -78,6 +77,8 @@ for (keys %Subjects) {
     update_subj($_);
 }
 
+write_toc();
+
 sub fn2topic {
     my ($fn) = @_;
     $fn =~ s,.*/([^/]*)\.t$,$1,;
@@ -85,17 +86,12 @@ sub fn2topic {
 }
 
 # Parse an info file
-# Set $filename, $long{TOPIC}, $chapter{TOPIC}, $desc{TOPIC},
+# Set $filename, $lines{TOPIC}, $chapter{TOPIC}, $desc{TOPIC},
 # $level{TOPIC}.
 # Update %Subjects.
 sub parse_file {
     ($filename) = @_;
     my $topic = fn2topic($filename);
-    my $st;
-
-    $st = stat $filename
-       or die "Can't stat $filename: $!";
-    $long{$topic} = $st->size > 9999;
 
     open(F, "<$filename")
        or die "Can't open $filename: $!";
@@ -141,16 +137,17 @@ sub parse_file {
        if (/^\.SA "([^\"]*)"/) {
            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;
 }
 
@@ -209,7 +206,8 @@ sub update_subj {
                $flags .= "+";
                $any_obsolete = 1;
            }
-           if ($long{$topic}) {
+           if ($lines{$topic} > 300) {
+               # TODO use formatted line count
                $flags .= "!";
                $any_long = 1;
            }
@@ -224,13 +222,13 @@ sub update_subj {
     }
     $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";
-    $out .= "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;
-    $out .= "Subjects marked by + are obsolete.\n"
+    $out .= "Topics marked by + are obsolete.\n"
        if $any_obsolete;
-    $out .= "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));
@@ -253,6 +251,18 @@ sub same_contents {
     return $contents eq $old;
 }
 
+sub write_toc {
+    my @toc;
+    for (keys %chapter) {
+       push @toc, "$chapter{$_} $_";
+    }
+    open(TOC, ">info/toc")
+       or die "Can't open info/toc for writing: $!";
+    print TOC join("\n", sort @toc);
+    print TOC "\n";
+    close TOC;
+}
+
 # Print an integrity error message and exit with code 1
 sub error {
     my ($error) = @_;