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

   1 #!/usr/local/bin/perl
   2 #
   3 #                                 info.pl
   4 #
   5 #                 Create SUBJECT.t files from the Info Pages.
   6 #
   7 #                           written by Ken Stevens
   8 #
   9 #
  10 # DESCRIPTION:
  11 # info.pl reads all of the info pages and creates a table of contents
  12 # for them organized by subject.
  13 #
  14 # Info consists of pages organized into chapters and subjects.  Each
  15 # page is about a topic.  The page for topic ITEM is in info file
  16 # info/ITEM.t.  An info page's chapter is the first argument of its
  17 # .TH request.  It belongs to a subject if that subject appears in its
  18 # .SA request ("SEE ALSO") _and_ that entry is not the name of another
  19 # info page.  An info page may belong to more than one subject.
  20 #
  21 # For example, the .SA request of headlines.t contains "newspaper" and
  22 # "Communication".  Since there's already an info page called
  23 # "newspaper.t", but there is no "Communication" info page, the
  24 # headlines info page is considered to be a member of the
  25 # Communication subject.
  26 #
  27 # This script reads GNUmakefile and sources.mk to find info sources.
  28 # It reads existing subjects from subjects.mk, and updates that file.
  29 # It creates a file info/SUBJECT.t for each SUBJECT, and a table of
  30 # subjects info/TOP.t.
  31 #
  32 # REQUIREMENTS:
  33 # info.pl requires perl5 to run.  If you don't have version 5 of perl, then
  34 # you'll either have to install it, or you'll have to get someone to create
  35 # your Subjects.t files for you.
  36 #
  37 # HOW TO RUN IT:
  38 # Run "info.pl" at the root of the build tree.
  39
  40 #       --- Global variables ---
  41 # @Subjects       Existing subjects
  42 # @Chapters       Existing chapters
  43 # $filename       The name of the current info file
  44 # $chapter{TOPIC} TOPIC's chapter (first arg to .TH)
  45 # $desc{TOPIC}    A one line description of TOPIC (second arg to .NA)
  46 # $level{TOPIC}   TOPIC's difficulty level (arg to .LV)
  47 # $see_also{TOPIC}
  48 #                 TOPIC's SEE ALSO items (.SA argument)
  49 # $sanr{TOPIC}    Line number of TOPIC's .SA request
  50 # $subject{$subj}{$chap} = "item1\nitem2\n..."
  51 #                 Topics in that subject organized by chapter.
  52 # $largest{$sub}  The largest topic name in that subject (used for
  53 #                 column formatting)
  54 #
  55 #     --- File handles ---
  56 # F               Filehandle for info page sources and makefiles
  57 # SUBJ            Filehandle for Subject.t
  58 # TOP             Filehandle for TOP.t
  59 #
  60 #     --- Functions ---
  61 #
  62 # read_make_var   Read a variable value from a makefile
  63 # parse_file      Check the .TH, .NA, and .SA fields & parse them
  64 # parse_see_also  Create %subject from %see_also
  65 # set_subject     Add a new entry to %subject and possibly to %largest
  66 # create_subj     Create a Subject.t file
  67 # create_subjects Remove the old Subject.t files and create new ones
  68 # flush_subj      Print a row of Subjects to TOP
  69 # error           Print an integrity error to STDERR and exit with code 1.
  70
  71 use strict;
  72 use warnings;
  73
  74 use Errno qw(ENOENT);
  75 use Fcntl qw(O_WRONLY O_EXCL O_CREAT);
  76
  77 our (%chapter, %desc, %level, %see_also, %sanr);
  78 our ($filename, %subject, %largest);
  79
  80 eval("require 5");              # Test for perl version 5
  81 die "$0 requires version 5 of perl.\n" if $@;
  82
  83 # The chapters, in order
  84 our @Chapters = qw/Introduction Concept Command Server/;
  85
  86 # Get known subjects
  87 our @Subjects = split(' ', read_make_var("subjects", "subjects.mk", ""));
  88 # Get source directory
  89 my $srcdir = read_make_var("srcdir", "GNUmakefile");
  90 # Get info sources
  91 my @tsrc = grep(/\.t$/, split(' ' , read_make_var("src", "sources.mk")));
  92
  93 # Parse the .t files
  94 for my $t (@tsrc) {
  95     parse_file("$srcdir/$t");
  96 }
  97
  98 # Create %subject from %see_also
  99 for my $t (sort keys %desc) {
 100     parse_see_also($t);
 101 }
 102
 103 # Create the Subject.t files
 104 @Subjects = create_subjects();
 105
 106 # Update subjects.mk
 107 open(F, ">subjects.mk")
 108     or die "Can't open subjects.mk for writing: $!";
 109 print F "subjects := " . join(' ', @Subjects) . "\n";
 110 close(F);
 111
 112 exit 0;
 113
 114 # Read a variable value from a makefile
 115 sub read_make_var {
 116     my ($var, $fname, $dflt) = @_;
 117     my $val;
 118
 119     unless (open(F, "<$fname")) {
 120         return $dflt if $! == ENOENT and defined $dflt;
 121         die "Can't open $fname: $!";
 122     }
 123     while (<F>) {
 124         if (/^[ \t]*\Q$var\E[ \t]:?=*(.*)/) {
 125             $val = $1;
 126             last;
 127         }
 128     }
 129     close(F);
 130     $val or die "Can't find $var in $fname";
 131     return $val;
 132 }
 133
 134 # Check .TH, .NA, .LV and .SA.
 135 # Parse .NA into %desc and .SA into %see_also
 136 sub parse_file {
 137     ($filename) = @_;
 138     my $topic;
 139
 140     $topic = $filename;
 141     $topic =~ s,.*/([^/]*)\.t$,$1,;
 142
 143     open(F, "<$filename")
 144         or die "Can't open $filename: $!";
 145
 146     $_ = <F>;
 147     if (/^\.TH (\S+) (\S.+\S)$/) {
 148         if (!grep(/^$1$/, @Chapters)) {
 149             error("First argument to .TH was '$1', which is not a known chapter");
 150         }
 151         $chapter{$topic} = $1;
 152         if ($1 eq "Command" && $2 ne "\U$topic") {
 153             error("Second argument to .TH was '$2' but it should be '\U$topic'");
 154         }
 155     } else {
 156         error("The first line in the file must be a .TH request");
 157     }
 158
 159     $_ = <F>;
 160     if (/^\.NA (\S+) "(\S.+\S)"$/) {
 161         if ($topic ne $1) {
 162             error("First argument to .NA was '$1' but it should be '$topic'");
 163         }
 164         $desc{$topic} = $2;
 165     } else {
 166         error("The second line in the file must be a .NA request");
 167     }
 168
 169     $_ = <F>;
 170     if (/^\.LV (\S+)$/) {
 171         if ($1 ne 'Basic' && $1 ne 'Expert') {
 172             error("The argument to .LV was '$1' but it must be either 'Basic' or 'Expert'");
 173         }
 174         $level{$topic} = $1;
 175     } else {
 176         error("The third line in the file must be a .LV request");
 177     }
 178
 179     while (<F>) {
 180         last if /^\.SA/;
 181     }
 182
 183     if ($_) {
 184         if (/^\.SA "([^\"]*)"/) {
 185             $see_also{$topic} = $1;
 186             $sanr{$topic} = $.;
 187         } else {
 188             error("Incorrect .SA Syntax.  Syntax should be '.SA \"item1, item2\"'");
 189         }
 190
 191         while (<F>) {
 192             error("Multiple .SA requests.  Each file may contain at most one.") if /^\.SA/;
 193         }
 194     } else {
 195         error(".SA request is missing");
 196     }
 197
 198     close F;
 199 }
 200
 201 # Create %subject from %see_also
 202 sub parse_see_also {
 203     my ($topic) = @_;
 204     my @see_also = split(/, /, $see_also{$topic});
 205     my $wanted = $chapter{$topic};
 206     my $found;                 # found a subject?
 207
 208     $wanted = undef if $wanted eq 'Concept' or $wanted eq 'Command';
 209     $filename = "$srcdir/$topic";
 210
 211     for (@see_also) {
 212         if (!exists $desc{$_}) { # is this entry a subject?
 213             set_subject($_, $topic);
 214             $found = 1;
 215         }
 216         if ($wanted && $_ eq $wanted) {
 217             $wanted = undef;
 218         }
 219     }
 220
 221     $. = $sanr{$topic};
 222     error("No subject listed in .SA") unless $found;
 223     error("Chapter $wanted not listed in .SA") if $wanted;
 224 }
 225
 226 # Add a new entry to %subject and possibly to %largest
 227 sub set_subject {
 228     my ($sub, $topic) = @_;
 229     my $chap = $chapter{$topic};
 230     $subject{$sub}{$chap} .= "$topic\n";
 231     $largest{$sub} = "" unless defined $largest{$_};
 232     $largest{$sub} = $topic if length $topic > length $largest{$sub};
 233     $largest{$sub} = $chap if length $chap > length $largest{$_};
 234 }
 235
 236 # Create a Subject.t file
 237 sub create_subj {
 238     my ($subj) = @_;
 239     my $fname = "info/$subj.t";
 240
 241     print "WARNING: $subj is a NEW subject\n"
 242         unless grep(/^$subj$/, @Subjects);
 243     sysopen(SUBJ, $fname, O_WRONLY | O_EXCL | O_CREAT)
 244         or die "Unable to create $fname: $!\n";
 245
 246     print SUBJ '.\" DO NOT EDIT THIS FILE.  It was automatically generated by info.pl'."\n";
 247     print SUBJ ".TH Subject \U$subj\n";
 248     $largest{$subj} =~ s/-/M/g;
 249     print SUBJ ".in \\w'$largest{$subj}XX\\0\\0\\0\\0'u\n";
 250     for my $chap (@Chapters) {
 251         next unless exists $subject{$subj}{$chap};
 252         print SUBJ ".s1\n";
 253         for (split(/\n/, $subject{$subj}{$chap})) {
 254             print SUBJ ".L \"$_ ";
 255             if ($level{$_} eq 'Basic') {
 256                 print SUBJ "* \"\n";
 257             } else {
 258                 print SUBJ "  \"\n";
 259             }
 260             print SUBJ "$desc{$_}\n";
 261         }
 262     }
 263     print SUBJ <<EOF;
 264 .s1
 265 .in 0
 266 For info on a particular subject, type "info <subject>" where <subject> is
 267 one of the subjects listed above.  Subjects marked by * are the most
 268 important and should be read by new players.
 269 EOF
 270     close SUBJ;
 271 }
 272
 273 # Remove the old Subject.t files and create the Subject.t files and TOP.t
 274 sub create_subjects {
 275     my (@colsubj, @rowsubj, @subj);
 276
 277     for (@Subjects) {
 278         unlink "info/$_.t";
 279     }
 280     open(TOP, ">info/TOP.t")
 281         or die "Can't open info/TOP.t: $!";
 282     print TOP <<EOF;
 283 .TH Info "List of Subjects"
 284 .s1
 285 Empire info is available on the following subjects:
 286 .NF
 287 EOF
 288
 289     @rowsubj = sort keys %subject;
 290
 291     for my $subj (@Subjects) {
 292         print "WARNING: The subject $subj has been removed.\n"
 293             unless grep (/^$subj$/, @rowsubj);
 294     }
 295
 296     # reorder subjects for display in three columns
 297     my $k = 0;
 298     for my $i (0..2) {
 299         for (my $j = $i; $j <= $#rowsubj; $j += 3) {
 300             $colsubj[$j] = $rowsubj[$k++];
 301         }
 302     }
 303
 304     for my $subj (@colsubj) {
 305         create_subj($subj);
 306         push(@subj, $subj);
 307         if ($#subj > 1) {
 308             flush_subj(@subj);
 309             @subj = ();
 310         }
 311     }
 312     flush_subj(@subj);
 313     print TOP <<EOF;
 314 .FI
 315 Type "info <Subject>" where <Subject> is one of the subjects listed above.
 316 For a complete list of all info topics, type "info all".
 317 EOF
 318     close TOP;
 319     return @rowsubj;
 320 }
 321
 322 # Print a row of subjects to TOP
 323 sub flush_subj {
 324     return unless $#_ >= 0;
 325     print TOP "  ";
 326     for (@_) {
 327         printf TOP "%-25s", $_;
 328     }
 329     print TOP "\n";
 330 }
 331
 332 # Print an integrity error message and exit with code 1
 333 sub error {
 334     my ($error) = @_;
 335
 336     print STDERR "info.pl:$filename:$.: $error\n";
 337     exit 1;
 338 }