#!/usr/bin/perl -w
use strict;
#
# Straightens out links in multiple latex source files. Uses a master tex
#  file (first argument) and straightens out all the links. The problem is that
#  links in each tex file may point to other tex files.  But 
#  we aren't going to generate multiple dvi files in the end, so the links all
#  need to work in the same source file. This will be resolved by making a list
#  of links, a hash with keys being the original link targets. 
#  Then global link names will be created. The hash will contain the
#  new link name as the value. A reverse hash will also be created at the
#  same time.

# In addition to the above situation, it is possible that tex filenames have changed
#  since the links were created. To handle this, parameters can be entered
#  from the command line and links will be translated. Multiple translation arguments
#  can be entered at the command line to translated any number of file links.

# The top-level tex file is read in and all includes saved. These files are then
#  examined to find all link anchors. The list of links is processed to make them 
#  all unique across all source files. This is done by appending an integer to each
#  link name, using the lowest integer that will generate a unique link name.
#
# The tex files are then processed again, dropping the filename in the link, and
#  putting in the unique link name determined above. The new files are named
#  foo.linked.tex, where foo is the name of the original tex file.

# Unresolved links are listed to STDOUT, and forward and reverse lists of links
#  are output to files at the end.

# Invocation syntax is as follows:
#
#  link_resolver.pl -f infile.tex [ -t oldfile=newfile]...
#
#

my %translation;

sub max { return $_[0] > $_[1] ? $_[0] : $_[1]; }

sub get_includes {
	# Get a list of include files from the top-level tex file.
	my $masterFile = shift;
	my (@list,$file,%excludeList,$filelist);

	# Check that the master file exists, and open it.
	# Grab a list of include files, and add it to the array.
	open MASTER,"<$masterFile" or die "Cannot open master file: $masterFile";
	while (<MASTER>) {
		chomp;
		# If the special code '% nolinks' is found, parse the rest of the line for
		#   a list of files to not bring in to resolve links.
		if (($filelist) = /^\%\s+nolinks\s+(.*)/i) {
			foreach (split(/\s+/,$filelist)) {$excludeList{$_} = "";}
		}
			
		($file) = /^\\include\{(.*)?\}/ or next;
		# Remove the .linked part of the filename, that refers to files already linked.
		$file =~ s/\.linked$//;
		if (!defined $excludeList{$file}) {
			push(@list,"$file.tex");
		}
	}
	close MASTER;
	return @list;
}

sub get_anchors {
	# Examines each file and grabs a list of anchors from it. 
	my @files = @_;
	my $anchors = {};
	my ($cnt,$fileAnchors);

	# Creates a hash composed of those global links, one key for each file. Each
	#  of these hashes will contain a hash of anchors from the file.
	foreach my $file (@files) { 
		($fileAnchors,$cnt) = load_anchors($file); 
		$anchors->{$file} = $fileAnchors;
	}
	return $anchors;
}

