[p5sagit/p5-mst-13.2.git] / pod / pod2html.SH

case $CONFIG in
'')
	if test -f config.sh; then TOP=.;
	elif test -f ../config.sh; then TOP=..;
	elif test -f ../../config.sh; then TOP=../..;
	elif test -f ../../../config.sh; then TOP=../../..;
	elif test -f ../../../../config.sh; then TOP=../../../..;
	else
		echo "Can't find config.sh."; exit 1
	fi
	. $TOP/config.sh
	;;
esac
case "$0" in
*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
esac
echo "Extracting pod/pod2html (with variable substitutions)"
rm -f pod2html
$spitshell >pod2html <<!GROK!THIS!
#!$bin/perl
eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
	if \$running_under_some_shell;
!GROK!THIS!

$spitshell >>pod2html <<'!NO!SUBS!'
#
# pod2html - convert pod format to html
# 
# usage: pod2html [podfiles]
# will read the cwd and parse all files with .pod extension
# if no arguments are given on the command line.
#
*RS = */;
*ERRNO = *!;

use Carp;

$gensym = 0;

while ($ARGV[0] =~ /^-d(.*)/) {
    shift;
    $Debug{ lc($1 || shift) }++;
}

# look in these pods for things not found within the current pod
@inclusions = qw[
     perlfunc perlvar perlrun perlop 
];

# ck for podnames on command line
while ($ARGV[0]) {
    push(@Pods,shift);
}
$A={};

# location of pods
$dir="."; 

# The beginning of the url for the anchors to the other sections.
# Edit $type to suit.  It's configured for relative url's now.
$type='<A HREF="';		
$debug = 0;

unless(@Pods){
    opendir(DIR,$dir)  or  die "Can't opendir $dir: $ERRNO";
    @Pods = grep(/\.pod$/,readdir(DIR));
    closedir(DIR) or die "Can't closedir $dir: $ERRNO";
}
@Pods or die "expected pods";

