]> git.pond.sub.org Git - empserver/blobdiff - info/mksubj.pl
Update copyright notice
[empserver] / info / mksubj.pl
index 4e966b123e6434d3de62f5f0c728012f9416fea7..614b035b9a958b06ddfbb5e4524aebba764e9d8e 100644 (file)
@@ -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-2014, Dave Pare, Jeff Bailey, Thomas Ruschak,
 #                 Ken Stevens, Steve McClure, Markus Armbruster
 #
 #   Empire is free software: you can redistribute it and/or modify
@@ -25,7 +25,7 @@
 #
 #   ---
 #
-#   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)
 #
 # Usage: mksubj.pl SUBJECT... INFO-FILE...
 #
-# Read the INFO-FILE..., 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 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/;
+
+# $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} = undef;
+    $Subjects{shift @ARGV} = [];
+}
+
+for (@ARGV) {
+    $filename{fn2topic($_)} = $_;
 }
 
 for (@ARGV) {
     parse_file($_);
 }
 
-for my $t (sort keys %desc) {
-    parse_see_also($t);
+for (keys %Subjects) {
+    update_subj($_);
 }
 
-create_subjects();
+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: $!";
@@ -143,39 +133,34 @@ sub parse_file {
 
     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';
-    $filename = $filename{$topic};
-    $. = $sanr{$topic};
-
-    for (@see_also) {
-       if (!exists $desc{$_}) { # is this entry a subject?
-           error("Unknown topic $_ in .SA") unless exists $Subjects{$_};
-           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;
        }
@@ -185,33 +170,31 @@ sub parse_see_also {
     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 @topics = @{$Subjects{$subj}};
+    my $out = "";
     my ($any_topic, $any_basic, $any_obsolete, $any_long);
 
-    sysopen(SUBJ, $fname, O_WRONLY | O_EXCL | O_CREAT)
-       or die "Unable to create $fname: $!\n";
+    my $largest = "";
+    for my $topic (@topics) {
+       $largest = $topic if length $topic > length $largest;
+    }
+
+    $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 .= "*";
@@ -221,45 +204,49 @@ sub create_subj {
                $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";
        }
     }
     unless ($any_topic) {
        print STDERR "$0: Subject $subj has no topics\n";
        exit 1;
     }
-    print SUBJ ".s1\n"
+    $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 (keys %Subjects) {
-       unlink "info/$_.t";
-    }
-
-    @subj = sort keys %subject;
+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: $!";
     }
+    my $old = <SUBJ>;
+    close SUBJ;
+    return $contents eq $old;
 }
 
 # Print an integrity error message and exit with code 1