sub load_anchors {
	# Loads the links from the given file into the anchors hash, and returs that hash.
	my ($filename) = shift;
	my ($bfr,$name,$cnt,$targetFile,$position,$data);
	my $anchors = {};

	# Opens the indicated file for reading.
	# Load the whole file into a buffer.
	# Search the buffer for the form \label{foo} or \special{html:<a name="foo">}.
	# Note that anchors may be duplicated in the two types of references, but that 
	#  doesn't matter.
	#   If found,
	#   	extract the name.
	#       Drop trailing spaces.
	#		save in anchors hash for this file.
	# close the file.
	# Return the anchors hash for this file.
	
	open IF,"<$filename" or die "Cannot open file $filename for reading";
	while (<IF>) {
		$bfr .= $_;
	}
	close IF;

	$cnt = 0;
	(!$bfr) and die "No data in Input File: $filename";
	while ($bfr =~ /(\\label\{.*?\})|(\\special\n*\{html:<a\s+name=\".*?\">\})/s ) {
		if ($bfr =~ /\\label\{(.*?)\}/s) {
			$bfr = $';
			$name = $1;
			$name =~ s/\s+$//;
			$anchors->{$name} = $name;
			$cnt++;
		} elsif ($bfr =~ /\\special\n*\{html:<a\s+name=\"(.*?)\">\}/s ) {
			$bfr = $';
			$name = $1;
			$name =~ s/\s+$//;
			$anchors->{$name} = $name;
			$cnt++;
		} else {
			die "Parse error retrieving anchors";
		}
	}
	return ($anchors,$cnt);
}


# convert_links
#  Go through the list of anchors for each file and convert the anchors to unique ones.
#  Save the new anchor in its original place and also into a hash of new anchors.
sub convert_links {
	# Converts the anchor to global (source-independent) versions.
	my ($links) = shift;
	my ($file,$anchor,$newanchor);
	my %linksList;

	foreach $file (keys(%$links)) {
		foreach $anchor (keys(%{$links->{$file}})) {
			$newanchor = get_newlink($anchor,\%linksList);
			$links->{$file}{$anchor} = $newanchor;
			$linksList{$newanchor} = "";
		}
	}
}

sub get_newlink {
	# Makes up a new anchor from the old one.
	my ($anchor,$linkhash) = @_;
	my ($newlink,$number,$base);

	# If the anchor isn't already in the hash, it's unique so return it.
	# Otherwise it's not unique, and we need to append a number.
	#  If the link already contains a number at the end, 
	#    start with one higher, otherwise start with 0.
	#  If the anchor exists with the number appended, keep incrementing
	#    the number until a unique one is found.
	# Return the new anchor.
	if (!defined($linkhash->{$anchor})) { return $anchor; };
	if ($anchor =~ /\d*$/) { 
		$number = $&;
		$base = $`;
	} else { 
		$number = 0; 
		$base = $anchor;
	}
	
	while (exists($linkhash->{$anchor . ++$number})) {}
	return $anchor . $number;
}

# changeOldLinks
#  For each source file in the list of files to process,
#    Process the file, writing links into an output file foo.linked.tex.
sub changeOldLinks {
	my ($links,$filelist) = @_;
	my ($infile,$response,$outfile);
	my $cnt = 0;

	foreach $infile (@$filelist) {
		$outfile = $infile;
		$outfile =~ s/\.tex/.linked.tex/;
		$cnt += changeFileLinks($infile,$outfile,$links);
	}
	return $cnt;
}

# Open the tex file for reading, and the output file for writing.
# Read the entire target file into a buffer.
# Pass everything from the target file to the output file, until we
#   get to a link or a label
# If the reference is an external one (http:, ftp:, or mailto:) ignore
#   it and pass it unchanged to the output file
# If it is a label, save the command and grab the first argument as the target.
# If it is a hyperref, save the command and srab the fourth argument as the target
# Separate the filename from the anchor in the target.
# Translate any filenames that have changed.
# If the reference has no corresponding anchor, output a warning.
# If the reference is to a local file that is not a tex file, output a warning.
# Output the reference to the output file, using the new reference name. No line wrapping
#  occurs for outputting a referenece, so the lines in the tex file may get longer.

sub changeFileLinks {
	my ($infile,$outfile,$links) = @_;
	my ($bfr,$cmd,$type,$target,$refFile,$pointer,$newtarget);
	my ($url,$category,$name,$temp);
	my ($text,$output);
	my $cnt = 0;

	my @regLink;

	$regLink[0] = '(\\\\elink\\{)(.*?)\\}';
	$regLink[1] = '(\\\\label\\{)(.*?)\\}';
	$regLink[2] = '(\\\\hyperref\\{)(.*?)\\}\\{(.*?)\\}\\{(.*?)\\}\\{(.*?)\\}';
	$regLink[3] = '(\\\\special\\n*\\{html:<a\\s+href=\\")(.*?)\\">\\}';
	$regLink[4] = '(\\\\special\\n*\\{html:<a\\s+name=\\")(.*?)\\">\\}';
	$regLink[5] = '(\\\\ilink\\{)(.*?)\\}\\{(.*?)\\}';
	my $linkTest = "(" . join(")|(",@regLink) . ")";

	open TEX,"<$infile" or die "Cannot open $infile for reading\n";
	open OUT,">$outfile" or die "Cannot open $outfile for writing\n";
	while (<TEX>) {
		$bfr .= $_;
	}
	close TEX;

	while ($bfr =~ /$linkTest/so) {
		$bfr = $& . $';
		$cnt++;
		print OUT $`;
		if (($cmd,$target) = ($bfr =~ /^$regLink[0]/so)) {
			$bfr = $';
			print OUT $&;
			next;
		} elsif (($cmd,$target) = $bfr =~ /^$regLink[1]/so) {
			$bfr = $';
			$refFile = $infile; $pointer = $target; 
			$type = 1;
		} elsif (($cmd,$text,$category,$name,$url) =  $bfr =~ /^$regLink[2]/so ) {
			$bfr = $';
			$refFile = $url;
			$pointer = $category;
			$type = 2;
		} elsif (($cmd,$target) =  $bfr =~ /^$regLink[3]/so) {
			$bfr = $';
			$temp = $&;
			if ($target =~ /^(http:|ftp:|mailto:)/) {
				print OUT $temp;
				next;
			}
			($refFile,$pointer) = split (/\#+/,$target);
			$type = 3;
		} elsif (($cmd,$target) =  $bfr =~ /^$regLink[4]/so) {
			$bfr = $';
			$refFile = $infile; $pointer = $target; 
			$type = 4;
		} elsif (($cmd,$text,$target) =  $bfr =~ /^$regLink[5]/so ) {
			$bfr = $';
			($refFile,$pointer) = split (/\#+/,$target);
			$type = 5;
		} else {
			# Error.
			die "Parsing Error";	
		}
		$cmd =~ s/\n/ /sg;

		foreach (keys(%translation)) { $refFile =~ s/$_/$translation{$_}/; }

		if (defined($pointer) and $pointer) {
			$pointer =~ s/\n//g;
			$pointer =~ s/\s+$//;
			if (defined($links->{$refFile}{$pointer})) {
				$newtarget = $links->{$refFile}{$pointer};
			} else {
				warn "Warning: Reference not Found- $refFile#$pointer in  $infile\n";
				$newtarget = "";
			}
		} else {
			warn "Warning: Outside Reference: $refFile in  $infile\n";
			$newtarget = $refFile;
		}


		if ($type == 0) {
			$cmd = "";
		} elsif ($type == 1) {
			$cmd .= "$newtarget\}";
		} elsif ($type == 2) {
			$cmd .= "$text\}\{\}\{\}\{$newtarget\}";
		} elsif ($type == 3) {
			$cmd .= "$newtarget\">\}";
		} elsif ($type == 4) {
			$cmd .= "$newtarget\">\}";
		} elsif ($type == 5) {
			$cmd .= "$text\}\{$newtarget\}";
		} else {
			die "Parsing Error";
		}
		print OUT $cmd;
	}
	print OUT $bfr;
	close OUT;
	return $cnt;
}


# Write a list of links to the indicated file.
sub write_links_file {
	my ($links) = shift;
	my $outlinks = "links.out";
	my ($strlen,$filename,$pointer,$longest,$spaces);

	# Writes the list of links out to a file.
	open OF,">$outlinks" or die "Cannot open $outlinks for writing\n";

	# Find the longest key.
	$longest = 0;
	foreach $filename (keys(%$links)) {
		foreach $pointer (sort(keys(%{$links->{$filename}}))) {
			$strlen = length($filename) + length($pointer);
			$longest = max($longest,$strlen);
		}
	}

	foreach $filename (sort(keys(%$links))) {
		foreach $pointer (sort(keys(%{$links->{$filename}}))) {
			$strlen = length($filename) + length($pointer);
			$spaces = " " x ($longest - $strlen);
			print OF "$filename#$pointer $spaces $links->{$filename}{$pointer}\n";
		}
	}
	close OF;
}

# Write a list of reverse links to the indicated file.
sub writeRevLinks {
	my ($links) = shift;
	my $outlinks = "linksr.out";
	my (%revlinks,$longest,$spaces);

	# Writes the list of reverse links out to a file.
	open OF,">$outlinks" or die "Cannot open $outlinks for writing\n";

	foreach my $filename (sort(keys(%$links))) {
		foreach my $pointer (sort(keys(%{$links->{$filename}}))) {
			$revlinks{$links->{$filename}{$pointer}} = "$filename#$pointer";
		}
	}

	$longest = 0;
	foreach (keys(%revlinks)) {
		$longest = max($longest,length($_));
	}

	foreach (sort(keys(%revlinks))) {
		$spaces = " " x ($longest - length($_));
		print OF "$_ $spaces $revlinks{$_}\n";
	}
	close OF;
}

# Look for arguments in the command line, and decode them into a hash.
sub parse_cmdline {
	my $cmds = {};
	my ($cnt,$arg);

	$cnt = 0;
	while (defined($arg = $ARGV[$cnt++])) {
		if ($arg =~ /-f/) {
			if (defined($arg = $ARGV[$cnt++])) { $cmds->{infile} = $arg; }
				else {die "No Input File given on Command line\n"; }
		} elsif ($arg =~ /-t/) {
			if (defined($arg = $ARGV[$cnt++])) { 
				if ($arg =~ /=/) { $translation{$`} = $'; }
					else {die "Invalid translation Given $arg"; }
			} else {
				die "No Translation argument given for -t argument";
			}
		}
	}
	return $cmds;
}


##################################################################
#                       MAIN                                  ####
##################################################################

my (@includes,%pointers,%pointersRev,$anchors);

# Parse the command-line arguments and put them into a hash.
my $args = parse_cmdline;

if (!defined($args->{infile})) {
	die "Master File to Process must be given with -f parameter\n";
}

foreach (sort(keys(%translation))) {
	print "Filename Translation: $_ -> $translation{$_}\n";
}

# Read in the list of files to be included
# Get the links from each file.
# Convert the link format from local to global; check for duplicates.
# Change all the links in the source files to global ones, and change
# 	the names (labels) to global ones.
# Write out the list of links and reverse links to a text file.
#
@includes = get_includes($args->{infile});

$anchors = get_anchors(@includes);
convert_links($anchors);
my $link_cnt = changeOldLinks($anchors,\@includes);
#write_links_file($anchors);
#writeRevLinks($anchors);
my $anchor_cnt = keys(%$anchors);
print "Finished -- $anchor_cnt Anchors Found  $link_cnt Links Resolved\n";