#!/usr/bin/perl

#
# This program marks up the V3.5 SRD with handy cross-reference links.
# It is pretty fragile.
#
# TO-DO LIST:
#   Export characters in simple HTML
#   Create index pages.
#   Create A-Z lists at the top of certain pages
#   Create a scheme such that if a heading is defined in more than one place,
#     created links are directed to the closer one (or the user intervenes).
#   Prevent modification of lines between <a ...> and </a>
#
use strict;
use IO::Handle;

sub TitleCase
{
    my $parm = shift;

    my @words = split(' ', $parm);

    my $result = join(' ', map { ucfirst lc } @words);

    return $result;
}

# This causes status messages to be displayed immediately,
# but comes at the price of decreased output performance on
# STDOUT (boo-hoo).
autoflush STDOUT 1;

# The place to find the original files
my $html_dir = "/cygdrive/c/palmSRD/orig";

# The place to put the processed files
my $out_dir = "/cygdrive/c/palmSRD/html";

rmdir $out_dir || "Can't delete directory '$out_dir'\n";

mkdir $out_dir || die "Can't create output directory '$out_dir'\n";

chdir $out_dir || die "Can't change to directory '$html_dir'\n";

my @orig_files = glob "$html_dir/*.html";

# Make a copy of the original files so that we don't damange them.
`cp @orig_files $out_dir`;

# The list of all files
my @all_files = glob "*.html";

# Global variable used to hold the mappings from a target
# word or phrase to the anchor tag where that word or phrase
# is defined.
my %target_to_link;

#
# Global variable containing list of all indices produced.
#
my @indices;

