addlinks

#!/usr/local/bin/perl
# Add links from instances to definitions
# Write to stdout
#
# -x			allow html2ps to add crossrefs (page numbers)
# dbase			DBM file created by mkanchdb
# file			input file
# ins-class/def-class	links will be created from every occurrence
#			of ins-class to occurrence of def-class (as found
#			in dbase)
#
# Arnaud Le Hors - lehors@w3.org
# Modifications by Bert Bos <bert@w3.org>
# $Id: addlinks,v 2.8 2006-10-09 18:55:52 ihickson Exp $

use DB_File;
use Getopt::Std;
use lib 'bin';
use utils;

$PROG = substr($0, rindex($0, "/") + 1);
$USAGE = "Usage: $PROG [-x] dbase file [ins-class/def-class [ins-class/def-class...]]\n";

# $1=starttag, $2=class excl. prefix, $3=contents, $4=endtag
$pre = '(<span\s+[^>]*?class\s*=\s*[\"\']?';
$post = '([^\s\"\'>]+)[\"\']?.*?>)(.*?)(</span\s*>)';

# compute relative path from 1 to 2
sub rpath {
    @path1 = split("/", $_[0]);
    @path2 = split("/", $_[1]);

    pop(@path1);
    while ($path1[0] eq $path2[0]) {
	shift(@path1);
	shift(@path2);
    }

    $root = "";
    foreach $el (@path1) {
	$root .= "../";
    }
    $path = join("/", @path2);
    return "$root$path";
}


# Find the URL for $_[0] in %anchors, create <A> around/in element
sub gen_anch {
    my ($key, $stag, $content, $etag, $xrefon) = @_;
    my $anch = $anchors{$key};
    # Make html2ps add page numbers if $xrefon is true,
    # or if there is an explicit "xref" specified on the element.
    if ($xrefon) {$class = "";} else {$class = " class=\"noxref\"";}
    if ($stag =~ /\bxref\b/) {$class = "";}
    if (! defined $anch) {
	warn "$PROG: index $_[0] not found\n";
	$anch = "";
    }
    # class=noxref directs our patched html2ps to omit the page number
    if ($content =~ /^<a\s[^>]*?href\s*=/sio) {
	# An A with an HREF at the start, give up...
	warn "$PROG: cannot add link to \"$anch\", there is a link already:
\t$content\n";
	return "$stag$content$etag";
    } elsif ($content =~ /^<a\b/sio) {
	# An A, but without HREF, at the start, add HREF to existing <A>
	return "$stag<a href=\"$anch\"$class$'$etag";
    } elsif ($content =~ /<a\b/sio) {
	# An A not at the start, add <A> before the existing one
	return "$stag<a href=\"$anch\"$class>$`</a>$&$'$etag";
    } else {
	# No <A> in content, enclose whole element
	return "<a href=\"$anch\"$class>$stag$content$etag</a>";
    }
}

### main

getopts('x') or die $USAGE;
($dbase = $ARGV[0]) || die $USAGE;
shift;
($file = $ARGV[0]) || die $USAGE;
shift;

my $xrefon = defined $opt_x;

dbmopen(%anchors, $dbase, 0666) || die "$PROG: cannot open database $dbase\n";

# Load file
$buf = readfile($file);

# Loop over class/dbase pairs
while (($class1, $class2) = split(/\//, $ARGV[0])) {
    shift;
    $buf =~ s/$pre$class1$post/gen_anch("$class2$2", $1, $3, $4, $xrefon)/sieg;
}
dbmclose(%anchors);

# Write result
print $buf;