#!/usr/bin/perl
#
# Philippe Chauvat - Bacula Systems
# ---
# 25-octobre-2013: Creation
# ---
# Context: This script is designed to handle external references in HTML
#          manuals.
# ---
# Overview:
# This is a two step process.
# -a) Each HTML file produced by the latex2html converter is analyzed and
#     every <a name="whatever_but_beginning_with_SECTION"> expression is
#     kept into a global file in a tab form: manual anchor_name file_name
# -b) This (handle-xr-references.pl) script is called once, after the
#     translate.pl post-process.
#     It takes a list of manuals and the filename from (a) (list of anchors)
#     and analyze each HTML file to find the external reference pattern:
#     __XRANCHOR_...
#     Then it replaces the pattern build like __XRANCHOR_TEXT_ANCHOR_MANUAL_LEVEL_
#     by a <a href="path/to/manual/file_name#anchor_name>text level</a>
#
#
# args:
# -i: list of anchors file name
# -m: list of manuals to manage
# -l: lang of the manuals. en by default.
# -?: help / usage
# -d: debug requested
use Getopt::Long ;
use File::Basename ;
use Data::Dumper ;
sub usage {
    print "handle-xr-references.pl -m | --manuals-list manual's list
 -i | --input anchors-input-file-name
 [ -l | --lang language ]
 [ -d | --debug ]
 [ --help | -? ]\n" ;
    exit 1 ;
}
#
# Send message to output in case of debug only
# ======================
sub debugdump {
    my ($what,$msg) = @_ ;
    if ($debug) {
	print "\n===============================\nBegin of $msg\n" ;
	$what->dump ;
	print "\n===============================\nEnd of $msg\n\n" ;
    }
}

sub read_references {
    my $referencefile = $_[0] ;
    my %references ;
    local *FH ;
    open FH, "< $referencefile" or die "Unable to open $referencefile\n" ;
    while (<FH>) {
	our($manual,$filename,$anchor) = split /\t/,$_ ;
	chomp($anchor) ;
	if ($anchor !~ /^SECTION/ and $anchor !~ /^tex2html/ and $anchor !~ /^\d+/ ) {
#	    print "Manual: $manual\nAnchor: $anchor\nFilename: $filename\n\n" ;
	    $references{$manual}{$anchor} = $filename ;
	}
    }
    close FH ;
    return %references ;
}
#
# Args to Vars
our($anchorfile,$manuallist,$help,$debug,$language) ;
#
# Usage in case of missing arguments
usage() unless($#ARGV > -1) ;
#
# Input file / Output file
GetOptions("input|i=s" => \$anchorfile,
	   "manual-list|m=s" => \$manuallist,
	   "lang|l=s" => \$language,
	   "debug|d" => \$debug,
	   "help|?" => \$help) or usage() ;
#
# Help is requested?
usage() if ($help) ;
#
# Anchor file is mandatory
usage() unless (defined $anchorfile) ;
# ... and file must exist
die "$anchorfile does not exists.\n" unless -e $anchorfile ;
#
# Manual list is mandatory too
usage() unless (defined $manuallist) ;
#
# Read the anchor file
my %references = read_references($anchorfile) ;
#
# Read all HTML files and replace the need references
my @manuals = split / /, $manuallist ;
my $m ;
foreach $m (@manuals) {
    print "HTML files for manual $m\n" ;
    @htmls = glob($m . "/*html") ;
    foreach my $f (@htmls) {
	print "HTML file: $f\n" ;
	local *FH ;
	open FH, "< $f" or die "Unable to open $f\n" ;
	my @content = <FH> ;
	close FH ;
	open FH, "> $f" or die "Unable to write to $f\n" ;
	foreach my $l (@content) {
#	    print $l . "\n" ;
# __XRANCHOR_Tape Testing_FreeBSDTapes_problems_chapter__ 
	    while ($l =~ /(__XRANCHOR_[^_]*_[^_]*_[^_]*_[^_]*__)/) {
		$_ = $1 ;
		my $xr = $1 ;
		my ($text,$anchor,$manual,$level) = /__XRANCHOR_([^_]*)_([^_]*)_([^_]*)_([^_]*)__/ ;
#		print "\t\tText: $text\n\t\tAnchor: $anchor\n\t\tManual: $manual\n\t\tLevel: $level\n" ;
		my $filename = $references{$manual}{$anchor} ;
		my $theanchor = "<a class=\"borg_xrlinkclass\" href=\"../../$manual/$manual/$filename#$anchor\">$text $level</a>" ;
		$_ = $l ;
#		print $l . "\n" ;
		s/$xr/$theanchor/ ;
		$l = $_ ;
 #		print $l . "\n" ;
	    }
	    while ($l =~ /(__HREF_[^_]*_[^_]*__)/) {
		$_ = $1 ;
		my ($link,$text) = /__HREF_([^_]*)_([^_]*)__/ ;
		my $theanchor = "<a class=\"borg_linkclass\" href=\"$link\">$text</a>" ;
		$_ = $l ;
#		print $l . "\n" ;
		s/$xr/$theanchor/ ;
		$l = $_ ;
#		print $l . "\n" ;
	    }
	    print FH "$l" ;
	}
	close FH ;
    }
}
1 ;