# loop twice through the pods, first to learn the links, then to produce html
for $count (0,1){
    (print "Scanning pods...\n") unless $count;
    foreach $podfh ( @Pods ) {
	($pod = $podfh) =~ s/\.pod$//;
	Debug("files", "opening 2 $podfh" );
	(print "Creating $pod.html from $podfh\n") if $count;
	$RS = "\n=";
	open($podfh,"<".$podfh)  || die "can't open $podfh: $ERRNO";
	@all=<$podfh>;
	close($podfh);
	$RS = "\n";
	$all[0]=~s/^=//;
	for(@all){s/=$//;}
	$Podnames{$pod} = 1;
	$in_list=0;
	$html=$pod.".html";
	if($count){
	    open(HTML,">$html") || die "can't create $html: $ERRNO";
	    print HTML <<'HTML__EOQ', <<"HTML__EOQQ";
	    <!-- \$RCSfile\$\$Revision\$\$Date\$ -->
	    <!-- \$Log\$ -->
	    <HTML>
HTML__EOQ
	    <TITLE> \U$pod\E </TITLE>
HTML__EOQQ
	}

	for($i=0;$i<=$#all;$i++){

	    $all[$i] =~ /^(\w+)\s*(.*)\n?([^\0]*)$/ ;
	    ($cmd, $title, $rest) = ($1,$2,$3);
	    if ($cmd eq "item") {
		if($count ){
		    ($depth) or do_list("over",$all[$i],\$in_list,\$depth);
		    do_item($title,$rest,$in_list);
		}
		else{
		    # scan item
		    scan_thing("item",$title,$pod);
		}
	    }
	    elsif ($cmd =~ /^head([12])/){
		$num=$1;
		if($count){
		    do_hdr($num,$title,$rest,$depth);
		}
		else{
		    # header scan
		    scan_thing($cmd,$title,$pod); # skip head1
		}
	    }
	    elsif ($cmd =~ /^over/) {
		$count and $depth and do_list("over",$all[$i+1],\$in_list,\$depth);
	    }
	    elsif ($cmd =~ /^back/) {
		if($count){
		    ($depth) or next; # just skip it
		    do_list("back",$all[$i+1],\$in_list,\$depth);
		    do_rest("$title.$rest");
		}
	    }
	    elsif ($cmd =~ /^cut/) {
		next;
	    }
	    elsif($Debug){
		(warn "unrecognized header: $cmd") if $Debug;
	    }
	}
        # close open lists without '=back' stmts
	if($count){
	    while($depth){
		 do_list("back",$all[$i+1],\$in_list,\$depth);
	    }
	    print HTML "\n</HTML>\n";
	}
    }
}

sub do_list{
    my($which,$next_one,$list_type,$depth)=@_;
    my($key);
    if($which eq "over"){
	($next_one =~ /^item\s+(.*)/ ) or (warn "Bad list, $1\n") if $Debug;
	$key=$1;
	if($key =~ /^1\.?/){
	$$list_type = "OL";
	}
	elsif($key =~ /\*\s*$/){
	$$list_type="UL";
	}
	elsif($key =~ /\*?\s*\w/){
	$$list_type="DL";
	}
	else{
	(warn "unknown list type for item $key") if $Debug;
	}
	print HTML qq{\n};
	print HTML qq{<$$list_type>};
	$$depth++;
    }
    elsif($which eq "back"){
	print HTML qq{\n</$$list_type>\n};
	$$depth--;
    }
}

sub do_hdr{
    my($num,$title,$rest,$depth)=@_;
    ($num == 1) and print HTML qq{<p><hr>\n};
    process_thing(\$title,"NAME");
    print HTML qq{\n<H$num> };
    print HTML $title; 
    print HTML qq{</H$num>\n};
    do_rest($rest);
}

sub do_item{
    my($title,$rest,$list_type)=@_;
    process_thing(\$title,"NAME");
    if($list_type eq "DL"){
	print HTML qq{\n<DT><STRONG>\n};
	print HTML $title; 
	print HTML qq{\n</STRONG></DT>\n};
	print HTML qq{<DD>\n};
    }
    else{
	print HTML qq{\n<LI>};
	($list_type ne "OL") && (print HTML $title,"\n");
    }
    do_rest($rest);
    print HTML ($list_type eq "DL" )? qq{</DD>} : qq{</LI>};
}

sub do_rest{
    my($rest)=@_;
    my(@lines,$p,$q,$line,,@paras,$inpre);
    @paras=split(/\n\n+/,$rest);
    for($p=0;$p<=$#paras;$p++){
	@lines=split(/\n/,$paras[$p]);
	if($lines[0] =~ /^\s+\w*\t.*/){  # listing or unordered list
	    print HTML qq{<UL>};
	    foreach $line (@lines){ 
		($line =~ /^\s+(\w*)\t(.*)/) && (($key,$rem) = ($1,$2));
		print HTML defined($Podnames{$key}) ?
		    "<LI>$type$key.html\">$key<\/A>\t$rem</LI>\n" : 
			"<LI>$line</LI>\n";
	    }
	    print HTML qq{</UL>\n};
	}
	elsif($lines[0] =~ /^\s/){       # preformatted code
	    if($paras[$p] =~/>>|<</){
		print HTML qq{\n<PRE>\n};
		$inpre=1;
	    }
	    else{
		print HTML qq{\n<XMP>\n};
		$inpre=0;
	    }
inner:
	    while(defined($paras[$p])){
	        @lines=split(/\n/,$paras[$p]);
		foreach $q (@lines){
		    if($paras[$p]=~/>>|<</){
			if($inpre){
			    process_thing(\$q,"HTML");
			}
			else {
			    print HTML qq{\n</XMP>\n};
			    print HTML qq{<PRE>\n};
			    $inpre=1;
			    process_thing(\$q,"HTML");
			}
		    }
		    while($q =~  s/\t+/' 'x (length($&) * 8 - length($`) % 8)/e){
			1;
		    }
		    print HTML  $q,"\n";
		}
		last if $paras[$p+1] !~ /^\s/;
		$p++;
	    }
	    print HTML ($inpre==1) ? (qq{\n</PRE>\n}) : (qq{\n</XMP>\n});
	}
	else{                             # other text
	    @lines=split(/\n/,$paras[$p]);
	    foreach $line (@lines){
                process_thing(\$line,"HTML");
		print HTML qq{$line\n};
	    }
	}
	print HTML qq{<p>};
    }
}

sub process_thing{
    my($thing,$htype)=@_;
    pre_escapes($thing);
    find_refs($thing,$htype);
    post_escapes($thing);
}

sub scan_thing{
    my($cmd,$title,$pod)=@_;
    $_=$title;
    s/\n$//;
    s/E<(.*?)>/&$1;/g;
    # remove any formatting information for the headers
    s/[SFCBI]<(.*?)>/$1/g;         
    # the "don't format me" thing
    s/Z<>//g;
    if ($cmd eq "item") {

        if (/^\*/) 	{  return } 	# skip bullets
        if (/^\d+\./) 	{  return } 	# skip numbers
        s/(-[a-z]).*/$1/i;
	trim($_);
        return if defined $A->{$pod}->{"Items"}->{$_};
        $A->{$pod}->{"Items"}->{$_} = gensym($pod, $_);
        $A->{$pod}->{"Items"}->{(split(' ',$_))[0]}=$A->{$pod}->{"Items"}->{$_};
        Debug("items", "item $_");
        if (!/^-\w$/ && /([%\$\@\w]+)/ && $1 ne $_ 
    	    && !defined($A->{$pod}->{"Items"}->{$_}) && ($_ ne $1)) 
        {
    	    $A->{$pod}->{"Items"}->{$1} = $A->{$pod}->{"Items"}->{$_};
    	    Debug("items", "item $1 REF TO $_");
        } 
        if ( m{^(tr|y|s|m|q[qwx])/.*[^/]} ) {
    	    my $pf = $1 . '//';
    	    $pf .= "/" if $1 eq "tr" || $1 eq "y" || $1 eq "s";
    	    if ($pf ne $_) {
    	        $A->{$pod}->{"Items"}->{$pf} = $A->{$pod}->{"Items"}->{$_};
    	        Debug("items", "item $pf REF TO $_");
    	    }
	}
    }
    elsif ($cmd =~ /^head[12]/){                
        return if defined($Headers{$_});
        $A->{$pod}->{"Headers"}->{$_} = gensym($pod, $_);
        Debug("headers", "header $_");
    } 
    else {
        (warn "unrecognized header: $cmd") if $Debug;
    } 
}


sub picrefs { 
    my($char, $bigkey, $lilkey,$htype) = @_;
    my($key,$ref,$podname);
    for $podname ($pod,@inclusions){
	for $ref ( "Items", "Headers" ) {
	    if (defined $A->{$podname}->{$ref}->{$bigkey}) {
		$value = $A->{$podname}->{$ref}->{$key=$bigkey};
		Debug("subs", "bigkey is $bigkey, value is $value\n");
	    } 
	    elsif (defined $A->{$podname}->{$ref}->{$lilkey}) {
		$value = $A->{$podname}->{$ref}->{$key=$lilkey};
		return "" if $lilkey eq '';
		Debug("subs", "lilkey is $lilkey, value is $value\n");
	    } 
	} 
	if (length($key)) {
            ($pod2,$num) = split(/_/,$value,2);
	    if($htype eq "NAME"){  
		return "\n<A NAME=\"".$value."\">\n$bigkey</A>\n"
	    }
	    else{
		return "\n$type$pod2.html\#".$value."\">$bigkey<\/A>\n";
	    }
	} 
    }
    if ($char =~ /[IF]/) {
	return "<EM> $bigkey </EM>";
    } elsif($char =~ /C/) {
	return "<CODE> $bigkey </CODE>";
    } else {
	return "<STRONG> $bigkey </STRONG>";
    }
} 

sub find_refs { 
    my($thing,$htype)=@_;
    my($orig) = $$thing;
    # LREF: a manpage(3f) we don't know about
    $$thing=~s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))>:the I<$1>$2 manpage:g;
    $$thing=~s/L<([^>]*)>/lrefs($1,$htype)/ge;
    $$thing=~s/([CIBF])<(\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge;
    $$thing=~s/((\w+)\(\))/picrefs("I", $1, $2,$htype)/ge;
    $$thing=~s/([\$\@%](?!&[gl]t)([\w:]+|\W\b))/varrefs($1,$htype)/ge;
    (($$thing eq $orig) && ($htype eq "NAME")) && 
	($$thing=picrefs("I", $$thing, "", $htype));
}

sub lrefs {
    my($page, $item) = split(m#/#, $_[0], 2);
    my($htype)=$_[1];
    my($podname);
    my($section) = $page =~ /\((.*)\)/;
    my $selfref;
    if ($page =~ /^[A-Z]/ && $item) {
	$selfref++;
	$item = "$page/$item";
	$page = $pod;
    }  elsif (!$item && $page =~ /[^a-z\-]/ && $page !~ /^\$.$/) {
	$selfref++;
	$item = $page;
	$page = $pod;
    } 
    $item =~ s/\(\)$//;
    if (!$item) {
    	if (!defined $section && defined $Podnames{$page}) {
	    return "\n$type$page.html\">\nthe <EM> $page </EM> manpage<\/A>\n";
	} else {
	    (warn "Bizarre entry $page/$item") if $Debug;
	    return "the <EM> $_[0] </EM>  manpage\n";
	} 
    } 

    if ($item =~ s/"(.*)"/$1/ || ($item =~ /[^\w\/\-]/ && $item !~ /^\$.$/)) {
	$text = "<EM> $item </EM>";
	$ref = "Headers";
    } else {
	$text = "<EM> $item </EM>";
	$ref = "Items";
    } 
    for $podname ($pod, @inclusions){
	undef $value;
	if ($ref eq "Items") {
	    if (defined($value = $A->{$podname}->{$ref}->{$item})) {
		($pod2,$num) = split(/_/,$value,2);
		return (($pod eq $pod2) && ($htype eq "NAME"))
	    	? "\n<A NAME=\"".$value."\">\n$text</A>\n"
	    	: "\n$type$pod2.html\#".$value."\">$text<\/A>\n";
            }
        } 
	elsif($ref eq "Headers") {
	    if (defined($value = $A->{$podname}->{$ref}->{$item})) {
		($pod2,$num) = split(/_/,$value,2);
		return (($pod eq $pod2) && ($htype eq "NAME")) 
	    	? "\n<A NAME=\"".$value."\">\n$text</A>\n"
	    	: "\n$type$pod2.html\#".$value."\">$text<\/A>\n";
            }
	}
    }
    (warn "No $ref reference for $item (@_)") if $Debug;
    return $text;
} 

sub varrefs {
    my ($var,$htype) = @_;
    for $podname ($pod,@inclusions){
	if ($value = $A->{$podname}->{"Items"}->{$var}) {
	    ($pod2,$num) = split(/_/,$value,2);
	    Debug("vars", "way cool -- var ref on $var");
	    return (($pod eq $pod2) && ($htype eq "NAME"))  # INHERIT $_, $pod
		? "\n<A NAME=\"".$value."\">\n$var</A>\n"
		: "\n$type$pod2.html\#".$value."\">$var<\/A>\n";
	}
    }
    Debug( "vars", "bummer, $var not a var");
    return "<STRONG> $var </STRONG>";
} 

sub gensym {
    my ($podname, $key) = @_;
    $key =~ s/\s.*//;
    ($key = lc($key)) =~ tr/a-z/_/cs;
    my $name = "${podname}_${key}_0";
    $name =~ s/__/_/g;
    while ($sawsym{$name}++) {
        $name =~ s/_?(\d+)$/'_' . ($1 + 1)/e;
    }
    return $name;
} 

sub pre_escapes {
    my($thing)=@_;
    $$thing=~s/&/noremap("&amp;")/ge;
    $$thing=~s/<</noremap("&lt;&lt;")/eg;
    $$thing=~s/(?:[^ESIBLCF])</noremap("&lt;")/eg;
    $$thing=~s/E<([^\/][^<>]*)>/\&$1\;/g;              # embedded special
}

sub noremap {
    my $hide = $_[0];
    $hide =~ tr/\000-\177/\200-\377/;
    $hide;
} 

sub post_escapes {
    my($thing)=@_;
    $$thing=~s/[^GM]>>/\&gt\;\&gt\;/g;
    $$thing=~s/([^"MGAE])>/$1\&gt\;/g;
    $$thing=~tr/\200-\377/\000-\177/;
}

sub Debug {
    my $level = shift;
    print STDERR @_,"\n" if $Debug{$level};
} 

sub dumptable  {
    my $t = shift;
    print STDERR "TABLE DUMP $t\n";
    foreach $k (sort keys %$t) {
	printf STDERR "%-20s <%s>\n", $t->{$k}, $k;
    } 
} 
sub trim {
    for (@_) {
        s/^\s+//;
        s/\s\n?$//;
    }
}


!NO!SUBS!
chmod 755 pod2html
$eunicefix pod2html
Commit	Line	Data
5d94fbed	1	case $CONFIG in
	2	'')
	3	if test -f config.sh; then TOP=.;
	4	elif test -f ../config.sh; then TOP=..;
	5	elif test -f ../../config.sh; then TOP=../..;
	6	elif test -f ../../../config.sh; then TOP=../../..;
	7	elif test -f ../../../../config.sh; then TOP=../../../..;
	8	else
	9	echo "Can't find config.sh."; exit 1
	10	fi
	11	. $TOP/config.sh
	12	;;
	13	esac
	14	case "$0" in
	15	/) cd `expr X$0 : 'X\(.*\)/'` ;;
	16	esac
	17	echo "Extracting pod/pod2html (with variable substitutions)"
	18	rm -f pod2html
	19	$spitshell >pod2html <<!GROK!THIS!
	20	#!$bin/perl
	21	eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
	22	if \$running_under_some_shell;
	23	!GROK!THIS!
	24
	25	$spitshell >>pod2html <<'!NO!SUBS!'
748a9306	26	#
	27	# pod2html - convert pod format to html
	28	#
	29	# usage: pod2html [podfiles]
	30	# will read the cwd and parse all files with .pod extension
	31	# if no arguments are given on the command line.
	32	#
	33	RS = /;
	34	ERRNO = !;
	35
	36	use Carp;
	37
	38	$gensym = 0;
	39
	40	while ($ARGV[0] =~ /^-d(.*)/) {
	41	shift;
	42	$Debug{ lc($1 \|\| shift) }++;
	43	}
	44
	45	# look in these pods for things not found within the current pod
	46	@inclusions = qw[
	47	perlfunc perlvar perlrun perlop
	48	];
	49
	50	# ck for podnames on command line
	51	while ($ARGV[0]) {
	52	push(@Pods,shift);
	53	}
	54	$A={};
	55
	56	# location of pods
	57	$dir=".";
a0d0e21e	58
a0d0e21e	59	# The beginning of the url for the anchors to the other sections.
748a9306	60	# Edit $type to suit. It's configured for relative url's now.
	61	$type='<A HREF="';
	62	$debug = 0;
	63
	64	unless(@Pods){
	65	opendir(DIR,$dir) or die "Can't opendir $dir: $ERRNO";
	66	@Pods = grep(/\.pod$/,readdir(DIR));
	67	closedir(DIR) or die "Can't closedir $dir: $ERRNO";
a0d0e21e	68	}
748a9306	69	@Pods or die "expected pods";
a0d0e21e	70
748a9306	71	# loop twice through the pods, first to learn the links, then to produce html
748a9306	72	for $count (0,1){
5d94fbed	73	(print "Scanning pods...\n") unless $count;
748a9306	74	foreach $podfh ( @Pods ) {
	75	($pod = $podfh) =~ s/\.pod$//;
	76	Debug("files", "opening 2 $podfh" );
5d94fbed	77	(print "Creating $pod.html from $podfh\n") if $count;
748a9306	78	$RS = "\n=";
	79	open($podfh,"<".$podfh) \|\| die "can't open $podfh: $ERRNO";
	80	@all=<$podfh>;
	81	close($podfh);
	82	$RS = "\n";
	83	$all[0]=~s/^=//;
	84	for(@all){s/=$//;}
	85	$Podnames{$pod} = 1;
	86	$in_list=0;
	87	$html=$pod.".html";
	88	if($count){
748a9306	89	open(HTML,">$html") \|\| die "can't create $html: $ERRNO";
748a9306	90	print HTML <<'HTML__EOQ', <<"HTML__EOQQ";
5d94fbed	91	<!-- \$RCSfile\$\$Revision\$\$Date\$ -->
5d94fbed	92	<!-- \$Log\$ -->
748a9306	93	<HTML>
	94	HTML__EOQ
	95	<TITLE> \U$pod\E </TITLE>
	96	HTML__EOQQ
a0d0e21e	97	}
748a9306	98
	99	for($i=0;$i<=$#all;$i++){
	100
	101	$all[$i] =~ /^(\w+)\s(.)\n?([^\0]*)$/ ;
	102	($cmd, $title, $rest) = ($1,$2,$3);
	103	if ($cmd eq "item") {
	104	if($count ){
5d94fbed	105	($depth) or do_list("over",$all[$i],\$in_list,\$depth);
5d94fbed	106	do_item($title,$rest,$in_list);
a0d0e21e	107	}
a0d0e21e	108	else{
748a9306	109	# scan item
5d94fbed	110	scan_thing("item",$title,$pod);
a0d0e21e	111	}
a0d0e21e	112	}
748a9306	113	elsif ($cmd =~ /^head([12])/){
	114	$num=$1;
	115	if($count){
5d94fbed	116	do_hdr($num,$title,$rest,$depth);
748a9306	117	}
	118	else{
	119	# header scan
5d94fbed	120	scan_thing($cmd,$title,$pod); # skip head1
748a9306	121	}
a0d0e21e	122	}
748a9306	123	elsif ($cmd =~ /^over/) {
5d94fbed	124	$count and $depth and do_list("over",$all[$i+1],\$in_list,\$depth);
a0d0e21e	125	}
748a9306	126	elsif ($cmd =~ /^back/) {
	127	if($count){
	128	($depth) or next; # just skip it
5d94fbed	129	do_list("back",$all[$i+1],\$in_list,\$depth);
5d94fbed	130	do_rest("$title.$rest");
a0d0e21e	131	}
748a9306	132	}
748a9306	133	elsif ($cmd =~ /^cut/) {
5d94fbed	134	next;
a0d0e21e	135	}
5d94fbed	136	elsif($Debug){
5d94fbed	137	(warn "unrecognized header: $cmd") if $Debug;
a0d0e21e	138	}
a0d0e21e	139	}
5d94fbed	140	# close open lists without '=back' stmts
748a9306	141	if($count){
748a9306	142	while($depth){
5d94fbed	143	do_list("back",$all[$i+1],\$in_list,\$depth);
748a9306	144	}
748a9306	145	print HTML "\n</HTML>\n";
a0d0e21e	146	}
	147	}
	148	}
a0d0e21e	149
748a9306	150	sub do_list{
	151	my($which,$next_one,$list_type,$depth)=@_;
	152	my($key);
	153	if($which eq "over"){
5d94fbed	154	($next_one =~ /^item\s+(.*)/ ) or (warn "Bad list, $1\n") if $Debug;
748a9306	155	$key=$1;
	156	if($key =~ /^1\.?/){
	157	$$list_type = "OL";
	158	}
	159	elsif($key =~ /\\s$/){
	160	$$list_type="UL";
	161	}
	162	elsif($key =~ /\?\s\w/){
	163	$$list_type="DL";
	164	}
	165	else{
5d94fbed	166	(warn "unknown list type for item $key") if $Debug;
748a9306	167	}
	168	print HTML qq{\n};
	169	print HTML qq{<$$list_type>};
	170	$$depth++;
	171	}
	172	elsif($which eq "back"){
	173	print HTML qq{\n</$$list_type>\n};
	174	$$depth--;
	175	}
a0d0e21e	176	}
a0d0e21e	177
748a9306	178	sub do_hdr{
	179	my($num,$title,$rest,$depth)=@_;
	180	($num == 1) and print HTML qq{<p><hr>\n};
5d94fbed	181	process_thing(\$title,"NAME");
748a9306	182	print HTML qq{\n<H$num> };
	183	print HTML $title;
	184	print HTML qq{</H$num>\n};
5d94fbed	185	do_rest($rest);
a0d0e21e	186	}
a0d0e21e	187
748a9306	188	sub do_item{
748a9306	189	my($title,$rest,$list_type)=@_;
5d94fbed	190	process_thing(\$title,"NAME");
748a9306	191	if($list_type eq "DL"){
	192	print HTML qq{\n<DT><STRONG>\n};
	193	print HTML $title;
	194	print HTML qq{\n</STRONG></DT>\n};
	195	print HTML qq{<DD>\n};
	196	}
	197	else{
	198	print HTML qq{\n<LI>};
	199	($list_type ne "OL") && (print HTML $title,"\n");
	200	}
5d94fbed	201	do_rest($rest);
748a9306	202	print HTML ($list_type eq "DL" )? qq{</DD>} : qq{</LI>};
748a9306	203	}
a0d0e21e	204
748a9306	205	sub do_rest{
748a9306	206	my($rest)=@_;
5d94fbed	207	my(@lines,$p,$q,$line,,@paras,$inpre);
748a9306	208	@paras=split(/\n\n+/,$rest);
	209	for($p=0;$p<=$#paras;$p++){
	210	@lines=split(/\n/,$paras[$p]);
	211	if($lines[0] =~ /^\s+\w\t./){ # listing or unordered list
	212	print HTML qq{<UL>};
	213	foreach $line (@lines){
	214	($line =~ /^\s+(\w)\t(.)/) && (($key,$rem) = ($1,$2));
	215	print HTML defined($Podnames{$key}) ?
	216	"<LI>$type$key.html\">$key<\/A>\t$rem</LI>\n" :
	217	"<LI>$line</LI>\n";
	218	}
	219	print HTML qq{</UL>\n};
a0d0e21e	220	}
748a9306	221	elsif($lines[0] =~ /^\s/){ # preformatted code
	222	if($paras[$p] =~/>>\|<</){
	223	print HTML qq{\n<PRE>\n};
	224	$inpre=1;
	225	}
	226	else{
	227	print HTML qq{\n<XMP>\n};
	228	$inpre=0;
	229	}
	230	inner:
	231	while(defined($paras[$p])){
	232	@lines=split(/\n/,$paras[$p]);
	233	foreach $q (@lines){
	234	if($paras[$p]=~/>>\|<</){
	235	if($inpre){
5d94fbed	236	process_thing(\$q,"HTML");
748a9306	237	}
	238	else {
	239	print HTML qq{\n</XMP>\n};
	240	print HTML qq{<PRE>\n};
	241	$inpre=1;
5d94fbed	242	process_thing(\$q,"HTML");
748a9306	243	}
	244	}
	245	while($q =~ s/\t+/' 'x (length($&) * 8 - length($`) % 8)/e){
	246	1;
	247	}
	248	print HTML $q,"\n";
	249	}
	250	last if $paras[$p+1] !~ /^\s/;
	251	$p++;
	252	}
	253	print HTML ($inpre==1) ? (qq{\n</PRE>\n}) : (qq{\n</XMP>\n});
a0d0e21e	254	}
748a9306	255	else{ # other text
	256	@lines=split(/\n/,$paras[$p]);
	257	foreach $line (@lines){
5d94fbed	258	process_thing(\$line,"HTML");
748a9306	259	print HTML qq{$line\n};
a0d0e21e	260	}
748a9306	261	}
	262	print HTML qq{<p>};
	263	}
	264	}
	265
	266	sub process_thing{
	267	my($thing,$htype)=@_;
5d94fbed	268	pre_escapes($thing);
	269	find_refs($thing,$htype);
	270	post_escapes($thing);
748a9306	271	}
	272
	273	sub scan_thing{
	274	my($cmd,$title,$pod)=@_;
	275	$_=$title;
	276	s/\n$//;
	277	s/E<(.*?)>/&$1;/g;
	278	# remove any formatting information for the headers
	279	s/[SFCBI]<(.*?)>/$1/g;
	280	# the "don't format me" thing
	281	s/Z<>//g;
	282	if ($cmd eq "item") {
	283
	284	if (/^\*/) { return } # skip bullets
	285	if (/^\d+\./) { return } # skip numbers
	286	s/(-[a-z]).*/$1/i;
	287	trim($_);
	288	return if defined $A->{$pod}->{"Items"}->{$_};
	289	$A->{$pod}->{"Items"}->{$_} = gensym($pod, $_);
	290	$A->{$pod}->{"Items"}->{(split(' ',$_))[0]}=$A->{$pod}->{"Items"}->{$_};
	291	Debug("items", "item $_");
	292	if (!/^-\w$/ && /([%\$\@\w]+)/ && $1 ne $_
	293	&& !defined($A->{$pod}->{"Items"}->{$_}) && ($_ ne $1))
	294	{
	295	$A->{$pod}->{"Items"}->{$1} = $A->{$pod}->{"Items"}->{$_};
	296	Debug("items", "item $1 REF TO $_");
	297	}
	298	if ( m{^(tr\|y\|s\|m\|q[qwx])/.*[^/]} ) {
	299	my $pf = $1 . '//';
	300	$pf .= "/" if $1 eq "tr" \|\| $1 eq "y" \|\| $1 eq "s";
	301	if ($pf ne $_) {
	302	$A->{$pod}->{"Items"}->{$pf} = $A->{$pod}->{"Items"}->{$_};
	303	Debug("items", "item $pf REF TO $_");
	304	}
	305	}
	306	}
	307	elsif ($cmd =~ /^head[12]/){
	308	return if defined($Headers{$_});
	309	$A->{$pod}->{"Headers"}->{$_} = gensym($pod, $_);
	310	Debug("headers", "header $_");
	311	}
	312	else {
5d94fbed	313	(warn "unrecognized header: $cmd") if $Debug;
748a9306	314	}
	315	}
	316
	317
	318	sub picrefs {
	319	my($char, $bigkey, $lilkey,$htype) = @_;
	320	my($key,$ref,$podname);
	321	for $podname ($pod,@inclusions){
	322	for $ref ( "Items", "Headers" ) {
	323	if (defined $A->{$podname}->{$ref}->{$bigkey}) {
	324	$value = $A->{$podname}->{$ref}->{$key=$bigkey};
	325	Debug("subs", "bigkey is $bigkey, value is $value\n");
	326	}
	327	elsif (defined $A->{$podname}->{$ref}->{$lilkey}) {
	328	$value = $A->{$podname}->{$ref}->{$key=$lilkey};
	329	return "" if $lilkey eq '';
	330	Debug("subs", "lilkey is $lilkey, value is $value\n");
	331	}
	332	}
	333	if (length($key)) {
	334	($pod2,$num) = split(/_/,$value,2);
	335	if($htype eq "NAME"){
	336	return "\n<A NAME=\"".$value."\">\n$bigkey</A>\n"
a0d0e21e	337	}
748a9306	338	else{
748a9306	339	return "\n$type$pod2.html\#".$value."\">$bigkey<\/A>\n";
a0d0e21e	340	}
748a9306	341	}
	342	}
	343	if ($char =~ /[IF]/) {
	344	return "<EM> $bigkey </EM>";
5d94fbed	345	} elsif($char =~ /C/) {
5d94fbed	346	return "<CODE> $bigkey </CODE>";
748a9306	347	} else {
748a9306	348	return "<STRONG> $bigkey </STRONG>";
5d94fbed	349	}
748a9306	350	}
	351
	352	sub find_refs {
	353	my($thing,$htype)=@_;
	354	my($orig) = $$thing;
	355	# LREF: a manpage(3f) we don't know about
	356	$$thing=~s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))>:the I<$1>$2 manpage:g;
	357	$$thing=~s/L<([^>]*)>/lrefs($1,$htype)/ge;
	358	$$thing=~s/([CIBF])<(\W?(-?\w).*?)>/picrefs($1, $2, $3, $htype)/ge;
	359	$$thing=~s/((\w+)\(\))/picrefs("I", $1, $2,$htype)/ge;
