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

   1 #!/usr/local/bin/perl
   2 #
   3 #                                 info.pl
   4 #
   5 #               Create Subjects/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.  An info page belongs to a subject if
  13 # that subject appears as an entry in the .SA ("SEE ALSO") field of the
  14 # info page _and_ that entry is not the name of another info page.
  15 #
  16 # For example, the .SA field of headlines.t contains the entries
  17 # "newspaper" and "Communication".  Since there's already an info page
  18 # called "newspaper.t", but there is no "Communication" info page, then
  19 # the headlines info page is considered to be a member of the
  20 # Communication subject.
  21 #
  22 # An info page may belong to more than one subject, and if it belongs
  23 # to no subject, then its subject will be set to the name of the subdirectory
  24 # it is in (e.g. the Server and Information info pages work this way).
  25 #
  26 # The output of this script is a bunch of files in the "Subjects"
  27 # subdirectory.  The file Subjects/TOP.t is the toplevel table of
  28 # contents and lists all of the subjects.  This is what the player
  29 # sees when they type "info".  Then for each subject, a
  30 # Subjects/Subject.t file is created, listing all of the info pages that
  31 # belong to that subject.
  32 #
  33 # INSTALLATION:
  34 # info.pl requires perl5 to run.  If you don't have version 5 of perl, then
  35 # you'll either have to install it, or you'll have to get someone to create
  36 # your Subjects.t files for you.
  37 #
  38 # HOW TO RUN IT:
  39 # Type "info.pl" at the unix prompt.
  40 #
  41 # BUG REPORTS:
  42 # mail your bug-reports and comments to:
  43 # Ken Stevens <children@empire.net>
  44
  45 #       --- Glossary ---
  46 # item.t          An info page file
  47 # item            An info page
  48 # Subject         An entry in a SEE ALSO entry which is not an item
  49 # subdirectory    Where the info files are kept
  50 #
  51 #       --- Global variables ---
  52 # @dirs           Subdirectories of info directory containing item.t files
  53 # @Subjects       Subjects which already exist (as Subjects/Subject.t)
  54 # $dir            The current subdirectory we're working in
  55 # $filename       The name of an item.t file
  56 # $filedir{$filename}
  57 #                 The subdirectory item.t is in
  58 # F               Filehandle for item.t
  59 # $desc{$filename}
  60 #                 A one line description of the item (second arg to .NA)
  61 # $level{$filename}
  62 #                 The difficulty level of the page.  At present either
  63 #                 Basic or Expert.
  64 # $see_also{$filename}
  65 #                 A list of SEE ALSO items for the file (.SA argument)
  66 # $subj           A subject
  67 # SUBJ            Filehandle for Subject.t
  68 # $subject{$subj}{$dir} = "item1\nitem2\n..."
  69 #                 Items in that subject organized by directory.
  70 # $largest{$sub}  The largest item in that subject (used for column formatting)
  71 # TOP             Filehandle for Subjects/TOP.t
  72 # @rowsubj        List of subjects
  73 # @colsubj        List of subjects organized into 3 columns
  74 #
  75 #     --- Functions ---
  76 #
  77 # read_subjects   Get list of current subjects
  78 # parse_files     Parse all the item.t files in one $dir
  79 # parse_file      Check the .TH, .NA, and .SA fields & parse them
  80 # parse_see_also  Create %subject from %see_also
  81 # set_subject     Add a new entry to %subject and possibly to %largest
  82 # create_subj     Create a Subject.t file
  83 # create_subjects Remove the old Subject.t files and create new ones
  84 # flush_subj      Print a row of Subjects to TOP
  85 # error           Print an integrity error to STDERR and exit with code 1.
  86
  87 use strict;
  88 use warnings;
  89
  90 our (@dirs, $dir, $filename, %filedir, @Subjects, $type, %desc, %level);
  91 our (%see_also, %subject, %largest, $subj, @rowsubj, @colsubj, @subj);
  92
  93 eval("require 5");              # Test for perl version 5
  94 die "info.pl requires version 5 of perl.\n" if $@;
  95
  96 # These are the directories which contain item.t files:
  97 @dirs = ('Commands', 'Concepts', 'Server', 'Introduction');
  98
  99 # Get list of current subjects
 100 &read_subjects;
 101
 102 # Parse the item.t files in each info directory
 103 for $dir (@dirs) {
 104   &parse_files;
 105 }
 106
 107 # Create %subject from %see_also
 108 for $filename (sort keys %filedir) {
 109   &parse_see_also;
 110 }
 111
 112 # Create the Subject.t files
 113 &create_subjects;
 114
 115 exit 0;
 116
 117 # Get list of current subjects
 118 sub read_subjects {
 119   open (LS, "ls Subjects|");
 120
 121   while (<LS>) {
 122     chop;
 123     next unless /^(\S+).t/;
 124     push(@Subjects, $1);
 125   }
 126   close LS;
 127 }
 128
 129 # Parse all the item.t files in one $dir with lots of integrity checks
 130 sub parse_files {
 131   local ($type) = $dir;
 132   chop($type) unless $type eq "Server" || $type eq "Introduction";
 133
 134   if (defined $filedir{$dir}) {
 135     $filename = $dir;
 136     &error("Illegal filename (it is a directory name).");
 137   } elsif (defined $filedir{$type}) {
 138     $filename = $type;
 139     &error("Illegal filename (it is a type name).");
 140   }
 141
 142   open (LS, "cd $dir && ls *.t|");
 143
 144   while (<LS>) {
 145     chop;
 146     $filename = $_;
 147     &parse_file;
 148   }
 149   close LS;
 150 }
 151
 152 # Check the .TH, .NA, and .SA fields.
 153 # Parse .NA into %desc and .SA into %see_also
 154 sub parse_file {
 155   $filename =~ s/\.t$//;
 156
 157   if (grep (/^$filename$/, @dirs)) {
 158     &error("Illegal filename.  $filename is a name of a subdirectory of the info directory.");
 159   }
 160   if ($filedir{$filename}) {
 161     &error("$filename.t is in both $filedir{$filename} and $dir");
 162   } elsif (grep (/^$filename$/, @Subjects)) {
 163     &error("Illegal filename.  $filename is already a Subject name.");
 164   } else {
 165     $filedir{$filename} = $dir;
 166   }
 167
 168   die "Can't open $dir/$filename.t\n" unless open(F, "<$dir/$filename.t");
 169
 170   $_ = <F>;
 171   if (/^\.TH (\S+) (\S.+\S)$/) {
 172     if ($1 ne $type) {
 173       &error("First argument to .TH was '$1' but it should be '$type'");
 174     }
 175     if ($type eq "Command" && $2 ne "\U$filename") {
 176       &error("Second argument to .TH was '$2' but it should be '\U$filename'");
 177     }
 178   } else {
 179     &error("The first line in the file must be a .TH entry");
 180   }
 181   $_ = <F>;
 182   if (/^\.NA (\S+) "(\S.+\S)"$/) {
 183     if ($filename ne $1) {
 184       &error("First argument to .NA was '$1' but it should be '$filename'");
 185     }
 186     $desc{$filename} = $2;
 187   } else {
 188     &error("The second line in the file must be an .NA entry");
 189   }
 190   $_ = <F>;
 191   if (/^\.LV (\S+)$/) {
 192     if ($1 ne 'Basic' && $1 ne 'Expert') {
 193       &error("The argument to .LV was '$1' but it must be either 'Basic' or 'Expert'");
 194     }
 195     $level{$filename} = $1;
 196   } else {
 197     &error("The third line in the file must be a .LV entry");
 198   }
 199   while (<F>) {
 200     last if /^\.SA/;
 201   }
 202   if ($_) {
 203     if (/^\.SA "([^\"]*)"/) {
 204       $see_also{$filename} = $1;
 205     } else {
 206       &error("Incorrect .SA Syntax.  Syntax should be '.SA \"item1, item2\"'");
 207     }
 208     while (<F>) {
 209       &error("Multiple .SA entries.  Each file may contain at most one .SA entry") if /^\.SA/;
 210     }
 211   }
 212   close F;
 213 }
 214
 215 # Create %subject from %see_also
 216 sub parse_see_also {
 217   my (@see_also) = split(/, /, $see_also{$filename});
 218   local ($dir) = $filedir{$filename};
 219   my ($found);          # Does this item belong to any Subject?
 220
 221   for (@see_also) {
 222     if (!(defined $filedir{$_})) { # is this entry a subject?
 223       &set_subject;
 224       $found = 1;
 225     }
 226   }
 227
 228   &error("No Subject listed in .SA field") unless $found;
 229 }
 230
 231 # Add a new entry to %subject and possibly to %largest
 232 sub set_subject {
 233   $subject{$_}{$dir} .= "$filename\n";
 234   $largest{$_} = "" unless defined $largest{$_};
 235   $largest{$_} = $filename if length $filename > length $largest{$_};
 236   $largest{$_} = $dir if length $dir > length $largest{$_};
 237 }
 238
 239 # Create a Subject.t file
 240 sub create_subj {
 241   print "  Creating Subjects/$subj.t\n";
 242   print "WARNING: $subj is a NEW subject\n" unless
 243     grep(/^$subj$/, @Subjects);
 244   die "Unable to write to Subjects/$subj.t\n" unless
 245     open(SUBJ, ">Subjects/$subj.t");
 246
 247   print SUBJ '.\" DO NOT EDIT THIS FILE.  It was automatically generated by info.pl'."\n";
 248   print SUBJ ".TH Subject \U$subj\n";
 249   $largest{$subj} =~ s/-/M/g;
 250   print SUBJ ".in \\w'$largest{$subj}XX\\0\\0\\0\\0'u\n";
 251   for $dir (keys %{$subject{$subj}}) {
 252     print SUBJ ".s1\n";
 253     for (split(/\n/, $subject{$subj}{$dir})) {
 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   print "  Removing Subjects/*.t\n";
 276   `rm -f Subjects/*.t`;
 277   print "  Creating Subjects/TOP.t\n";
 278   die "Can't open Subjects/TOP.t" unless open(TOP, ">Subjects/TOP.t");
 279   print TOP <<EOF;
 280 .TH Info "List of Subjects"
 281 .s1
 282 Empire info is available on the following subjects:
 283 .NF
 284 EOF
 285
 286   @rowsubj = sort keys %subject;
 287
 288   for $subj (@Subjects) {
 289     print "WARNING: The subject $subj has been removed.\n" unless
 290       $subj eq 'TOP' || grep (/^$subj$/, @rowsubj);
 291   }
 292
 293   my $k = 0;
 294   for my $i (0..2) {
 295     for (my $j = $i; $j <= $#rowsubj; $j += 3) {
 296       $colsubj[$j] = $rowsubj[$k++];
 297     }
 298   }
 299
 300   for $subj (@colsubj) {
 301     &create_subj;
 302     push(@subj, $subj);
 303     &flush_subj if $#subj > 1;
 304   }
 305   &flush_subj;
 306   print TOP <<EOF;
 307 .FI
 308 Type "info <Subject>" where <Subject> is one of the subjects listed above.
 309 For a complete list of all info topics, type "info all".
 310 EOF
 311   close TOP;
 312 }
 313
 314 # Print a row of subjects to TOP
 315 sub flush_subj {
 316   return unless $#subj >= 0;
 317   print TOP "  ";
 318   for (@subj) {
 319     printf TOP "%-25s", $_;
 320   }
 321   print TOP "\n";
 322   @subj = ();
 323 }
 324
 325 # Print an integrity error message and exit with code 1
 326 sub error {
 327   my ($error) = @_;
 328
 329   print STDERR "Error on line $. of $filedir{$filename}/$filename.t:\n";
 330   print STDERR "$_";
 331   print STDERR "\n" unless /\n$/;
 332   print STDERR "$error\n";
 333   exit 1;
 334 }