#!/usr/bin/perl
#
# Trying to convert this into a command line utility to convert batches
# of info files to html files.
#
# For my Win32 Unix Utility Ports project.
# Ted Felix <tfelix@fred.net> 8/26/97
#------------------------------------------------------------------------
#
# info2www - Gateway between GNU Info nodes and WWW
$id = '$Id: info2www,v 1.2 1994/07/28 15:39:38 lmdrsm Rel lmdrsm $';
#
# This is a script conforming to the CGI - Common Gateway Interface
#
# Author:	Roar Smith (lmdrsm@lmd.ericsson.se)
#
# Copyright:	This program is in the Public Domain.
#
# The original code (most of &info2html) was written by 
# Eelco van Asperen (evas@cs.few.eur.nl).
#
# TODO:
# -----
# * Present a list of choices when there is no exact match for the requested
#   Info file but multiple non-exact matches exist.
# 
# * Use Tag Table to find possible file and offset.
#
#

#----------------- CONFIGURATION -----------------------------------------------

#
# Set $DEBUG = 1; to debug what's happening
#
$DEBUG = 0;

#
# INFOPATH is the path of direcories in which to search for Info node files.
#
@INFOPATH =				
    ( "/home/users2/tfelix/wuup/info2www" );

#
# ALLOWPATH specifies whether info files with may be specified with path-names
# outside of those directories included in INFOPATH .
# It is a possible security hole to set this variable to a true value,
# because *any* file on the system could then be accessed through this gateway.
$ALLOWPATH = 0;

#
# ALIAS is a map of aliases - look for the alias if the node itself isn't found.
# The key (first entry) is the node filename, the value (second entry) is the
# alias. Both are basenames (i.e. no path!) with no capital letters.
# Note that the keys *must* be unique!
#
%ALIAS =
    (
     'emacs',	'lemacs',
     'g++',	'gcc',
     'c++',	'gcc',
     'gunzip',	'gzip',
     'zcat' ,	'gzip',
     'elisp',	'lispref'
     );

#
# URL of the icons used for indicating references and stuff:
# $INFO_ICON	- Icon at the top left of each document
# $UP_ICON	- Icon used in an "Up:"   hyperlink at the top
# $NEXT_ICON	- Icon used in a  "Next:" hyperlink at the top
# $PREV_ICON	- Icon used in a  "Prev:" hyperlink at the top
# $MENU_ICON	- Icon used in front of each menu label
#
# Set these to "" if you don't want them used.
#
$INFO_ICON =	"infodoc.gif";
$UP_ICON =	"up.gif";
$NEXT_ICON =	"next.gif";
$PREV_ICON =	"prev.gif";
$MENU_ICON =	"menu.gif";

#
# These are the defines for file-locking with flock(2)
#
$LOCK_SH = 1;
$LOCK_EX = 2;
$LOCK_NB = 4;
$LOCK_UN = 8;

#----------------- MAIN --------------------------------------------------------
$pg = $0; $pg =~ s,^.*/([^/]*)$,$1,;
($version, $date) = ($id =~ m@,v\s+([0-9.]+)\s+([0-9/]+)@);

$script_name = $ENV{'SCRIPT_NAME'};
$server_name = $ENV{'SERVER_NAME'};
$request_method = $ENV{'REQUEST_METHOD'};
$prefix = "";	# prefix for HREF= entries

print "ARGV: ", join('+', @ARGV), "<BR>\n" if $DEBUG;
if ($#ARGV == -1) {
    $nodename = "(DIR)";
} else {
    $nodename = join('+', @ARGV);
    $nodename = &DeEscape($nodename);
}
print "nodename: ", $nodename, "<BR>\n" if $DEBUG;

&info2html($nodename);

# Couldn't figure out how to stuff this into info2html
print
    "<HR>\n",
    "<em>automatically generated by</em> ",
    "<strong>info2www</strong> ",
    "<em>version $version</em>\n";

exit(0);

#----------------- SUBROUTINES -------------------------------------------------

#------------------------------------------------------------
#                        ToPattern
#------------------------------------------------------------
# This procedure transforms a string in a search pattern,
# escaping the non standard characters.
#------------------------------------------------------------
sub ToPattern{
  local($Tag) = @_;
  local(@Temp);
  @Temp = split(/([^a-zA-Z0-9])/,$Tag);
  $Tag = "";
  for $x (@Temp){
    $x = ($x =~ /[^a-zA-Z0-9]/) ? '\\'.$x : $x;
    $Tag .= $x;
  }
  $Tag;
}

