#! /usr/bin/perl
# -*- perl_mode -*-

# yman2html yet another manpage 2 html formatter 
# (c) Leopold Toetsch <lt@toetsch.at>

# * This program is free software; you can redistribute it and/or modify
# * it under the terms of the GNU General Public License as published by
# * the Free Software Foundation; either version 2, or (at your option)
# * any later version.
# *
# * This program is distributed in the hope that it will be useful,
# * but WITHOUT ANY WARRANTY; without even the implied warranty of
# * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# * GNU General Public License for more details.
#
# BUGS
# - teatime(4pm) is considered as a manpage, and therefor
#   a link is generated
# - man links are only highlighted if there is a space
#   in front of them
# - mail/http/ftp - urls over multiple lines are not
#   linked correctly
#

use strict;
require 5.004;

my $VERSION = '0.22';
# config
my $MAN='/usr/bin/man';
my $APROPOS="/usr/bin/man -k";
my $INFO='/usr/bin/info';
my $UNIQ='/usr/bin/uniq';
my $SORT='/bin/sort';
my $AWK='/bin/awk';
# thanx to Kristian Ruud for the tip with gnuinfo
my $useGnuinfo='1';
my $index_page='../index.html';
my $section_arg='';
# end config
my $thiscgi = "$ENV{'SCRIPT_NAME'}" || "http://linux90/cgi-bin/yman2html";
my $infotext ='(The )(Texinfo documentation)( is\n\s+now the authoritative source)';
my $man_path = '';
# we are called with 
# yman2htm?m=man[&s=section]
# yman2htm?a=apropos

my (@toc, $manpage, $q, $title,$page, $apr);

&get_page;
&go;
1;

sub get_page {
    my (@pairs, $name,$value,$buffer,$pair, %form);
    if ($ENV{'QUERY_STRING'}) {
	@pairs = split(/&/, $ENV{'QUERY_STRING'});
	foreach $pair (@pairs) {
	    ($name,$value) = split(/=/,$pair);
	    $value =~ tr/+/ /;
	    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	    #$value =~ s/[^\w\d*+:.\-?\[\]()|\\]//g; # no shell chars
	    $value =~ s/[^\w\d*+:.-?\[\]()|\\]//g; # no shell chars
	    $form{$name} = $value;
	}	
	$page = $form{'m'};
	my $section = $form{'s'};
	$man_path = $form{'p'};
	my $path = $man_path ? "-M ".$man_path : '';
	#print("$path\n");
    	my $r = $form{'r'} ? '-r' : '';
	$page =~ s/[^\w\d.:\-]//g unless($r); # valid chars?
	if ($form{'a'}) {
	    $page = $form{'a'};
	    $page =~ s/[^\w\d]//g unless($r);
	    $title = "Apropos '$page'";
	    $title .= " ($section)" if($section);
	    $apr=1;
	    my $awk='';
	    if ($section) {
	    	$awk = "| $AWK" .' "/\\('.$section.'[a-z]*\\)  / {print \$0}"';
	    }	
	    $manpage = `$APROPOS $r \"$page\" | $SORT | $UNIQ $awk 2>/dev/null`;
	    $manpage =~ s!(- .*?)($page)!$1#b#$2#/b#!gi;	
	}	
	else {
		if($section eq "all")
		{
			my $cnt = `$APROPOS \"$page\" | $SORT | $UNIQ  | grep \"^$page\[^0-9a-zA-Z_\]\"|wc -l`;
			if( $cnt == 1 )
			{
				my $content = `$APROPOS \"$page\"  | grep \"^$page\[^0-9a-zA-Z_\]\"`;
				my $p1 = index ($content, "(");
				if( $p1 == -1 )
				{
					print "get section error\n";
				}
				my $p2 = index ($content , ")");
				if( $p2 == -1 )
				{
					print "get section error\n";
				}				
				$section = substr ($content, $p1 + 1, $p2 - $p1 - 1);
				$title = uc($page);
			    	$title .= "($section)" if($section);
			    	$manpage = `$MAN $path $section_arg $section $page 2>/dev/null`;				
			}
			else
			{
				
				$manpage = `$APROPOS $r \"$page\" | $SORT | $UNIQ | grep \"^$page\[^0-9a-zA-Z_\]\" 2>/dev/null`;
				
			}
		}
		else
		{
			    $title = uc($page);
			    $title .= "($section)" if($section);
			    $manpage = `$MAN $path $section_arg $section $page 2>/dev/null`;
	   	}
	   	 
	}
    }                   
    else {
	undef $/;
	$manpage = <STDIN>;
    }	
}
                       
