#!../perl

# The beginning of the url for the anchors to the other sections.
chop($wd=`pwd`);
$type="<A HREF=\"file://localhost".$wd."/";
$debug=0;
$/ = "";
$p=\%p;
@exclusions=("perldebug","perlform","perlobj","perlstyle","perltrap","perlmod");
$indent=0;
opendir(DIR,".");
@{$p->{"pods"}}=grep(/\.pod$/,readdir(DIR));
closedir(DIR);

# learn the important stuff

foreach $tmpod (@{$p->{"pods"}}){
    ($pod=$tmpod)=~s/\.pod$//;
    $p->{"podnames"}->{$pod}=1;
    next if grep(/$pod/,@exclusions);
    open(POD,"<$tmpod");
    while(<POD>){
	s/B<([^<>]*)>/$1/g;         # bold
	s/I<([^<>]*)>/$1/g;         # bold
        if (s/^=//) {
	    s/\n$//s;
	    s/\n/ /g;
	    ($cmd, $_) = split(' ', $_, 2);
 	    if ($cmd eq  "item") {
		($what,$rest)=split(' ', $_, 2);
		$what=~s#(-.).*#$1#;
		$what=~s/\s*$//;
		next if defined $p->{"items"}->{$what};
		$p->{"items"}->{$what} = $pod."_".$i++;
	    }
	    elsif($cmd =~ /^head/){
		$_=~s/\s*$//;
		next if defined($p->{"headers"}->{$_});
		$p->{"headers"}->{$_} = $pod."_".$i++;
	    }
	}
    }
}

$/="";
    
# parse the pods, produce html
foreach $tmpod (@{$p->{"pods"}}){
    open(POD,"<$tmpod") || die "cant open $pod";
    ($pod=$tmpod)=~s/\.pod$//;
    open(HTML,">$pod.html");
    print HTML "<!-- \$RCSfile\$\$Revision\$\$Date\$ -->\n";
    print HTML "<!-- \$Log\$ -->\n";
    print HTML "<HTML>\n";
    print HTML "<TITLE> \U$pod\E </TITLE>\n";
    $cutting = 1;
    while (<POD>) {
	if ($cutting) {
	    next unless /^=/;
	    $cutting = 0;
	}
	chop;
	length || (print "\n") && next;
	# Translate verabatim paragraph

	if (/^\s/) {
	    $unordered=0;
	    &pre_escapes;
	    &post_escapes;
	    @lines = split(/\n/);
	    if($lines[0]=~/^\s+(\w*)\t(.*)/){  # listing or unordered list
		($key,$rest)=($1,$2);
		if(defined($p->{"podnames"}->{$key})){
		    print HTML "\n<ul>\n";
		    $unordered = 1;
		}
		else{
		    print HTML  "\n<listing>\n";
		}
		foreach $line (@lines){
		    ($line =~ /^\s+(\w*)\t(.*)/) && (($key,$rest)=($1,$2));
		    print HTML defined($p->{"podnames"}->{$key}) ?
	    		"<li>$type$key.html\">$key<\/A>\t$rest\n" : "$line \n";
		}
		print HTML $unordered ? "</ul>\n" : "</listing>\n";
		next;
	    }else{                 # preformatted text
		print HTML "<pre>\n";
		for(@lines){
		    s/^/    /;
		    s/\t/        /g;
		    print HTML  $_,"\n";
	        }
            print  HTML "</pre>\n";
            next;
	    }
	}
	&pre_escapes;
	s/S<([^<>]*)>/$1/g;              # embedded special
	$_ = &Do_refs($_,$pod);
	s/Z<>/<p>/g; # ?
	s/E<([^<>]*)>/\&$1\;/g;              # embedded special
	&post_escapes;
	if (s/^=//) {
	    s/\n$//s;
	    s/\n/ /g;
	    ($cmd, $_) = split(' ', $_, 2);
	    if ($cmd eq 'cut') {
		$cutting = 1;
	    }
	    elsif ($cmd eq 'head1') {
		print HTML  qq{<h2>$_</h2>\n};
	    }
	    elsif ($cmd eq 'head2') {
		print  HTML qq{<h3>$_</h3>\n};
	    }
	    elsif ($cmd eq 'over') {
		push(@indent,$indent);
		$indent = $_ + 0;
		print HTML  qq{\n<dl>\n};
	    }
	    elsif ($cmd eq 'back') {
		$indent = pop(@indent);
		warn "Unmatched =back\n" unless defined $indent;
		$needspace = 1;
		print HTML qq{\n</dl>\n\n};
	    }
	    elsif ($cmd eq 'item') {
		($what,$rest)=split(' ', $_, 2);
		$what=~s/\s*$//;
		if($justdid ne $what){
		    print HTML "\n<A NAME=\"".$p->{"items"}->{$what}."\"></A>\n";
		    $justdid=$what;
		}
		print  HTML qq{<dt><B>$_</B> </dt>\n};
		$next_para=1;
	    }
	    else {
		warn "Unrecognized directive: $cmd\n";
	    }
	}
	else {
	    length || next;
	    $next_para && (print HTML  qq{<dd>\n});
	    print HTML  "$_<p>";
	    $next_para && (print  HTML qq{</dd>\n<p>\n}) && ($next_para=0);
	}
    }
}
print HTML "\n</HTML>\n";

#########################################################################

sub pre_escapes {
    s/\&/\&amp\;/g;
    s/<</\&lt\;\&lt\;/g;
    s/([^ESIBLCF])</$1\&lt\;/g;
}

sub post_escapes{
    s/>>/\&gt\;\&gt\;/g;
    s/([^"AIB])>/$1\&gt\;/g;
}

sub Do_refs{
local($para,$pod)=@_;
foreach $char ("L","C","I","B"){
    next unless /($char<[^<>]*>)/;
    local(@ar) = split(/($char<[^<>]*>)/,$para);
    local($this,$key,$num);
    for($this=0;$this<=$#ar;$this++){
        next unless $ar[$this] =~ /${char}<([^<>]*)>/;
	$key=$1;

	if((defined($p->{"podnames"}->{$key})) && ($char eq "L")){
	    $ar[$this] = "\n$type$key.html\">\nthe $key manpage<\/A>\n"; # 
	}
	elsif(defined($p->{"items"}->{$key})){
	    ($pod2,$num)=split(/_/,$p->{"items"}->{$key},2);
		$ar[$this] = (($pod2 eq $pod) && ($para=~/^\=item/)) ?
		"\n<A NAME=\"".$p->{"items"}->{$key}."\">\n$key</A>\n"
	        :
		"\n$type$pod2.html\#".$p->{"items"}->{$key}."\">$key<\/A>\n";
        }
	elsif(defined($p->{"headers"}->{$key})){
	    ($pod2,$num)=split(/_/,$p->{"headers"}->{$key},2);
		$ar[$this] = (($pod eq $pod2) && ($para=~/^\=head/)) ? 
		"\n<A NAME=\"".$p->{"headers"}->{$key}."\">\n$key</A>\n"
		:
		"\n$type$pod2.html\#".$p->{"headers"}->{$key}."\">$key<\/A>\n";
	}
	else{
	    (warn "No \"=item\" or \"=head\" reference for $ar[$this] in $pod\n") if $debug;
	    if($char =~ /^[BCF]$/){
		$ar[$this]="<B>$key</B>";
	    }
	    elsif($char eq "L"){
		$ar[$this]=$key;
	    }
	    elsif($char eq "I"){
		$ar[$this]="<I>$key</I>";
	    }
	}
    }
    $para=join('',@ar);
}
$para;
}
sub wait{1;}
