\n}; $inpre=1; process_thing(\$q,"HTML"); } } 1 while $q =~ s/\t+/' 'x (length($&) * 8 - length($`) % 8)/e; print HTML $q,"\n"; } last if $paras[$p+1] !~ /^\s/; $p++; } print HTML ($inpre==1) ? (qq{\n\n}) : (qq{\n\n}); } else { # other text @lines = split(/\n/,$paras[$p]); foreach $line (@lines) { process_thing(\$line,"HTML"); print HTML qq{$line\n}; } } print HTML qq{
};
}
}
sub process_thing{ # process a chunk, order important
my($thing,$htype) = @_;
pre_escapes($thing);
find_refs($thing,$htype);
post_escapes($thing);
}
sub scan_thing{ # scan a chunk for later references
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") {
/^\*/ and return; # skip bullets
/^\d+\./ and 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($A->{$pod}->{"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\n$bigkey\n"
}
else {
return "\n$type$pod2.html\#".$value."\">$bigkey<\/A>\n";
}
}
}
if ($char =~ /[IF]/) {
return "$bigkey";
} elsif ($char =~ /C/) {
return "$bigkey
";
} else {
return "$bigkey";
}
}
sub find_refs {
my($thing,$htype) = @_;
my($orig) = $$thing;
# LREF: a manpage(3f) we don't know about
for ($$thing) {
#s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))>:the I<$1>$2 manpage:g;
s@(\S+?://\S*[^.,;!?\s])@noremap(qq{$1})@ge;
s,([a-z0-9_.-]+\@([a-z0-9_-]+\.)+([a-z0-9_-]+)),noremap(qq{$1}),gie;
s/L<([^>]*)>/lrefs($1,$htype)/ge;
s/([CIBF])<(\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge;
s/(S)<([^\/]\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge;
s/((\w+)\(\))/picrefs("I", $1, $2,$htype)/ge;
s/([\$\@%](?!&[gl]t)([\w:]+|\W\b))/varrefs($1,$htype)/ge;
}
if ($$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 $page manpage<\/A>\n";
} else {
(warn "Bizarre entry $page/$item") if $Debug;
return "the $_[0] manpage\n";
}
}
if ($item =~ s/"(.*)"/$1/ || ($item =~ /[^\w\/\-]/ && $item !~ /^\$.$/)) {
$text = "$item";
$ref = "Headers";
} else {
$text = "$item";
$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\n$text\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\n$text\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\n$var\n"
: "\n$type$pod2.html\#".$value."\">$var<\/A>\n";
}
}
Debug( "vars", "bummer, $var not a var");
return "$var";
}
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 { # twiddle these, and stay up late :-)
my($thing) = @_;
for ($$thing) {
s/"(.*?)"/``$1''/gs;
s/&/noremap("&")/ge;
s/<]*)>/\&$1\;/g; # embedded special
}
}
sub noremap { # adding translator for hibit chars soon
my $hide = $_[0];
$hide =~ tr/\000-\177/\200-\377/;
$hide;
}
sub post_escapes {
my($thing) = @_;
for ($$thing) {
s/([^GM])>>/$1\>\;\>\;/g;
s/([^D][^"MGA])>/$1\>\;/g;
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?$//;
}
}