sub header {
    my $title = $_[0];
    print "Content-type: text/html\n\n" if ($ENV{'QUERY_STRING'});
    print <<EOM;
<HTML>
<HEAD>
<TITLE>$title</TITLE>
<STYLE>
<!--
i {color:#000080}
-->
</STYLE>
</HEAD>
<BODY BGCOLOR="#f0f0f0">
<H1>$title</H1>
EOM
}
                       
sub go {                                 
    my($firstline, $lastline, $olastline);
    if ($manpage =~ /^No manual entry for/) {
	$manpage .= "Apropos says:\n\n". `$MAN -k $page | $SORT | $UNIQ 2>/dev/null`;
	$apr=1;
    }	
    $manpage =~ s/^\n+//;
    if ($manpage =~ m!
	((\w+::)?[\.\w\+\-]+	# text
	\((\d\w*|n)\)) 		# section
	\s+      
	(.*?)			# title
	\s*
	\1			# and 1st again
	!x) {
	$firstline = $&;                     
	$title = $1;
	$manpage =~ s/\n*\Q$firstline\E\n*/\n/g;	# kill it in manpages
    }	
    if ($manpage =~ /\n(.*?\d+)(\n)+$/) {
	$olastline = $1;
	$lastline = quotemeta($1);	# spaces get escaped too ???
	$lastline =~ s/\\ / /g;
	$lastline =~ s/\s+\d+$/\\s+\\d+/;	# last dig is line-num, so let this match nums
	$manpage =~ s/(\n)+$lastline(\n)+/\n/g;	# kill them in text
    }
    &header($title);
    &fmt_line;              
    &make_toc;                     
    if (@toc) {      
        print "<h3>Contents</h3><ul>\n";
	my ($lev,$fs,$fe);
        foreach (@toc) {       
    	    if (s/^\s+//) {
		if ($lev==0) {
		    print "<ul>";
		    $lev++;
		}	
		$fs = '<font size=-1>';
		$fe = '</font>';
    	    }    
	    else {
		if ($lev==1) {
		    print "</ul>";
		    $lev--;
		}    
		$fs = $fe = '';
	    }	
	    print qq(<li><a href="#$_">$fs$_$fe</a>\n);
	}
        print "</ul>";
    }	
    print "<pre>\n";      
    if($apr) {
	 $manpage =~ s!#(/)?b#!<$1b>!g;
         $manpage = "\n$manpage";
    }	 
    &add_links;
    print $manpage;             
    print "\n\n$olastline" if($olastline =~ /[a-zA-Z]/); # don't print if only line number
    print "</pre>";
    print "<hr><a href=\"$index_page\">[ Index ]</a> ";
    my $ref = $ENV{'HTTP_REFERER'};
    print "<a href=\"$ref\">[ Entry Form ]</a> " if ($ref);
    print "<a href=\"javascript:history.back()\"> [ Back ]</a>";
    print "</body></html>\n";
}

sub fmt_line {
    $manpage =~ s/&/&amp;/g;
    $manpage =~ s/</&lt;/g;
    $manpage =~ s/>/&gt;/g;
    $manpage =~ s/"/&quot;/g; #"
    $manpage =~ s/((([^&]|(&\w+;)))(\x08\2)+)+/<b>$&<\/b>/g;	# single char, or &bla; (<bs> same)+
    $manpage =~ s/([^&]|(&\w+;))(\x08\1)+/$1/g;
    $manpage =~ s/(_\x08([^&]|(&\w+;)))+/<i>$&<\/i>/g; # italic
    $manpage =~ s/_\x08([^&]|(&\w+;))/$1/g;  

    $manpage =~ s/([^&]|(&\w+;))\x08([^&]|(&\w+;))/$3/g;  # bs like regex(7)

    $manpage =~ s:</b> <b>: :g;
    $manpage =~ s:</i> <i>: :g;
}          

# URL-encode data
sub escape {
    my $toencode = shift;
    return undef unless defined($toencode);
    $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
    return $toencode;
}

sub add_links {
    my $url= $thiscgi;           
	
    # mail	    

    $manpage =~ s!
    	(mailto:)?
	([\w.\-_]+
	@([\w\-]+\.)+[a-z]{2,3})   # TODO
	!<a href="mailto:$2">$2</a>!gx;
	
    # http
    $manpage =~ s!
    	((ht|f)tp://
	([\w\-]+\.)+[a-z]{2,3}
	([/\w~\-.]+)?/?)	# TODO
	!<a href="$1">$1</a>!gx;
	
    # info	                
    if ($manpage =~ m!$infotext!o) {
	my $info = $url;
	if($useGnuinfo)	{
	    $info =~ s:/[^/]+$:/gnuinfo:;
	}
	else {    
	    $info =~ s:/[^/]+$:/info2html:;
	}    
	my $infosays=`$INFO -o- $page 2>/dev/null`;
	my ($ifile, $inode) =	$infosays =~ /File:\s(.*?)\.info,\s+Node:\s(.*?),/;
	$inode =~ s/ /%20/g;
	if($useGnuinfo)	{
	    $manpage =~ s!$infotext!$1<a href="$info/$ifile/$inode">$2</a>$3!o;	
	}    
	else {
	    $manpage =~ s!$infotext!$1<a href="$info?($ifile)$inode">$2</a>$3!o;	
	}    
    }	
    # man
    $manpage =~ s!
	(\s)			# newl, space 1
	(<[bi]>)?		# opt bold    2
	((\w+::)?[\w\+\-\.]+)  	# text   3,4
	(</[bi]>)? 		# end opt bold    5
	([ ]?)			# 6
	(<[bi]>)?		# opt bold       7
	\(
	(<[bi]>)?		# opt bold       8
	(\d[A-Za-z]*|n)		# section         9
	(</[bi]>)?		# end opt bold 10
	\) 
	(</[bi]>)?		# end opt bold 11
	!"$1<a href=\"$url?m=" . &escape("$3") . "&s=$9\">$2$3$5$6$7($8$9$10)$11</a>"!gex;
        # ƥģʽmanת(Ľ)
    # keyword (section) мΪһͶո
   	$manpage =~ s!
	(\s)?			# newl, space 		1
	(<[bi]>)?		# opt bold    		2
	((\w+::)?[\w\+\-\.]+)  	# text   	3,4
	(</[bi]>)? 		# end opt bold    	5
	(\s*)?			# newl, space 		6
	(<[bi]>)?       # opt bold       	7
	\(
	(<[bi]>)?		# opt bold       	8
	(\d[A-Za-z]*|n)		# section       9
	(</[bi]>)?		# end opt bold 		10
	\) 
	(</[bi]>)?		# end opt bold 		11
	!"$1<a href=\"$url?m=" . &escape("$3") . "&s=$9&p=$man_path\">$2$3$5$6$7($8$9$10)$11</a>"!gex;
		
   	# man
    # ƥģʽmanת(Ľ)
    # keyword1 [keyword2] (section)мΪһͶո
	$manpage =~ s!
	(\s)?			# newl, space 		1
	(<[bi]>)?		# opt bold    		2
	((\w+::)?[\w\+\-\.]+)  	# text   	3,4
	(</[bi]>)? 		# end opt bold    	5
	(\s*)?			# newl, space 		6
	(<[bi]>)?		# opt bold       	7
	\[
	(<[bi]>)?		# opt bold       	8
	((\w+::)?[\w\+\-\.]+)  	# text   	9,10
	(</[bi]>)?		# end opt bold 		11
	\]
	(</[bi]>)?		# end opt bold 		12
	(\s*)?			# newl, space 		13
	(<[bi]>)?		# opt bold       	14
	\(
	(<[bi]>)?		# opt bold       	15
	(\d[A-Za-z]*|n)		# section       16
	(</[bi]>)?		# end opt bold 		17
	\) 
	(</[bi]>)?		# end opt bold 		18
	!"$1<a href=\"$url?m=" . &escape("$9") . "&s=$16&p=$man_path\">$2$3$5$6$7\[$8$9$11\]$12$13$14($15$16$17)$18</a>"!gex;
}

sub make_toc {
    # a bold line of CAPS at Bol get's into main TOC
    # other bold lines are sub toc
    while ($manpage =~ s!
	\n(\n\ +)?<b>		# new line, spaces? bold
	([A-Z][\w .\(\)\-]+)	# our word(s)
	</b>\n
	!$1 ?
	  qq(\n$1<a name="$2"><b>$2</b></a>\n) :
	  qq(</pre><h3><a name="$2"><b>$2</b></a></h3><pre>)!ex) {
		push(@toc, "$1$2");	# remember it		
    }
}
