#! /usr/local/bin/perl
$map{'info'} = '&do_info($rest)';

$info_dir = "/usr/local/info/";

sub main'do_info {
    local($arg) = @_;
    $arg =~ s/%20/ /g;
    $arg =~ s/%26/%/g;
    do info2html($info_dir . $arg);
}

#---------------------------------------------------------------------------
# @(#)info2html	1.7 92/10/27
#
# usage: info2html [-r rootdirectory] [-s subject] filename
#
# The filename argument can contain an embedded subject for use
# with the WWW HTTP daemon; syntax is '/path/filename,subject'.
# F.e. '/usr/pkg/gnu/info/info.info,checking' will search for
# subject 'checking' in the file '/usr/pkg/gnu/info/info.info'
#
# If no subject argument is present, the subject 'Top' will be located.
#
#---------------------------------------------------------------------------

$debug = 0;
$sep = ",";

require 'yagrip.pl';

sub info2html {
    local($filename) = @_;

    $matches = 0;
    $blank = 0;
    $prefix = $protocol;			# prefix for HREF= entries
    $target = "top";

    $rootdir = "/info/";		# top of info directory tree
    $prefix .= "/" if (substr($filename,0,1) ne "/");

    if ($filename =~ /$sep/) {
	$_ = $filename;
	($path, $file, $target) = /(.+\/)([^\/]+)$sep(.+)$/;
	$prefix .= $rootdir;
	$filename = $path . $file;
    } else {
	$_ = $filename;
	($path, $file) = /^(.+\/)([^\/]+)$/;
	$prefix .= $rootdir;
    }

    $target =~ y/A-Z/a-z/;

    print "filename: $filename\nprefix: $prefix\npath: $path\nfile: $file\ntarget: $target\n" if $debug;

    $nfiles = 0;
    &OpenFile($filename) || return(0);

    $active = 0;
    $seenMenu = 0;
    $indirect = 0;
    $inentry = 0;
    $lastblank = 0;

  FileLoop:
    for (; $nfiles > 0; ) {

	local($handle) = "FH_$nfiles";
	print "--now reading from $handle--<P>\n" if $debug;
	while (<$handle>) {
	    chop;
	    /^[\037\f]/ && do {
		&EndMenu();
		&EndListing();
		exit(0) if $active;	# we've done our work
		$active = 0;
		$seenMenu = 0;
		$indirect = 0;
		$inentry = 0 if $inentry;
		$inentry++;
		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,  Previous: 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_previous;
		undef $h_up;

		@F = split(/[,\s]+/);
		for ($i = 0; $i <= $#F; ) {
		    $_ = $F[$i];
		    if ( /^node:$/i || /^file:$/i || /^up:$/i
			|| /^previous:$/i || /^prev:$/i || /^next:$/i ) {
		        #
		        # make the name of the variable:
		        #
		        $v = $_;
			$v =~ s/://;
			$v =~ tr/A-Z/a-z/;
			$v = "previous" if $v eq "prev";
			$w = "";
			#
			# find all words that belong to this field:
			#
			for ($i++; $i <= $#F; $i++) {
			    $_ = $F[$i];
			    last if ( /^node:$/i || /^file:$/i
				     || /^up:$/i || /^previous:$/i
				     || /^prev:$/i || /^next:$/i );
			    $w .= $_ . " ";
			}
			$w =~ s/\s+$//;		# delete trailing spaces
			eval "\$h_$v = \$w;";
		    } else {
			$i++;
		    }
		}
		
		print "--h_node: $h_node--<p>\n" if $debug;
		$n = 0;

		if ($h_node =~ m/^$target/i) {
		    $active = 1;
		    $matches++;
		    print "<TITLE>$h_file -- $h_node</TITLE>\n";
		    if (defined $h_file) {
			#print "<COMMENT file=$h_file>\n";
		    }
		    if (defined $h_up) {
			print " up: ", &make_anchor($h_up, $h_up), "\n";
			$n++;
		    }
		    if (defined $h_previous) {
			print " previous: ", 
			  &make_anchor($h_previous, $h_previous), "\n";
			$n++;
		    }
		    if (defined $h_next) {
			print " next: ", &make_anchor($h_next, $h_next), "\n";
			$n++;
		    }
		}

		print "<P>\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($root . $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), "<DD>";
		    $rest_of_line =~ s/^[\s\.]+//;
		    print $rest_of_line;
		    next;
		};

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

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

		# no match: ignore silently
	    };

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

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

	    /\*note/i && do {
		# cross reference entry:
		# "*note nodename::."
		# "*note Croff-reference-name: nodename."
		local($n) = 0;
		while (1) {
		    # *note foo:
		    if (/\*note\s+([^:\.]+)::/i) {
			s//@@@NOTE@@@/;	# insert unique (I hope) marker
			local($ref) = sprintf("Note: %s", 
					      &make_anchor($1, $1));
			s/@@@NOTE@@@/$ref$1<\/A>/;
			$n++;
			next;
		    }

		    # * foo: (bar)beer OR (bar)
		    if (/\*note\s+([^:]+):\s+\(([^\) \t\n]+)\)([^\t\n\.,]*)/i) {
			s//@@@NOTE@@@/;	# insert unique (I hope) marker
			local($ref) = sprintf("Note: %s", 
					      &make_anchor("($2)$3", $1));
			s/@@@NOTE@@@/$ref/;
			$n++;
			next;
		    }

		    # * foo: beer.
		    if (/\*note\s+([^:]+):\s+([^\t,\n\.]+)/i) {
			s//@@@NOTE@@@/;	# insert unique (I hope) marker
			local($ref) = sprintf("Note: %s", 
					      &make_anchor($2, $1));
			s/@@@NOTE@@@/$ref/;
			$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;
	$nfiles--;
	$inentry = $save_inentry[$nfiles];
	$indirect = $save_indirect[$nfiles];
	print "--inentry: $inentry--indirect: $indirect--<p>\n" if $debug;
    }
    if ($matches == 0) {
	print "Sorry, entry '$target' was not found.\n";
    }
}

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

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

    # (foo)bar
    if ($ref =~ m/\(([^\)]+)\)\s*([^\t\n,\.]*)/) {
	$node_file = $1;
	$node_name = $2;
    } else {
	$node_file = $file;
	$node_name = $ref;
    }
    $node_name =~ s/[ ]*$//;
    $node_name =~ s/%/%26/g;  
    $node_name =~ s/ /%20/g;  

    if ($node_name ne "") {
	"<A HREF=\"$prefix$node_file$sep$node_name\">$label</A>";
    } else {
	"<A HREF=\"$prefix$node_file\">$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 Usage {
    print STDERR
      "usage: info2html [-r rootdirectory] [-s subject] filename\n";
    exit(1);
}

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

    $filename =~ y/A-Z/a-z/;
    $alternate = $filename . ".info";

    $nfiles++;
    $handle = "FH_$nfiles";
    if ( !open($handle, $filename)
	&& !open($handle, $alternate)
	&& !open($handle, $path . $filename)
	&& !open($handle, $path . $alternate) ) {
		print 
"<P>Could not open file \"$filename\" or \"$alternate\".\n";

		print "path: $path<p>\n" if $debug;
		return(0);
    }

    return(1);
}

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

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

    exit(0);
}

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