#!/usr/local/bin/perl
# Add d-links from images to long descriptions.
# Two cases:
# Image is part of a figure with a caption ():
# Insert d-link at beginning of caption.
# Not part of a figure or no caption.
# Add d-link just after image.
#
# Ian Jacobs ij@w3.org
# $Id: addlongdesc,v 1.5 2006-10-09 18:55:52 ihickson Exp $
use English;
use DB_File;
use lib 'bin';
use utils;
$PROG = substr($0, rindex($0, "/") + 1);
$USAGE = "Usage: $PROG input [output]\n";
($file = $ARGV[0]) || die $USAGE;
shift;
($output = $ARGV[0]) || ($output = "-");
shift;
sub image_name {
my $f = `basename $_[0] '.gif'`;
$f = `basename $_[0] '.png'`;
chop $f;
return($f);
}
sub desc_title {
my $f = "$_[0]";
my $title = "";
if (open(DLINK, $f)) {
local $/ = undef;
my $b = ;
close(DLINK);
$b =~ /(.*?)<\/TITLE>/iso;
# Probably need to strip title of markup here.
$title = $1;
}
return($title);
}
open(FILE, $file) ||
die "$PROGNAME Error: Cannot open $file\n";
open(OUTPUT, "> $output") ||
die "$PROGNAME Error: Cannot output to $output\n";
$INPUT_RECORD_SEPARATOR="<";
$buf = "";
while ($buf = ) {
print OUTPUT $buf;
$INPUT_RECORD_SEPARATOR=">";
unless (eof(FILE)) {
$anchor=;
# Remove final ">"
chop($anchor);
$INPUT_RECORD_SEPARATOR="<";
$dlink = "";
if ($anchor =~ /^IMG.*?src\s*=\s*(?:([^\s>]+)|\"([^\"]+)\").*/is){
my $imagename = image_name("$1$2");
my $descfile = "images/longdesc/$imagename-desc.html";
if (-f "$descfile") {
$title = desc_title($descfile);
if ($title) {
$dlink = " [D]";
}
}
} else {
# No change to the anchor.
}
# Put back chopped ">"
print OUTPUT "$anchor>$dlink";
}
}
close(FILE);
close(OUTPUT);