5d94fbed	360	$$thing=~s/([\$\@%](?!&[gl]t)([\w:]+\|\W\b))/varrefs($1,$htype)/ge;
748a9306	361	(($$thing eq $orig) && ($htype eq "NAME")) &&
	362	($$thing=picrefs("I", $$thing, "", $htype));
	363	}
	364
	365	sub lrefs {
	366	my($page, $item) = split(m#/#, $_[0], 2);
	367	my($htype)=$_[1];
	368	my($podname);
	369	my($section) = $page =~ /\((.*)\)/;
	370	my $selfref;
	371	if ($page =~ /^[A-Z]/ && $item) {
	372	$selfref++;
	373	$item = "$page/$item";
	374	$page = $pod;
	375	} elsif (!$item && $page =~ /[^a-z\-]/ && $page !~ /^\$.$/) {
	376	$selfref++;
	377	$item = $page;
	378	$page = $pod;
	379	}
	380	$item =~ s/\(\)$//;
	381	if (!$item) {
	382	if (!defined $section && defined $Podnames{$page}) {
	383	return "\n$type$page.html\">\nthe <EM> $page </EM> manpage<\/A>\n";
	384	} else {
5d94fbed	385	(warn "Bizarre entry $page/$item") if $Debug;
748a9306	386	return "the <EM> $_[0] </EM> manpage\n";
	387	}
	388	}
	389
	390	if ($item =~ s/"(.*)"/$1/ \|\| ($item =~ /[^\w\/\-]/ && $item !~ /^\$.$/)) {
	391	$text = "<EM> $item </EM>";
	392	$ref = "Headers";
	393	} else {
	394	$text = "<EM> $item </EM>";
	395	$ref = "Items";
	396	}
	397	for $podname ($pod, @inclusions){
	398	undef $value;
	399	if ($ref eq "Items") {
	400	if (defined($value = $A->{$podname}->{$ref}->{$item})) {
	401	($pod2,$num) = split(/_/,$value,2);
	402	return (($pod eq $pod2) && ($htype eq "NAME"))
	403	? "\n<A NAME=\"".$value."\">\n$text</A>\n"
	404	: "\n$type$pod2.html\#".$value."\">$text<\/A>\n";
	405	}
	406	}
	407	elsif($ref eq "Headers") {
	408	if (defined($value = $A->{$podname}->{$ref}->{$item})) {
	409	($pod2,$num) = split(/_/,$value,2);
	410	return (($pod eq $pod2) && ($htype eq "NAME"))
	411	? "\n<A NAME=\"".$value."\">\n$text</A>\n"
	412	: "\n$type$pod2.html\#".$value."\">$text<\/A>\n";
	413	}
	414	}
	415	}
5d94fbed	416	(warn "No $ref reference for $item (@_)") if $Debug;
748a9306	417	return $text;
	418	}
	419
	420	sub varrefs {
	421	my ($var,$htype) = @_;
	422	for $podname ($pod,@inclusions){
	423	if ($value = $A->{$podname}->{"Items"}->{$var}) {
	424	($pod2,$num) = split(/_/,$value,2);
	425	Debug("vars", "way cool -- var ref on $var");
	426	return (($pod eq $pod2) && ($htype eq "NAME")) # INHERIT $_, $pod
	427	? "\n<A NAME=\"".$value."\">\n$var</A>\n"
	428	: "\n$type$pod2.html\#".$value."\">$var<\/A>\n";
a0d0e21e	429	}
a0d0e21e	430	}
748a9306	431	Debug( "vars", "bummer, $var not a var");
	432	return "<STRONG> $var </STRONG>";
	433	}
	434
	435	sub gensym {
	436	my ($podname, $key) = @_;
	437	$key =~ s/\s.*//;
	438	($key = lc($key)) =~ tr/a-z/_/cs;
	439	my $name = "${podname}_${key}_0";
	440	$name =~ s/__/_/g;
	441	while ($sawsym{$name}++) {
	442	$name =~ s/_?(\d+)$/'_' . ($1 + 1)/e;
	443	}
	444	return $name;
	445	}
	446
	447	sub pre_escapes {
	448	my($thing)=@_;
	449	$$thing=~s/&/noremap("&")/ge;
	450	$$thing=~s/<</noremap("<<")/eg;
	451	$$thing=~s/(?:[^ESIBLCF])</noremap("<")/eg;
	452	$$thing=~s/E<([^\/][^<>]*)>/\&$1\;/g; # embedded special
a0d0e21e	453	}
748a9306	454
	455	sub noremap {
	456	my $hide = $_[0];
	457	$hide =~ tr/\000-\177/\200-\377/;
	458	$hide;
	459	}
	460
	461	sub post_escapes {
	462	my($thing)=@_;
	463	$$thing=~s/[^GM]>>/\&gt\;\&gt\;/g;
5d94fbed	464	$$thing=~s/([^"MGAE])>/$1\&gt\;/g;
748a9306	465	$$thing=~tr/\200-\377/\000-\177/;
a0d0e21e	466	}
748a9306	467
	468	sub Debug {
	469	my $level = shift;
	470	print STDERR @_,"\n" if $Debug{$level};
	471	}
	472
	473	sub dumptable {
	474	my $t = shift;
	475	print STDERR "TABLE DUMP $t\n";
	476	foreach $k (sort keys %$t) {
	477	printf STDERR "%-20s <%s>\n", $t->{$k}, $k;
	478	}
	479	}
	480	sub trim {
	481	for (@_) {
	482	s/^\s+//;
	483	s/\s\n?$//;
	484	}
	485	}
	486
	487
5d94fbed	488	!NO!SUBS!
	489	chmod 755 pod2html
	490	$eunicefix pod2html