#!/usr/cs/bin/perl
### Change the above line to fit your system or type "perl tail.pl" ###

################################################################################
#
# File:    tail.pl   (Trav's Angband Index Linker)
#
# Purpose: Generates an index for Angband's online help.
#
# Authors:
#   - txe  Travis Emmitt  www.tripalot.com
#
# Modifications:
#   - 1999-02-13  txe  Idea inspired by conversation with my friend Miro!
#   - 1999-02-14  txe  (v1.0) Initial creation of tai.pl, ran under UNIX only
#   - 1999-02-15  txe  (v1.1) Changed name to tail.pl, added DOS support
#   - 2005-04-28  txe  (v1.2) Removed email references, improved help.
#
################################################################################

### global variables ###

$PROG_NAME = "tail.pl";
$VERSION   = "1.2";
$PLATFORM  = "DOS";    ### Change to "DOS" (for Windows too) or "UNIX" ###
$LIST_SIZE = 5;        ### max number of files to list for each term ###
$MAX_DEPTH = 5;        ### max depth of help tree in UNIX (no DOS limit) ###
$OUT_DIR   = "index";  ### output subdirectory (within help path) ###

################################################################################

my ($helpPath, $platform) = @ARGV;
my (%counts, %seqs, %links);

print getHeader();

if ($helpPath eq "") 
{
  die(getShortHelp());
}

# should be a call to setPlatform() #
$PLATFORM = ($platform ? $platform : $PLATFORM); ### allow user to override ###
$helpPath = fixPath($helpPath);                  ### platform-dependent ###

if (!-e $helpPath) 
{
  die("Error: path '$helpPath' does not exist on your system\n");
}

my $outDir  = getOutputDir();
my $outPath = fixPath("$helpPath/$outDir");
if (!-e $outPath) 
{
  &system2("mkdir $outPath");
}

&readFiles($helpPath,      \%counts);
&calculateLinks($helpPath, \%counts, \%seqs, \%links);
&writeIndex($helpPath,     \%counts, \%seqs);
&writeLinks($helpPath,     \%links);

print "Done.\n";
print getAddHelp($helpPath); 
1;


################################################################################
# access to options and settings
################################################################################

sub getListSize()
{
  return $LIST_SIZE;
}

sub getMaxDepth
{
  return $MAX_DEPTH;
}

sub getOutputDir
{
  return $OUT_DIR;
}

sub getPlatform
{
  return $PLATFORM;
}

sub getProgramName
{
  return $PROG_NAME;
}

sub getVersion
{
  return $VERSION;
}

sub getMainHelpFile
{
  my ($helpPath) = @_;
  my $outDir = getOutputDir();
  return fixPath("$helpPath/help.hlp");
}


################################################################################
# pretty output
################################################################################

sub getBar
{
  return "===================================================================\n";
}

###############################################################################

sub getAddHelp
{
  my ($helpPath)   = @_;
  my $mainHelpFile = getMainHelpFile($helpPath);
  return "\n"
       . getBar()
       . "In order to access the index from within the game, you'll need to\n"
       . "edit $mainHelpFile.  You only need to do this once.\n\n"
       . "1) Decide what key will display the index.\n"
       . "   -- e.g., I chose 'x'\n"
       . "   -- make sure no other help items use this key\n"
       . "\n"
       . "2) Add a line to help.hlp telling the user how to open the index.\n"
       . "   -- e.g., (x) Index (index/index.hlp)\n"
       . "   -- you should mimic the style of the help for consistency\n"
       . "\n"
       . "3) Add a line to help.hlp telling the game how to open the index.\n"
       . "   -- e.g., ***** [x] index/index.hlp\n"
       . "   -- make sure the ***** starts the line\n"
       . "   -- try putting this line after the other ***** lines\n"
       . "\n"
       . "4) Start the game, hit '?' for help, and see if the index works.\n"
       . "   Good luck!\n"
       . getBar();
}

###############################################################################

sub getHeader
{
  my $bar         = getBar();
  my $version     = getVersion();
  my $datetime    = localtime();
  my $programName = getProgramName();
  return "\n"
       . $bar 
       . "         TAIL (Trav's Angband Index Linker) - version $version\n"
       . "                  run on $datetime\n"
       . $bar 
       . "\n";
}