#---------------------------------------------------------
#                      Escape
#---------------------------------------------------------
#  This procedures escapes some special characeters. The
#  escape sequence follows the WWW guide for escaped
#  characters in URLs
#---------------------------------------------------------
sub Escape{
  local($Tag) = @_;
#  $Tag =~ s/%/%25/g;		#  %
#  $Tag =~ s/[ \n]+/%20/g;	#  space(s) and/or newline(s)
#  $Tag =~ s/\+/%2B/g;		#  +
  $Tag =~ s/[ \n]+/\_/g;	#  space(s) and/or newline(s)
  return $Tag;
}

#----------------------------------------------------------
#                    DeEscape
#----------------------------------------------------------
sub DeEscape{
  local($Tag) = @_;
  $Tag =~ s/\\([][(){}|?*\\])/$1/g;
  return $Tag;
}    


#---------------------------------------------------------------------------
#
#                    info2html
#
#---------------------------------------------------------------------------
sub info2html {
    local($nodename) = @_;
    local($next_img, $prev_img, $up_img);
    local($noinfo);

    # Nodename looks like one of these:
    # (file)label	- Both file and label of the Info node given
    # (file)		- Label defaults to "Top"
    # 			- File defaults to "DIR", Label defaults to "Top"

    $matches = 0;
    $blank = 0;

    if ($nodename =~ /^\(([^\)]*)\)(.+)$/) {
	($file, $node) = ($1, $2);
    } elsif ($nodename =~ /^\(([^\)]*)\)$/) {
	($file, $node) = ($1, "Top");
    } elsif (!$nodename) {
	($file, $node) = ("DIR", "Top");
    } else {
	print "Malformed node name: $nodename\n";
	return(0);
    }

    $target = $node;
    $target =~ y/A-Z/a-z/;
    $target =~ s/%20/ /g;
    $target =~ s/&lt\;/</g;
    $target =~ s/&gt\;/>/g;
    $target = &ToPattern($target);
    $file =~ s/&lt\;/</g;
    $file =~ s/&gt\;/>/g;

    print "nodename: $nodename\nfile: $file\ntarget: $target\n" if $DEBUG;

    $info_img = "<IMG SRC=\"$INFO_ICON\" ALT=\"\" ALIGN=BOTTOM> " if $INFO_ICON;
    $next_img = "<IMG SRC=\"$NEXT_ICON\" ALT=\"\" ALIGN=BOTTOM> " if $NEXT_ICON;
    $prev_img = "<IMG SRC=\"$PREV_ICON\" ALT=\"\" ALIGN=BOTTOM> " if $PREV_ICON;
    $up_img = "<IMG SRC=\"$UP_ICON\" ALT=\"\" ALIGN=BOTTOM> " if $UP_ICON;

    $nfiles = 0;

    print "<BR> FindFile...\n" if $DEBUG;
    ($directory, $basefile) = &FindFile($file);
    if (!$directory) {
	&error("Couldn't find Info file \"$file\".");
	return(0);
    }
    &OpenFile($basefile) || return(0);
    
    $active = 0;
    $seenMenu = 0;
    $indirect = 0;
    $inentry = 0;
    $lastblank = 0;
    
  FileLoop:
    for (; $nfiles > 0; ) {

	local($handle) = "FH_$nfiles";
	print "<BR> --now reading from $handle--\n" if $DEBUG;
	if ($basefile) {
	    $h_file = $basefile;
	} elsif ($realfile{$handle}) {
	    $h_file = $realfile{$handle};
	    $h_file =~ s,.*/([^/])$,$1,;
	    $h_file =~ s,.*/(.*)-[0-9]+$,$1,;
	}
	while (<$handle>) {
	    chop;
	    # Convert special chars
	    s/&/&amp\;/g;
	    s/</&lt\;/g;
	    s/>/&gt\;/g;
	    #study;			# Doesn't seem to help or hurt!
	    /^[\037\f]/ && do {
		&EndMenu();
		&EndListing();
		if ($active) {
		    close($handle);
		    print "<BR> Closed file $handle\n" if $DEBUG;
		    return(1);
		}
		$active = 0;
		$seenMenu = 0;
		$indirect = 0;
		$inentry = 0 if $inentry;
		$inentry++;
		$pos = tell() - length($_) - 1;
		next;
	    };

	    next if ($inentry == 0);

	    $lastblank = $blank; $blank = 0;
	    /^$/ && do {
		if ($active) {
		    print "\n";
		} elsif ($menu == 0) {
		    print;
		}
		$blank = 1;
		next;
	    };

	    ($inentry == 1) && do  {
		# top line:
		# File: info,  Node: Add,  Up: Top,  Prev: Expert,  Next: Menus 
		/^tag table:/i && do {
		    # we don't use the tag table
		    $inentry = 0;
		    next;
		};
		/^indirect:/i && do {
		    # this entry is a list of filenames to include:
		    #
		    #	gcc.info-1: 1131
		    #	gcc.info-2: 49880
		    #	gcc.info-3: 99426
		    $inentry++;
		    $indirect++;
		    next;
		};

		#
		# Parse the header line. If one of the fields
		#	Node: Up: Next: Previous: File:
		# is found, then a variable 'h_node' is set for
		# the field 'node:', 'h_next' for 'next:', etc.
		#
		undef $h_node;
		undef $h_file;
		undef $h_next;
		undef $h_prev;
		undef $h_up;

		/\bfile: *([^ ,\t]*)/i && do {
		    $h_file = $1;
		};
		/\bnode: *([^,\t]*)/i && do {
		    $h_node = $1;
		    $h_node =~ s/\s+$//; # delete trailing spaces
		};
		/\bup: *([^,\t]*)/i && do {
		    $h_up = $1;
		    $h_up =~ s/\s+$//; # delete trailing spaces
		};
		/\bprevious: *([^,\t]*)/i && do {
		    $h_prev = $1;
		    $h_prev =~ s/\s+$//; # delete trailing spaces
		};
		/\bprev: *([^,\t]*)/i && do {
		    $h_prev = $1;
		    $h_prev =~ s/\s+$//; # delete trailing spaces
		};
		/\bnext: *([^,\t]*)/i && do {
		    $h_next = $1;
		    $h_next =~ s/\s+$//; # delete trailing spaces
		};
		
		print "--h_node: $h_node--<p>\n" if $DEBUG;
		$n = 0;

		if ($h_node =~ m/^$target$/i) {
		    $active = 1;
		    $matches++;

		    # Remove .info from filename
		    $noinfo = $h_file;
		    if ($h_file =~ /\.info$/) {
			$noinfo =~ s/\.info$//;
		    }

		    # Format name for output file
		    $filename = &Escape("$noinfo\@$h_node\.html");
		    # reopen stdout as destination file
		    open(STDOUT, ">"."$filename");
		    print STDERR "$filename\n";

		    print
			"<TITLE>",
			"Info Node: ($noinfo)$h_node",
			"</TITLE>\n",
			"<H1>$info_img($noinfo)$h_node</H1>\n",
			"<HR>\n";
		    if (defined $h_next) {
			print
			    "Next: ",
			    "<B>",
			    &make_anchor($h_next, "$next_img$h_next"),
			    "</B><TT>  </TT>";
			$n++;
		    }
		    if (defined $h_prev) {
			print
			    "Prev: ",
			    "<B>",
			    &make_anchor($h_prev, "$prev_img$h_prev"),
			    "</B><TT>  </TT>";
			$n++;
		    }
		    if (defined $h_up) {
			print
			    "Up: ",
			    "<B>", &make_anchor($h_up, "$up_img$h_up"),
			    "</B><TT>  </TT>";
			$n++;
		    }
		}

		print "\n<HR>\n" if $n;
		$inentry++;
		&StartListing();
		next;
	    };

	    ($inentry == 2) && $indirect && do  {
		# each line of this entry consists of two fields,
		# a filename and an offset, separated by a colon.
		# For example:
		#	texinfo-1: 1077
		local(@F) = split(/:/);
		print "#include $F[0]<p>\n" if $DEBUG;
		# should save: $inentry $indirect
		$save_inentry[$nfiles] = $inentry;
		$save_indirect[$nfiles] = $indirect;
		$inentry = 0;
		$indirect = 0;
		&OpenFile($F[0]) || return(0);
		next FileLoop;
	    };

	    next if $active == 0;

	    if (($end) = /^\*\s+Menu:(.*)$/) {
		# start of a menu:
		$seenMenu = 1;
		&EndListing();
		print "$end";
		&StartMenu();
		next;
	    };

	    /^\*/ && do {
		#---- SAMPLE LINES: -----------------------------------------
		# * Sample::.		Sample info.
		#
		# * Info: (info).	Documentation browsing system.
		# 
		# * Bison: (bison/bison)
		# 		A Parser generator in the same style as yacc.
		# * Random: (Random) Random    Random Number Generator
		#------------------------------------------------------------

		if ($menu == 0 && $seenMenu) { &EndListing(); &StartMenu(); };

		# * foo::
		/^\*\s+([^:]+)::/ && do {
		    $rest_of_line = $';
		    print
			"<DT>", &make_anchor($1, $1, $MENU_ICON),
			"<DD>";
		    $rest_of_line =~ s/^[\s\.]+//;
		    print $rest_of_line, "\n";
		    next;
		};

		# * foo: (bar)beer OR (bar)
		/^\*\s+([^:]+):\s+\(([^\) \t\n]+)\)([^\t\n\.,]*)/ && do {
		    $rest_of_line = $';
		    print
			"<DT>", &make_anchor("($2)$3",$1, $MENU_ICON),
			"<DD>";
		    $rest_of_line =~ s/^[\s\.]+//;
		    print $rest_of_line, "\n";
		    next;
		};

		# * foo: beer.
		/^\*\s+([^:]+):\s+([^\t,\n\.]+)/ && do {
		    $rest_of_line = $';
		    print
			"<DT>", &make_anchor($2, $1, $MENU_ICON),
			"<DD>", $2, ". ";
		    $rest_of_line =~ s/^[\s\.]+//;
		    print $rest_of_line, "\n";
		    next;
		};

		# no match: ignore silently
	    };

	    $menu && $lastblank && do {
		&EndMenu();
		&StartListing();
	    };

	    $menu && do {
		s/^\s+//;
	    };

	    /\*note/i && do {
		# cross reference entry:
		# "*note nodename::."
		# "*note Cross-reference-name: nodename."
		local($n) = 0;
		while (1) {
		    # *note \nfoo... (reference split over newline)
		    if (/\*note\s*$/i) {
			$_ .= "\n" . <$handle>;	# Merge with next line
			chop;
		    }
		    # *note foo\nbar... (reference split over newline)
		    if (/\*note\s+[^:\.]+$/i) {
			$_ .= "\n" . <$handle>;	# Merge with next line
			chop;
		    }
		    # *note foo: bar\nbleh... (reference split over newline)
		    if (/\*note\s+[^:\.]+:\s+[^:\.\t]+$/i) {
			$_ .= "\n" . <$handle>;	# Merge with next line
			chop;
		    }

		    # *note foo:
		    if (/\*note(\s+)([^:\.]+)::/i) {
			s//\@\@\@NOTE\@\@\@/; # insert unique marker
			local($spc, $ref, $lbl) = ($1, $2, $2);
			local($note) = "<B>Note:</B>$spc";
			$note .= &make_anchor($ref, $lbl);
			s/\@\@\@NOTE\@\@\@/$note/;
			$n++;
			next;
		    }

		    # * foo: (bar)beer OR (bar)
		    if (/\*note(\s+)([^:]+):\s+\(([^\) \t\n]+)\)([^\t\.,]*)(.?)/i) {
			s//\@\@\@NOTE\@\@\@/;	# insert unique marker
			local($spc, $ref, $lbl) = ($1, "($3)$4", "$2$5");
			local($nl) = ($ref =~ /\n/) ? "\n" : "";
			local($note) = "<B>Note:</B>$spc";
			$note .= &make_anchor($ref, $lbl);
			s/\@\@\@NOTE\@\@\@/$note$nl/;
			$n++;
			next;
		    }

		    # * foo: beer.
		    if (/\*note(\s+)([^:]+):\s+([^\t,\.]+)(.?)/i) {
			s//\@\@\@NOTE\@\@\@/;	# insert unique marker
			local($spc, $ref, $lbl) = ($1, $3, "$2$4");
			local($nl) = ($ref =~ /\n/) ? "\n" : "";
			local($note) = "<B>Note:</B>$spc";
			$note .= &make_anchor($ref, $lbl);
			s/\@\@\@NOTE\@\@\@/$note$nl/;
			$n++;
			next;
		    }

		    last;
		}
#		if ($n > 0) {
#		    local($l) = $listing;
#		    &EndListing() if $l;
#		    print "$_\n";
#		    &StartListing() if $l;
#		    next;
#		}
	    };

	    print "$_\n";
	}
	&EndMenu();

	# clear status variables;
	$active = 0;
	$seenMenu = 0;
	$indirect = 0;
	$inentry = 0;
	$lastblank = 0;

	print "--end of file $handle--<P>\n" if $DEBUG;
	close($handle);
	print "<BR> Closed file $handle\n" if $DEBUG;
	$nfiles--;
	$inentry = $save_inentry[$nfiles];
	$indirect = $save_indirect[$nfiles];
	print "--inentry: $inentry--indirect: $indirect--<p>\n" if $DEBUG;
	last if $matches;
    }
    if (!$matches) {
	&error("Couldn't find target: \"$target\" in file \"$file\".");
    }
    return $matches;
}