#
# Get rid of all of the font tags with size=5 or size=3.
#
sub NukeFontTags
{
  print "Removing FONT tags:";

# The list of files containing target definitions
  my @target_files = glob "*.html";

# The file currently being processed.
  my $filename;
  my $outfilename = "temp";

  for $filename (@target_files) {
    my $IN;
    my $OUT;

    $filename =~ m/(.)/;
    print uc $1;
    open IN, $filename || die "Can't open file '$filename'\n";

    open OUT, ">$outfilename" || die "Can't open output file '$outfilename'\n";

    my $line;

    while ($line = <IN>) {
      my @tagList = ();
      push @tagList, "dummy";
# Nuke all font tags
      while ($line =~ s/(\<font size\=\"[2]\"\>.*?\<\/font\>)/QQQ$#tagList/i) {
	push @tagList, $1;
      }

      $line =~ s/\<font size\s*\=\s*\"[345]\"\s*\>//gi;
      $line =~ s/\<\/font\>//gi;

      while ($line =~ s/(<font size\=\"2\"\>[^\<]+)/RRR$#tagList/i) {
	push @tagList, $1;
      }

      while ($line =~ s/<\/?font.*?>//ig) {
      }

      if ($line =~ /\<.?font.*?\>/i) {
	print "Still a font tag in $filename: '$line'\n";
      }

      while ($line =~ s/QQQ([0-9]+)/@tagList[$1+1]/) {
      }

      if ($line =~ /QQQ/) {
	print "QQQ Still in $filename: '$line'\n";
      }

#      $line =~ s/QQQ/$fonttag/;


      while ($line =~ s/RRR([0-9]+)/@tagList[$1+1]\<\/font\>/) {
      }

      if ($line =~ /RRR/) {
	print "RRR Still in $filename: '$line'\n";
      }

#      $line =~ s/RRR/$fonttag2\<\/font\>/;
      print OUT $line;
    }
    close IN;
    close OUT;

# Replace input with output
    rename $outfilename, $filename || die "Can't rename '$outfilename' to '$filename'\n";

  }
  print "\n";
}


#
# Find all the items worth indexing.  These are identified
# by having a <br> tag BY ITS SELF on the preceding line,
# and this line being terminated by a <br>
#
sub TagDestinations 
{
  my $prefix = shift;

  print "Creating anchors for $prefix.";

# The list of files containing target definitions
  my @target_files = glob "$prefix*.html";

# The file currently being processed.
  my $filename;
  my $outfilename = "temp";

  my %mapping;

  for $filename (@target_files) {
    my $IN;
    my $OUT;

    print ".";
    open IN, $filename || die "Can't open file '$filename'\n";

    open OUT, ">$outfilename" || die "Can't open output file '$outfilename'\n";

    my $line;

    while ($line = <IN>) {
      if ($line =~ /^\<br\>\r?$/) {
	$line = <IN> || die "Can't read.\n";


#	if ($line =~ /([^\<\>\(\)\[\]]{2,})\s*.*\<br\>/) {

	if ($line =~ /((armor proficiency \(\w+\))|^([^\<\>\(\)\[\]]{2,}))(\s*.*)\<br\>(.*)/i) {
#
# $1 contains the name of a target.  Save it for later and also
# mark it up as a header and a destination tag.
#
	  my $rest_of_name = $4;
	  my $target_name = &TitleCase($1);
	  my $everythingElse = $5;

	  if (length $target_name > 50) {
	    print OUT $line;
	  }
	  else {

# Use all lower-case for keys for consistency
	    my $lc_target_name = lc $target_name;

	    my $tag_name = "__$lc_target_name,,";
	    $tag_name =~ s/[ ,\"\'\(\)]/_/g;

#	  print "    $target_name\t";

# Create the mapping from key to link
	    $mapping{$lc_target_name} 
	    = "<a href=\"$filename\#$tag_name\">$target_name</a>";
#	  print "$mapping{$lc_target_name}\n";
	    print OUT "\n<h5><a name=\"$tag_name\">$target_name$rest_of_name</a></h5>\n$everythingElse";
#	    print OUT "\n<br><br><b><a name=\"$tag_name\">*$target_name</a>$2</b><br>\n$3";

# If this target has a comma in it, then create the
# mapping for the non-comma'd version.
# e.g. Stoneskin, Greater => Greater Stoneskin
# Create the mapping from key to link
	    if ($lc_target_name =~ /([^,]+)\,\s*(.+)/) {
	      my $alt_target_name = "$2 $1";

	      $mapping{$alt_target_name} 
	      = "<a href=\"$filename\#$tag_name\">$target_name</a>";
#	    print "    $alt_target_name\t";
#	    print "$mapping{$alt_target_name}\n";
	    }
	  }
	}
      }
      else {
	print OUT $line;
      }
    }
    close IN;
    close OUT;

# Replace input with output
    rename $outfilename, $filename || die "Can't rename '$outfilename' to '$filename'\n";

  }
  print "\n";

#
# Create an index file for these topics.
#
  &CreateIndexPage($prefix, \%mapping);
#
# Merge the mapping for this fileset into the master map.
#
  for my $key (keys %mapping) {
      $target_to_link{$key} =  $mapping{$key};
  }
}


sub MarkupLinks
{
    my $fileList = shift || "*.html";

  my $target_matcher = join('|', reverse sort { length($a) <=> length($b) } keys(%target_to_link));

  $target_matcher =~ s/\(/\\\(/g;
  $target_matcher =~ s/\)/\\\)/g;

  $target_matcher = "($target_matcher)";

  print "Marking up links";

# The list of files containing target definitions
  my @target_files = glob $fileList;

  foreach (@target_files) {
      m/^(.)/;
      print "$1";
  }

  print "\n";
  print "Progress so far:";

#  print $target_matcher;
#  exit;


# The file currently being processed.
  my $filename;
  my $outfilename = "temp";

  for $filename (@target_files) {
    my $IN;
    my $OUT;

    open IN, $filename || die "Can't open file '$filename'\n";

    open OUT, ">$outfilename" || die "Can't open output file '$outfilename'\n";

    $filename =~ m/(.)/;
    print uc $1;

    my $line;

    while ($line = <IN>) {
#	$line =~ s/($target_matcher)/$target_to_link{lc $1}/gi;
#	$line =~ s/(\<[bi]\>|[1-9]\s+)($target_matcher)/$1$target_to_link{lc $2}/gi;
#	$line =~ s/\<([bi])\>($target_matcher)/<$1>$target_to_link{lc $2}/gi;
	$line =~ s/(\W+|^|^<b>)($target_matcher)(?=[^\":\w]+)/$1$target_to_link{lc $2}/ogi;

	print OUT $line;
    }
    close IN;
    close OUT;

# Replace input with output
    rename $outfilename, $filename || die "Can't rename '$outfilename' to '$filename'\n";
  }

  print "\n";
}


sub CreateIndexPage 
{
    my $prefix = shift;
    my $indexName = $prefix . "Index.html";
    my $hashRef = shift;
    my %mapping = %$hashRef;

    if (scalar (keys %mapping)) {
	print "Creating $indexName\n";
    }
    else {
	print "$prefix is an empty index.\n";
	return;
    }

    my $OUT;
    open OUT, ">$indexName";
    print OUT "<html>\n";
    print OUT "<head><title>V3.5 SRD Index</title></head>\n";
    print OUT "<body>\n";
    print OUT "$prefix Index<br>\n";

    my $topic;

#
# Generate the alphabet links to the subsections of this index.
    my $firstLetter = "?";
    for $topic (sort keys %mapping) {
	# Create a new anchor if necessary
	if (substr($topic, 0, 1) ne $firstLetter) {
	    $firstLetter = substr($topic, 0, 1);
	    print OUT "<a href=\"\#$firstLetter\">\[" . uc $firstLetter . "\]</a>\n";
	}
    }

#
# If this is the master index, then write out topical index links.
#
    if ($prefix eq "Master") {
	print OUT "<br>\n";
	for $topic (sort @indices) {
	    print OUT "<a href=\"" . $topic . "Index.html\">$topic</A>\n";
	}

	# Also include the characters here
	print OUT "<a href=\"Landorel.html\">Landorel</a>\n";
	print OUT "<a href=\"Ptom.html\">Ptom</a>\n";

	print OUT "<br>\n";
    }

    push @indices, $prefix;
#
# Now write out the actual sections of this index.
#
    for $topic (sort keys %mapping) {
	# Create a new anchor if necessary
	if (substr($topic, 0, 1) ne $firstLetter) {
	    $firstLetter = substr($topic, 0, 1);
	    print OUT "<h4><a name=\"$firstLetter\">\[" . uc $firstLetter . "\]</a></h4>\n";
	}

	print OUT "$topic ";
    }

    print OUT "</body>\n";
    print OUT "</html>\n";
    close OUT;
}

&NukeFontTags();

# Tag the destinations in increasing order of their importance.
# This is necessary because later headings over-write earlier ones.
&TagDestinations("AbilitiesAndConditions");
&TagDestinations("CarryingAndExploration");
&TagDestinations("Monsters");
&TagDestinations("MonsterFeats");
&TagDestinations("TypesSubtypesAbilities");
&TagDestinations("Combat");
&TagDestinations("Spell");
#&TagDestinations("MagicItems");
&TagDestinations("Feats");
&TagDestinations("Skills");
&TagDestinations("Classes");
&TagDestinations("PrestigeClasses");
&TagDestinations("Basics");
&TagDestinations("Description");
&TagDestinations("Races");
#&TagDestinations("psionicd");

# Now create the master index.
&CreateIndexPage("Master", \%target_to_link);

&MarkupLinks("*.html");

print "Done!\n";