#!/usr/local/bin/perl # # # # # # # use myCPAN; require ("cgi-lib.pl"); require ("mak-lib.pl"); chomp($title = `uname -sr`); $title .= " On-Line Manuals" ; $ME = $ENV{'SCRIPT_NAME'} || $0 ; # Unbuffer output $| = 1; sub selected { my ( $value ) = @_ ; return ( ($selected eq $value) ? "SELECTED " : "" ) . 'VALUE="' . $value . '"'; } sub PrintFORM { print "

$title

\n", "Enter the name of the command or function, optionally followed by\n", "the section number surrounded by parenthesis.\n", "

\n", "For example:\n", "

\n", "

\n", "\n", "\n", " \n", " \n", "
What manual page would you like to see?\n", " What section?\n", " \n", "
\n", " \n", "     ", " \n", "
\n", " \n", "
\n", "
\n", "
\n"; } sub whatis { my ($section,$manpage) = @_ ; $command = "man"; $command .= " -s $section" if $section; $command .= " -k '$manpage' | sort | uniq"; open(WHATIS,"$command |") ; print "
\n";
	while () {
			# Patterns
			$parens = '\(\)' ;          # Empty Parenthesis
			$n_pat  = '[:\-\.\+\w$]+' ; # Man page
			$s_pat  = '\d\w*' ;         # Section

			# Filters
			next if m/^\.B\s/;

			s/\.PP.*//;
			#s/\.LP.*//;
			s/\\\*\(fp//;
			s/\\f\(C//;
			s/\\\*\(FF//;
			s/\.IX Header "NAME" //;

			# Fix up garbage
			s/\(\s+\)/()/g ;
			s/^\s+// ;
			s/\s*(\(\d\w*\))/$1/g ;

			# Additional filters
			s/\b.SM\s*(\w)/$1™/;

			# Filter section if given
			if ($section) {
				next unless m/\($section\)/i;
			}

			# Resolve the normal man page links
			# Form: manpage(section)
			if ( /(($n_pat)($parens)?)\(($s_pat)\)/ ) {
				s//$1($4)<\/A>/g ;
			}
			# Resolve the goofy first column links
			# Form: ^manpage
			if ( $^O ne 'solaris' and /^(($n_pat)($parens)?)/ ) {
				s//$1<\/A>/g ;
			}
			# Resolve the goofy lists of links
			# Form: ..., manpage,... and ...: manpage,...
			if ( $^O ne 'solaris' and /([:,])\s+(($n_pat)($parens)?)(,)/ ) {
				s//$1 $2<\/A>$5/g ;
			}
			# Resolve the goofy lists of links that the above missed
			# Form: ..., manpage,... and ...: manpage,...
			if ( $^O ne 'solaris' and /([:,])\s+(($n_pat)($parens)?)(,)/ ) {
				s//$1 $2<\/A>$5/g ;
			}
			print ;
	}
	close (WHATIS) ;
	print "
\n"; } # Main processing $FORM{'manpage'} = shift @ARGV ; $FORM{'section'} = shift @ARGV ; $FORM{KEYWORDLIST} = shift @ARGV ; unless (defined $FORM{'manpage'} or ReadParse(*FORM)) { print PrintHeader(), MAKHdr($title); PrintFORM() ; print HtmlBot(); exit; } # Get the man page ($manpage = $FORM{'manpage'}) =~ s/^\s*(.*)\s*$/$1/; # Make sure we have no goofy stuff unless ( $manpage =~ /^[:\+\-\.\w_]*$/ ) { MAKDie($title, "Invalid manual page specification") ; } # Get the section $section = $FORM{'section'} ; undef $section if $section eq "Dont Know" ; # Make sure our MANPATH is set @checklist = ( #'/usr/openwin/share/man', # Sun #'/usr/openwin/man', # Sun #'/opt/SUNWspro/man', # Sun #'/opt/SUNWmfdoc/man', # Sun #'/usr/man', # Sun #'/usr/local/bin', # MDC 'usr/share/man', # BSDI '/usr/X11/man', # BSDI '/usr/contrib/man', # BSDI '/usr/local/man', # BSDI, Sun #'/tools/man', # MDC '/home/mike808/man', '/home/mike808/CPAN/man' ); @manpath = split(':',$ENV{'MANPATH'}); @addlist = (); foreach $check (@checklist) { foreach $path (@manpath) { undef $check if $path eq $check; undef $check unless -d $path; undef $check unless -f "$path/whatis.db"; } if ($check) { undef $check unless -d $check; undef $check unless -f "$check/whatis.db"; } push (@addlist, $check) if $check; } # Don't do MANPATH for now on BSD delete $ENV{'MANPATH'}; # $ENV{'MANPATH'} = join(':', @manpath, @addlist); # Generate a keyword list if selected if (defined $FORM{KEYWORDLIST}) { print PrintHeader(), MAKHdr($title); PrintFORM() ; whatis($section,$manpage); exit; } # Make sure we have a manpage to display unless ( $manpage ) { MAKDie($title, "Missing manual page specification") ; } # Run a man on the thing and see if we get anything $tmp = "/tmp/man.cgi.$$"; open(TMP,">>$tmp"); $command = "man"; $command .= " -s $section" if $section; $command .= " - $manpage 2>/dev/null" ; $rslt = `$command` ; $err = $?; print TMP $rslt unless $err; close TMP; # Check for errors if( $err or -z $tmp) { MAKDie($title, "Error locating the requested document") ; } 1 while unlink($tmp); # Try with the -F option if ($rslt =~ m/^No manual entry for/) { # Run a man -F on the thing and see if we get anything $tmp = "/tmp/man.cgi.$$"; open(TMP,">>$tmp"); $command = "man -F"; $command .= " -s $section" if $section; $command .= " - $manpage 2>/dev/null" ; $rslt = `$command` ; $err = $?; print TMP $rslt unless $err; close TMP; # Check for errors if( $err or -z $tmp) { MAKDie($title, "Error locating the requested document") ; } 1 while unlink($tmp); if ($rslt =~ m/^No manual entry for/) { MAKDie($title, "Could not find the requested document") ; } } print PrintHeader(); $title2 = $title . " - " . $manpage ; $title2 .= "(" . $section . ")" if $section ; print MAKHdr("$title2","","$title"); $blank = 0 ; $heading = 0 ; open(MANUAL,"$command |") ; print "
\n";
$line=0 ;
while () {
	chomp;
	# Skip consecutive blank lines
	if ( /^\s*$/ ) {
		$blank++;
		next ;
	}
	$line++ ; # Increment our line counter

	# Do headings (ALL CAPS = A-Z0-9_().-/
	if ( /^\s*([A-Z\d_\(\)\.\-\/\s\b]+)\s*$/ ) {
		# Strip all the overstrikes out
		($heading = $1) =~ s/.[\b]//g ;

		# Skip things that look like 
 text or command line parameters
		unless (m/^[ ]{6,}/ or $heading =~ m/^-/ ) {
				print "\n

", $heading, "

\n" ; $blank = -100 if $blank > 0 ; # Ignore any preceding & following blanks next ; } } # Mangle funny characters for HTML s//&/g if /&/ ; s//</g if // ; # Bold all the char(BS+char+BS+char+BS+char) sequences # Including the funny characters we just mangled if ( /((((\S|>|<|&))([\b]\3))+)/ ) { s//$1<\/B>/g ; s/((\S|>|<|&))([\b]\1)+/$1/g ; } # Italicize all the punctuation+backspace sequences # We do this *after* bolding if ( /(([_\-\.][\b]\S)+)/ ) { s//$1<\/I>/g ; s/[_\-\.][\b]//g ; } # Handle bullets (oBS+ or +BSo) s/o[\b]\+/*<\/B>/g ; s/\+[\b]o/*<\/B>/g ; # Piece back together connected sections # i.e. a_b, a-b, a.b, a:b, a::b, a\s*b) s/<\/([IB])>(([:_\+\-\.\/\(\)\s])*)<\1>/$2/g ; # Do we have heading1 and print it the first time unless ( $head1 or $line != 1 ) { if ( /^ (\S+)\s+.*?\s+\1<\/B>$/i or $^O eq 'solaris') { $head1 = $_; # Fix overlaid centering problem while ( $_ =~ m/(.[\b].)+/ ) { my $pfx = $`; my $match = $&; my $suf = $'; my $sufpfx = ''; while ( $match =~ m/(.)[\b](.)/ ) { $pfx .= $1; $sufpfx .= $2; $match = $'; } $suf = $sufpfx . $suf; $_ = $pfx . "         " . $suf; } print "
", $_, "
\n" ; $blank = -100 if $blank > 0 ; # Ignore any preceding & following blanks next ; } } # Skip it the rest of the time if ( $_ eq $head1 ) { $blank = -100 if $blank > 0 ; # Ignore any preceding & following blanks next ; } # Do we have heading2 and print it the first time unless ( $head2 or $line != 2 ) { if ( /^ (.+)\s\s*\s\1<\/B>$/ ) { $head2 = $_ ; print "
", $_, "
\n" ; $blank = -100 if $blank > 0 ; # Ignore any preceding & following blanks next ; } } # Skip it the rest of the time if ( $_ eq $head2 ) { $blank = -100 if $blank > 0 ; # Ignore any preceding & following blanks next ; } # Do we have heading3 and print it the first time unless ( $head3 or $line != 3 ) { if ( /^\s+.+<\/B>$/ ) { $head3 = $_ ; print "
", $_, "
\n" ; $blank = -100 if $blank > 0 ; # Ignore any preceding & following blanks next ; } } # Skip it the rest of the time if ( $_ eq $head3 ) { $blank = -100 if $blank > 0 ; # Ignore any preceding & following blanks next ; } # Do we have a footer? unless ( $foot1 ) { if ( /^( Hewlett-Packard Company|\d+\/...\/\d+\s+Last change:)/ ) { $foot1 = $_ ; $foot1 =~ s/\s*\d+$//; } } # Skip footer until the end if ( $foot1 and /^$foot1/ ) { $blank -= 10 if $blank >= 4 ; # Skip 4 preceding and 6 following blanks next ; } # Do we have a normal footer unless ( $foot1 ) { if ( /^(.*)(- \d+ -)(\s+Formatted:.*)$/ ) { $foot1 = $1 . " " x length($2) . $3 ; } } # Skip footer until the end if ( /^(.*)(- \d+ -)(\s+Formatted:.*$)$/ ) { $blank -= 10 if $blank >= 4 ; # Skip 4 preceding and 6 following blanks next ; } # Decide what to do about blank lines if ( $blank > 0 ) { print "\n" ; } $blank = 0 ; # Handle the SEE ALSO links if ( $heading =~ /SEE\s+ALSO/ ) { if ( /(()?([:_\+\-\.\/\w]+)(<\/I>)?)\((\w+)\)/ ) { s//$1($5)<\/A>/g ; } } print $_, "\n" ; } close(MANUAL) ; # Print the footers if ( $foot1 ) { print "
", $foot1, "
\n" ; } print "
\n" ; print HtmlBot();