#---------------------------------------------------------------------------

sub make_anchor {
    local($ref, $label, $icon) = @_;
    local($node_file, $node_name, $img, $href, $noinfo);

    print "--make_anchor($ref, $label)<BR>\n" if $DEBUG;

    # (foo)bar
    if ($ref =~ m/\(([^\)]+)\)\s*([^\t,\.]*)/) {
	$node_file = $1;
	$node_name = $2;
    } elsif ($file =~ /^dir$/i) {
	print "--(DIR) node - Menu \"@_\" means \"($ref)\"<BR>\n" if $DEBUG;
	$node_file = $ref;
	$node_name = "";
    } else {
	$node_file = $h_file;
	$node_name = $ref;
    }
    $node_name =~ s/[ ]*$//;

    # Remove .info from filename for URL
    $noinfo = $node_file;
    if ($node_file =~ /\.info$/) {
	$noinfo =~ s/\.info$//;
    }

    if ($node_name ne "") {
	$href = &Escape("$noinfo\@$node_name\.html");
    } else {
	$href = &Escape("$noinfo\.html");
    }
    if ($icon) {
	$img = "<IMG SRC=\"$icon\" ALT=\"\*\"> ";
    }
    return "$img<A HREF=\"$href\">$label</A>";
}

sub StartMenu {
    print "\n<DL>" if $active;
    $menu = 1;
}

