git.pond.sub.org Git - empserver/blob - info/findsubj.pl

   1 #!/usr/bin/perl
   2 #
   3 #   Empire - A multi-player, client/server Internet based war game.
   4 #   Copyright (C) 1986-2011, Dave Pare, Jeff Bailey, Thomas Ruschak,
   5 #                 Ken Stevens, Steve McClure, Markus Armbruster
   6 #
   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.
  11 #
  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.
  16 #
  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/>.
  19 #
  20 #   ---
  21 #
  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.
  25 #
  26 #   ---
  27 #
  28 #   findsubj.pl: Find info subjects, update subjects.mk
  29 #
  30 #   Known contributors to this file:
  31 #      Ken Stevens (when it was still info.pl)
  32 #      Markus Armbruster, 2006-2008
  33 #
  34
  35 # Usage: findsubj.pl INFO-FILE...
  36 # Run it at the root of the build tree.  This updates the make include
  37 # file subjects.mk, which guides the remaking of info index files.
  38 #
  39 #       --- Global variables ---
  40 # @Subjects       Existing subjects
  41 # $filename       The name of the current info file
  42 # $filename{TOPIC}
  43 #                 TOPIC's info file name
  44 # $chapter{TOPIC} TOPIC's chapter (first arg to .TH)
  45 # $see_also{TOPIC}
  46 #                 TOPIC's SEE ALSO items (.SA argument)
  47 # $sanr{TOPIC}    Line number of TOPIC's .SA request
  48 # $subjfil{SUBJECT}
  49 #                 info files for SUBJECT separated by space
  50 #
  51 #     --- File handles ---
  52 # F               Filehandle for info page sources and makefiles
  53 #
  54 #     --- Functions ---
  55 #
  56 # read_make_var   Read a variable value from a makefile
  57 # parse_file      Read an info file
  58 # parse_see_also  Create %subjfil from %see_also
  59 # error           Print an integrity error to STDERR and exit with code 1.
  60
  61 use strict;
  62 use warnings;
  63
  64 use Errno qw(ENOENT);
  65
  66 our (%filename, %chapter, %see_also, %sanr);
  67 our ($filename, %subjfil);
  68
  69 # Get known subjects
  70 our @Subjects = split(' ', read_make_var("subjects", "subjects.mk", ""));
  71
  72 # Parse the .t files
  73 for my $f (@ARGV) {
  74     parse_file("$f");
  75 }
  76
  77 # Create %subjfil from %see_also
  78 for my $t (sort keys %see_also) {
  79     parse_see_also($t);
  80 }
  81
  82 # Update @Subjects from %subjfil
  83 for my $t (@Subjects) {
  84     print STDERR "WARNING: The subject $t has been removed.\n"
  85         unless exists $subjfil{$t};
  86 }
  87 for my $t (keys %subjfil) {
  88     unless (grep(/^$t$/, @Subjects)) {
  89         print STDERR "WARNING: $t is a NEW subject\n";
  90         my $fname = "info/$t.t";
  91         if (-e $fname) {
  92             print STDERR "File $fname exists\n";
  93             exit 1;
  94         }
  95     }
  96 }
  97 @Subjects = sort keys %subjfil;
  98
  99 # Update subjects.mk
 100 open(F, ">subjects.mk")
 101     or die "Can't open subjects.mk for writing: $!";
 102 print F "# DO NOT EDIT THIS FILE.  It was automatically generated by findsubj.pl\n";
 103 print F "subjects := " . join(' ', @Subjects) . "\n";
 104 for my $t (@Subjects) {
 105     print F "info/$t.t:$subjfil{$t}\n";
 106 }
 107 close(F);
 108
 109 exit 0;
 110
 111 # Read a variable value from a makefile
 112 sub read_make_var {
 113     my ($var, $fname, $dflt) = @_;
 114     my $val;
 115
 116     unless (open(F, "<$fname")) {
 117         return $dflt if $! == ENOENT and defined $dflt;
 118         die "Can't open $fname: $!";
 119     }
 120     while (<F>) {
 121         if (/^[ \t]*\Q$var\E[ \t]:?=*(.*)/) {
 122             $val = $1;
 123             last;
 124         }
 125     }
 126     close(F);
 127     $val or die "Can't find $var in $fname";
 128     return $val;
 129 }
 130
 131 # Read an info file
 132 # Parse .TH into %chapter and .SA into %see_also, %sanr
 133 sub parse_file {
 134     ($filename) = @_;
 135     my $topic;
 136
 137     $topic = $filename;
 138     $topic =~ s,.*/([^/]*)\.t$,$1,;
 139     $filename{$topic} = $filename;
 140
 141     open(F, "<$filename")
 142         or die "Can't open $filename: $!";
 143
 144     $_ = <F>;
 145     if (/^\.TH (\S+) (\S.+\S)$/) {
 146         $chapter{$topic} = $1;
 147     } else {
 148         error("The first line in the file must be a .TH request");
 149     }
 150
 151     while (<F>) {
 152         last if /^\.SA/;
 153     }
 154
 155     if ($_) {
 156         if (/^\.SA "([^\"]*)"/) {
 157             $see_also{$topic} = $1;
 158             $sanr{$topic} = $.;
 159         } else {
 160             error("Incorrect .SA Syntax.  Syntax should be '.SA \"item1, item2\"'");
 161         }
 162
 163         while (<F>) {
 164             error("Multiple .SA requests.  Each file may contain at most one.") if /^\.SA/;
 165         }
 166     } else {
 167         error(".SA request is missing");
 168     }
 169
 170     close F;
 171 }
 172
 173 # Create %subjfil from %see_also
 174 sub parse_see_also {
 175     my ($topic) = @_;
 176     my @see_also = split(/, /, $see_also{$topic});
 177     my $wanted = $chapter{$topic};
 178     my $found;                 # found a subject?
 179
 180     $wanted = undef if $wanted eq 'Concept' or $wanted eq 'Command';
 181     $filename = $filename{$topic};
 182
 183     for (@see_also) {
 184         if (!exists $see_also{$_}) { # is this entry a subject?
 185             $subjfil{$_} .= " info/$topic.t";
 186             $found = 1;
 187         }
 188         if ($wanted && $_ eq $wanted) {
 189             $wanted = undef;
 190         }
 191     }
 192
 193     $. = $sanr{$topic};
 194     error("No subject listed in .SA") unless $found;
 195     error("Chapter $wanted not listed in .SA") if $wanted;
 196 }
 197
 198 # Print an integrity error message and exit with code 1
 199 sub error {
 200     my ($error) = @_;
 201
 202     print STDERR "findsubj.pl:$filename:$.: $error\n";
 203     exit 1;
 204 }