#!/usr/local/bin/perl
#
#                                 info.pl
#        
#               Create Subjects/Subject.t files from the Info Pages.
#
#                           written by Ken Stevens
#
#
# DESCRIPTION:
# info.pl reads all of the info pages and creates a table of contents
# for them organized by subject.  An info page belongs to a subject if
# that subject appears as an entry in the .SA ("SEE ALSO") field of the
# info page _and_ that entry is not the name of another info page.
# 
# For example, the .SA field of headlines.t contains the entries
# "newspaper" and "Communication".  Since there's already an info page
# called "newspaper.t", but there is no "Communication" info page, then
# the headlines info page is considered to be a member of the
# Communication subject.
#
# An info page may belong to more than one subject, and if it belongs
# to no subject, then its subject will be set to the name of the subdirectory
# it is in (e.g. the Server and Information info pages work this way).
# 
# The output of this script is a bunch of files in the "Subjects"
# subdirectory.  The file Subjects/TOP.t is the toplevel table of
# contents and lists all of the subjects.  This is what the player
# sees when they type "info".  Then for each subject, a
# Subjects/Subject.t file is created, listing all of the info pages that
# belong to that subject.
#
# INSTALLATION:
# info.pl requires perl5 to run.  If you don't have version 5 of perl, then
# you'll either have to install it, or you'll have to get someone to create
# your Subjects.t files for you.
#
# HOW TO RUN IT:
# Type "info.pl" at the unix prompt.
#
# BUG REPORTS:
# mail your bug-reports and comments to:
# Ken Stevens <children@empire.net>

#       --- Glossary ---
# item.t          An info page file
# item            An info page
# Subject         An entry in a SEE ALSO entry which is not an item
# subdirectory    Where the info files are kept
#
#       --- Global variables ---
# @dirs           Subdirectories of info directory containing item.t files
# @Subjects       Subjects which already exist (as Subjects/Subject.t)
# $dir            The current subdirectory we're working in
# $filename       The name of an item.t file
# $filedir{$filename}
#                 The subdirectory item.t is in
# F               Filehandle for item.t
# $desc{$filename}
#                 A one line description of the item (second arg to .NA)
# $level{$filename}
#                 The difficulty level of the page.  At present either
#                 Basic or Expert.
# $see_also{$filename}
#                 A list of SEE ALSO items for the file (.SA argument)
# $subj           A subject
# SUBJ            Filehandle for Subject.t
# $subject{$subj}{$dir} = "item1\nitem2\n..."
#                 Items in that subject organized by directory.
# $largest{$sub}  The largest item in that subject (used for column formatting)
# TOP             Filehandle for Subjects/TOP.t
# @rowsubj        List of subjects
# @colsubj        List of subjects organized into 3 columns
#
#     --- Functions ---
#
# read_subjects   Get list of current subjects
# parse_files     Parse all the item.t files in one $dir
# parse_file      Check the .TH, .NA, and .SA fields & parse them
# parse_see_also  Create %subject from %see_also
# set_subject     Add a new entry to %subject and possibly to %largest
# create_subj     Create a Subject.t file
# create_subjects Remove the old Subject.t files and create new ones
# flush_subj      Print a row of Subjects to TOP
# error           Print an integrity error to STDERR and exit with code 1.

use strict;
use warnings;

our (@dirs, $dir, $filename, %filedir, @Subjects, $type, %desc, %level);
our (%see_also, %subject, %largest, $subj, @rowsubj, @colsubj, @subj);

eval("require 5");		# Test for perl version 5
die "info.pl requires version 5 of perl.\n" if $@;

# These are the directories which contain item.t files:
@dirs = ('Commands', 'Concepts', 'Server', 'Introduction');

# Get list of current subjects
&read_subjects;

# Parse the item.t files in each info directory
for $dir (@dirs) {
  &parse_files;
}

# Create %subject from %see_also
for $filename (sort keys %filedir) {
  &parse_see_also;
}

# Create the Subject.t files
&create_subjects;

exit 0;

# Get list of current subjects
sub read_subjects {
  open (LS, "ls Subjects|");

  while (<LS>) {    
    chop;
    next unless /^(\S+).t/;
    push(@Subjects, $1);
  }
  close LS;
}

# Parse all the item.t files in one $dir with lots of integrity checks
sub parse_files {
  local ($type) = $dir;
  chop($type) unless $type eq "Server" || $type eq "Introduction";

  if (defined $filedir{$dir}) {
    $filename = $dir;
    &error("Illegal filename (it is a directory name).");
  } elsif (defined $filedir{$type}) {
    $filename = $type;
    &error("Illegal filename (it is a type name).");
  }

  open (LS, "cd $dir && ls *.t|");

  while (<LS>) {    
    chop;
    $filename = $_;
    &parse_file;
  }
  close LS;
}