sub EndMenu {
    if ($menu) {
	print "</DL>\n" if $active;
	$menu = 0;
    }
}

sub StartListing {
    print "<PRE>\n" if $active;
    $listing++;
}

sub EndListing {
    if ($listing) {
	print "</PRE>\n" if $active;
	$listing--;
    }
}

sub FindFile {
    local($filename) = @_;
    local($dir, $fil);
    print "<BR> ", "FindFile: '$filename'\n" if $DEBUG;
    
    ($dir, $fil) = &FindFileNoAlias($filename);
    if ($dir) {
	return $dir, $fil;
    }
    # Try a possible alias...
    $fil = $filename;
    $fil =~ s/[-\.]info$//;
    $fil =~ tr/A-Z/a-z/;
    $filename = $ALIAS{$fil};
    print "<BR> ", "\$", "ALIAS{", $fil, "} = ", $filename, "\n" if $DEBUG;
    if ($filename) {
	print "<BR> Trying with the alias \"$filename\"...\n" if $DEBUG;
	return &FindFileNoAlias($filename);
    } else {
	# Bummer - no alias
	return;
    }
}
   
sub FindFileNoAlias {
    local($filename) = @_;
    local($altfilename) = $filename;
    local(@filelist) = ();
    local($dir, $fil);
    local($regex, $altregex);

    if ($filename =~ /\.info$/) {
	$altfilename =~ s/\.info$//;
    } elsif ($filename =~ /-info$/) {
	$altfilename =~ s/-info$/.info/;
    } else {
	$altfilename =~ s/$/.info/;
    }
    print "<BR> FindFileNoAlias: '$filename', Alt='$altfilename'\n" if $DEBUG;

    $regex = &ToPattern($filename);
    $altregex = &ToPattern($altfilename);

    # Try absolute match for $filename...
    if ($filename =~ /\//) {
	($dir, $fil) = ($filename =~ m,(.*)/([^/]*),);
	if ($ALLOWPATH || grep($_ eq $dir, @INFOPATH)) {
	    print "<BR> Trying absolute match for \"$filename\"...\n" if $DEBUG;
	    if (-e "$filename") {
		return $dir, $fil;
	    }
	    print "<BR> Trying absolute match for \"$altfilename\"...\n"
		if $DEBUG;
	    if (-e "$altfilename") {
		($dir, $fil) = ($altfilename =~ m,(.*)/([^/]*),);
		return $dir, $fil;
	    }
	    $file =~ s,^.*/([^/]*)$,$1,;
	    $filename =~ s,^.*/([^/]*)$,$1,;
	    $altfilename =~ s,^.*/([^/]*)$,$1,;
	    print "<BR> Stripped path from filename: $filename\n" if $DEBUG;
	} elsif (!$ALLOWPATH) {
	    print "<BR> Warning: Absolute path-names not allowed!\n" if $DEBUG;
	    $file =~ s,^.*/([^/]*)$,$1,;
	    $filename =~ s,^.*/([^/]*)$,$1,;
	    $altfilename =~ s,^.*/([^/]*)$,$1,;
	    print "<BR> Stripped path from filename: $filename\n" if $DEBUG;
	}
    }

    # Try exact match for $filename in all directories...
    print "<BR> Trying exact match for \"$filename\"...\n" if $DEBUG;
    foreach (@INFOPATH) {
	if (-e "$_/$filename") {
	    return $_, $filename;
	}
    }
    # Try exact match for $altfilename in all directories...
    print "<BR> Trying exact match for \"$altfilename\"...\n" if $DEBUG;
    foreach (@INFOPATH) {
	if (-e "$_/$altfilename") {
	    return $_, $altfilename;
	}
    }
    # Try caseless match for $filename in all directories...
    print "<BR> Trying caseless match for \"$filename\"...\n" if $DEBUG;
    @filelist = ();
    foreach (@INFOPATH) {
	$dir = $_;
	opendir(DIR, $dir);
	push (@filelist,
	      sort grep(s/^/$dir\//, grep(/^$regex$/i, readdir(DIR))));
	closedir(DIR);
    }
    if ($#filelist > 0) {
	# Multiple matches...present list or just return one item?
	($dir, $fil) = ($filelist[0] =~ m,(.*)/([^/]*),);
	return $dir, $fil;
    } elsif ($#filelist == 0) {
	($dir, $fil) = ($filelist[0] =~ m,(.*)/([^/]*),);
	return $dir, $fil;
    }
    # Try caseless match for $altfilename in all directories...
    print "<BR> Trying caseless match for \"$altfilename\"...\n" if $DEBUG;
    @filelist = ();
    foreach (@INFOPATH) {
	$dir = $_;
	opendir(DIR, $dir);
	push (@filelist,
	      sort grep(s/^/$dir\//, grep(/^$altregex$/i, readdir(DIR))));
	closedir(DIR);
    }
    if ($#filelist > 0) {
	# Multiple matches...present list or just return one item?
	($dir, $fil) = ($filelist[0] =~ m,(.*)/([^/]*),);
	return $dir, $fil;
    } elsif ($#filelist == 0) {
	($dir, $fil) = ($filelist[0] =~ m,(.*)/([^/]*),);
	return $dir, $fil;
    }
    # Bummer - no matches at all
    return;
}

sub OpenFile {
    local($filename) = @_;
    local($alternate, $handle);

    $nfiles++;
    $handle = "FH_$nfiles";
    if ($filename =~ /\//) {
	($directory, $filename) = ($filename =~ m,(.*)/([^/]*),);
    }
    $realfile{$handle} = "$directory/$filename";
    $success = 0;
    print
	"<P>Trying to open file ",
	"\"$filename\" in directory \"$directory\" ...\n" if $DEBUG;
    if (open($handle, "$directory/$filename")) {
	print "<P>Opened file \"$directory/$filename\"\n" if $DEBUG;
	return(1);
    } else {
	print "<P>Could not open file",
	"\"$filename\" in directory \"$directory\".\n" if "$DEBUG";
	return(0);
    }
}

sub error {
    local($reason) = @_;

    print 
"<TITLE>Lookup Error</TITLE>
<H1>Lookup Error</H1>
Can't retrieve your request - $reason\n";

    return(0);
}

#---------------------------------------------------------------------------