###############################################################################

sub getInstructions
{
  my $listSize = getListSize();
  return "Format:  <term> <link keys> <top $listSize files> <#occur>\n\n"
       . "Example: 'dog' [32] monsters/pets.txt 8\n"
       . "          - there are 8 occurances of 'dog' in pets.txt\n"
       . "          - you can view pets.txt by hitting '3' then '2'\n\n"
       . "Tips: Use / to search, ? to backup, #0 for top of file\n"
       . "      Use single quotes to search ('dog' instead of dog)\n";
}

###############################################################################

sub getShortHelp
{
  my $programName     = getProgramName();
  my $defaultPlatform = getPlatform();  # change later if I add getDefaultPlatform() #  
  return "  syntax: $programName <help_path> [platform] <-- defaults to $defaultPlatform\n"
       . " example: $programName zangband/lib/help\n\n" . getBar(); 
}


################################################################################
# Reads terms from files in help path.  (recursively looks at subdirectories)
################################################################################

sub readFiles 
{
  my ($helpPath, $line, $term, $i, $j, $numFiles);
  ($helpPath, *counts) = @_;

  my @paths    = (fixPath("$helpPath"));
  my $numPaths = @paths;
  my $platform = getPlatform();
  my $maxDepth = getMaxDepth();
    
  for ($i = 0; $paths[$i] ne ""; $i++) 
  {
    print "\nLocating files in path '$paths[$i]'\n";
  
    my $inPath     = $paths[$i];
    my @inFiles    = getRelativeFilesInPath($inPath);   
    my $numInFiles = @inFiles;

    for ($j = 0; $j < $numInFiles; $j++)
    {
      my $relativeFile = $inFiles[$j];
      my $inFile       = fixPath($inPath . "/" . $relativeFile);
          
      if ($platform eq "DOS" && !open(IN, "<$inFile")) 
      {
        $paths[$numPaths++] = fixPath($inFile);
        printf "  * queueing '%s'\n", $paths[$numPaths-1];
        next;
      }
      
      if ($inFile =~ /index/) 
      {
        print "  skipping likely index file: '$inFile'\n";
        next;
      }

      printf "  Reading terms from '$inFile' [%d]\n", $numFiles++;

      open(IN, "<$inFile") || die("Error reading '$inFile'\n");

      while ($line = <IN>) 
      {
        foreach $term (split(/\s+/, $line)) 
        {
          if ($term =~ /(\.|\/|\\)\w/) 
          {
            next;
          }
          $term = lc($term);            ### lower case ###
          $term =~ s/[^a-z]//g;         ### remove all non-letters ###
          $counts{$term}{$relativeFile} ++;
        }
      }
      close(IN);
      delete $counts{""}{$relativeFile};
    }

    if ($platform eq "UNIX" && $i < $maxDepth) 
    {
      $paths[$numPaths++] = fixPath("$paths[$i]");
      printf "  * queueing '%s'\n", $paths[$numPaths-1];
    }
  }
}


################################################################################
# returns list of files in path (filenames do not contain path)
################################################################################

sub getRelativeFilesInPath
{
  my ($helpPath) = @_;  
  my ($i, $j, @realFilenames);

  $helpPath = fixPath($helpPath);
  
  if (!(-e $helpPath))
  {
    die("Path does not exist: $helpPath");
  }
  else
  {  
    opendir(DIR, "$helpPath") || die("Error opening directory '$helpPath'");
    my @filenames = readdir(DIR);
    closedir(DIR);

    my $numFiles = @filenames;

    for ($i = 0; $i < $numFiles; $i++)
    {
      my $filename = $filenames[$i];
      if (($filename ne ".") && ($filename ne ".."))
      {
        $realFilenames[$j++] = $filename;
      }
    }
  }
  return @realFilenames;
}


################################################################################
# Calculates sequences of links needed to take user to relevant file 
################################################################################