# Check the .TH, .NA, and .SA fields.
# Parse .NA into %desc and .SA into %see_also
sub parse_file {
  $filename =~ s/\.t$//;

  if (grep (/^$filename$/, @dirs)) {
    &error("Illegal filename.  $filename is a name of a subdirectory of the info directory.");
  }
  if ($filedir{$filename}) {
    &error("$filename.t is in both $filedir{$filename} and $dir");
  } elsif (grep (/^$filename$/, @Subjects)) {
    &error("Illegal filename.  $filename is already a Subject name.");
  } else {
    $filedir{$filename} = $dir;
  }

  die "Can't open $dir/$filename.t\n" unless open(F, "<$dir/$filename.t");
  
  $_ = <F>;
  if (/^\.TH (\S+) (\S.+\S)$/) {
    if ($1 ne $type) {
      &error("First argument to .TH was '$1' but it should be '$type'");
    }
    if ($type eq "Command" && $2 ne "\U$filename") {
      &error("Second argument to .TH was '$2' but it should be '\U$filename'");
    }
  } else {
    &error("The first line in the file must be a .TH entry");
  }
  $_ = <F>;
  if (/^\.NA (\S+) "(\S.+\S)"$/) {
    if ($filename ne $1) {
      &error("First argument to .NA was '$1' but it should be '$filename'");
    }
    $desc{$filename} = $2;
  } else {
    &error("The second line in the file must be an .NA entry");
  }
  $_ = <F>;
  if (/^\.LV (\S+)$/) {
    if ($1 ne 'Basic' && $1 ne 'Expert') {
      &error("The argument to .LV was '$1' but it must be either 'Basic' or 'Expert'");
    }
    $level{$filename} = $1;
  } else {
    &error("The third line in the file must be a .LV entry");
  }
  while (<F>) {
    last if /^\.SA/;
  }
  if ($_) {
    if (/^\.SA "([^\"]*)"/) {
      $see_also{$filename} = $1;
    } else {
      &error("Incorrect .SA Syntax.  Syntax should be '.SA \"item1, item2\"'");
    }
    while (<F>) {
      &error("Multiple .SA entries.  Each file may contain at most one .SA entry") if /^\.SA/;
    }
  }
  close F;
}

# Create %subject from %see_also
sub parse_see_also {
  my (@see_also) = split(/, /, $see_also{$filename});
  local ($dir) = $filedir{$filename};
  my ($found);		# Does this item belong to any Subject?

  for (@see_also) {
    if (!(defined $filedir{$_})) { # is this entry a subject?
      &set_subject;
      $found = 1;
    }
  }

  &error("No Subject listed in .SA field") unless $found;
}

# Add a new entry to %subject and possibly to %largest
sub set_subject {
  $subject{$_}{$dir} .= "$filename\n";
  $largest{$_} = "" unless defined $largest{$_};
  $largest{$_} = $filename if length $filename > length $largest{$_};
  $largest{$_} = $dir if length $dir > length $largest{$_};
}

# Create a Subject.t file
sub create_subj {
  print "  Creating Subjects/$subj.t\n";
  print "WARNING: $subj is a NEW subject\n" unless
    grep(/^$subj$/, @Subjects);
  die "Unable to write to Subjects/$subj.t\n" unless
    open(SUBJ, ">Subjects/$subj.t");

  print SUBJ '.\" DO NOT EDIT THIS FILE.  It was automatically generated by info.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 $dir (keys %{$subject{$subj}}) {
    print SUBJ ".s1\n";
    for (split(/\n/, $subject{$subj}{$dir})) {
      print SUBJ ".L \"$_ ";
      if ($level{$_} eq 'Basic') {
	print SUBJ "* \"\n";
      } else {
	print SUBJ "  \"\n";
      }
      print SUBJ "$desc{$_}\n";
    }
  }
  print SUBJ <<EOF;
.s1
.in 0
For info on a particular subject, type "info <subject>" where <subject> is
one of the subjects listed above.  Subjects marked by * are the most
important and should be read by new players.
EOF
  close SUBJ;
}

# Remove the old Subject.t files and create the Subject.t files and TOP.t
sub create_subjects {
  print "  Removing Subjects/*.t\n";
  `rm -f Subjects/*.t`;
  print "  Creating Subjects/TOP.t\n";
  die "Can't open Subjects/TOP.t" unless open(TOP, ">Subjects/TOP.t");
  print TOP <<EOF;
.TH Info "List of Subjects"
.s1
Empire info is available on the following subjects:
.NF
EOF

  @rowsubj = sort keys %subject;

  for $subj (@Subjects) {
    print "WARNING: The subject $subj has been removed.\n" unless
      $subj eq 'TOP' || grep (/^$subj$/, @rowsubj);
  }

  my $k = 0;
  for my $i (0..2) {
    for (my $j = $i; $j <= $#rowsubj; $j += 3) {
      $colsubj[$j] = $rowsubj[$k++];
    }
  }

  for $subj (@colsubj) {
    &create_subj;
    push(@subj, $subj);
    &flush_subj if $#subj > 1;
  }
  &flush_subj;
  print TOP <<EOF;
.FI
Type "info <Subject>" where <Subject> is one of the subjects listed above.
For a complete list of all info topics, type "info all".
EOF
  close TOP;
}

# Print a row of subjects to TOP
sub flush_subj {
  return unless $#subj >= 0;
  print TOP "  ";
  for (@subj) {
    printf TOP "%-25s", $_;
  }
  print TOP "\n";
  @subj = ();
}

# Print an integrity error message and exit with code 1
sub error {
  my ($error) = @_;

  print STDERR "Error on line $. of $filedir{$filename}/$filename.t:\n";
  print STDERR "$_";
  print STDERR "\n" unless /\n$/;
  print STDERR "$error\n";
  exit 1;
}