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