sub calculateLinks 
{
  my ($helpPath, $term, $i, $target);
  ($helpPath, *counts, *seqs, *links) = @_;
  %seqs = ();
  my $outDir = getOutputDir();

  print "\nSorting and counting files...\n";
 
  foreach $term (keys(%counts)) 
  {
    foreach $target (keys(%{$counts{$term}})) 
    {
      $seqs{$target} = "ORIGINAL";
    }
  }
  
  my @targets  = sort(keys(%seqs));
  my $numFiles = @targets; 
  
  if ($numFiles == 0)
  {  
    die("Error: numFiles = 0; this is indicative of a programming error");
  }

  my $numDigits = int (log($numFiles) / log(10)) + 1;

  print "\nCalculating sequences...\n";

  for ($i = 0; ($target = $targets[$i]); $i++) 
  {
    if ($seqs{$target} eq "ORIGINAL") 
    {
      $seqs{$target} = sprintf "\%0${numDigits}d", $i;
    }
    my $pre = $seqs{$target};
    chop($pre);
    my $linker = "$outDir/index$pre.hlp";

    if ($seqs{$linker} eq "") 
    {
      if (!($linker =~ /index.hlp/)) 
      {
        $targets[$numFiles++] = $linker;
        $seqs{$linker} = $pre;
      }
      else 
      {
        $seqs{$linker} = "INDEX";
      }
      print "\n";
    }

    my $cmd = $seqs{$target};
    $cmd =~ s/$pre//;
    my $line = "[$cmd] $target";

    $links{$linker} .= " $line\n";
    print "  $linker\t$line\n";
  }
}


###############################################################################
# Writes the actual index (large) to index.hlp
###############################################################################

sub writeIndex 
{
  my ($helpPath, $term, $i, $temp);
  ($helpPath, *counts, *seqs) = @_;
  my $listSize = getListSize();
  my $outFile  = fixPath("$helpPath/$OUT_DIR/index.hlp");

  print "\nWriting index to '$outFile'\n";

  open(OUT, ">$outFile") || die ("Error writing index to '$outFile'\n");
  print OUT getHeader() . getInstructions() . getBar();

  foreach $term (sort(keys(%counts))) 
  {
    my @files = sort {$counts{$term}{$b} <=> $counts{$term}{$a}} (keys(%{$counts{$term}}));
    $files[$listSize] = "";
    my $temp = sprintf "\n%25s ", "'$term'";

    for ($i = 0; ($target = $files[$i]); $i++, $temp = sprintf "%26s", "") 
    {
      printf OUT "$temp [$seqs{$target}] %-30s $counts{$term}{$target}\n", $target;
    }
  }
  close(OUT);
}


###############################################################################
# Writes linking commands to all of the links files.  Appends to index.hlp.
###############################################################################

sub writeLinks 
{
  my ($helpPath);
  ($helpPath, *links) = @_;

  print "\nCreating links files:\n";

  foreach $linker (sort(keys(%links))) 
  {
    my $linkFile = fixPath("$helpPath/$linker");
    my $hidden   = $links{$linker};
    $hidden      =~ s/ \[/***** \[/g;

    if (!($linker =~ /index.hlp/)) 
    {
      unlink($linkFile);
    }
    print "  Writing links to '$linkFile'\n";

    open(OUT, ">>$linkFile") || die ("Error writing to '$linkFile'\n");
    print OUT getHeader() . "\n$links{$linker}\n$hidden\n";
    close(OUT);
  }
}


###############################################################################
# Converts filename into something legal on this platform.
###############################################################################

sub fixPath 
{
  my ($name) = @_;
  my $platform = getPlatform();

  if ($platform eq "DOS") 
  {
    $name =~ s/\//\\/g;         ### change all / to \ ###
    $name =~ s/\\\\/\\/g;       ### remove duplicates ###
  }
  elsif ($platform eq "UNIX") 
  {
    $name =~ s/\\/\//g;         ### change all \ to / ###
    $name =~ s/\/\//\//g;       ### remove duplicates ###
  }
  else 
  {
    die("Error: invalid platform '$platform'\n");
  }
  return $name;
}

###############################################################################

sub system2
{
  my ($command) = @_;
  $command = fixPath($command);
  return system($command);
}

###############################################################################
###############################################################################