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=../../../..;
9 echo "Can't find config.sh."; exit 1
15 */*) cd `expr X$0 : 'X\(.*\)/'` ;;
17 echo "Extracting pod/pod2html (with variable substitutions)"
19 $spitshell >pod2html <<!GROK!THIS!
21 eval 'exec perl -S \$0 \${1+"\$@"}'
22 if \$running_under_some_shell;
25 $spitshell >>pod2html <<'!NO!SUBS!'
27 # pod2html - convert pod format to html
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.
40 while ($ARGV[0] =~ /^-d(.*)/) {
42 $Debug{ lc($1 || shift) }++;
45 # look in these pods for things not found within the current pod
47 perlfunc perlvar perlrun perlop
50 # ck for podnames on command line
59 # The beginning of the url for the anchors to the other sections.
60 # Edit $type to suit. It's configured for relative url's now.
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";
69 @Pods or die "expected pods";
71 # loop twice through the pods, first to learn the links, then to produce html
73 (print "Scanning pods...\n") unless $count;
74 foreach $podfh ( @Pods ) {
75 ($pod = $podfh) =~ s/\.pod$//;
76 Debug("files", "opening 2 $podfh" );
77 (print "Creating $pod.html from $podfh\n") if $count;
79 open($podfh,"<".$podfh) || die "can't open $podfh: $ERRNO";
89 open(HTML,">$html") || die "can't create $html: $ERRNO";
90 print HTML <<'HTML__EOQ', <<"HTML__EOQQ";
91 <!-- \$RCSfile\$\$Revision\$\$Date\$ -->
95 <TITLE> \U$pod\E </TITLE>
99 for($i=0;$i<=$#all;$i++){
101 $all[$i] =~ /^(\w+)\s*(.*)\n?([^\0]*)$/ ;
102 ($cmd, $title, $rest) = ($1,$2,$3);
103 if ($cmd eq "item") {
105 ($depth) or do_list("over",$all[$i],\$in_list,\$depth);
106 do_item($title,$rest,$in_list);
110 scan_thing("item",$title,$pod);
113 elsif ($cmd =~ /^head([12])/){
116 do_hdr($num,$title,$rest,$depth);
120 scan_thing($cmd,$title,$pod); # skip head1
123 elsif ($cmd =~ /^over/) {
124 $count and $depth and do_list("over",$all[$i+1],\$in_list,\$depth);
126 elsif ($cmd =~ /^back/) {
128 ($depth) or next; # just skip it
129 do_list("back",$all[$i+1],\$in_list,\$depth);
130 do_rest("$title.$rest");
133 elsif ($cmd =~ /^cut/) {
137 (warn "unrecognized header: $cmd") if $Debug;
140 # close open lists without '=back' stmts
143 do_list("back",$all[$i+1],\$in_list,\$depth);
145 print HTML "\n</HTML>\n";
151 my($which,$next_one,$list_type,$depth)=@_;
153 if($which eq "over"){
154 ($next_one =~ /^item\s+(.*)/ ) or (warn "Bad list, $1\n") if $Debug;
159 elsif($key =~ /\*\s*$/){
162 elsif($key =~ /\*?\s*\w/){
166 (warn "unknown list type for item $key") if $Debug;
169 print HTML qq{<$$list_type>};
172 elsif($which eq "back"){
173 print HTML qq{\n</$$list_type>\n};
179 my($num,$title,$rest,$depth)=@_;
180 ($num == 1) and print HTML qq{<p><hr>\n};
181 process_thing(\$title,"NAME");
182 print HTML qq{\n<H$num> };
184 print HTML qq{</H$num>\n};
189 my($title,$rest,$list_type)=@_;
190 process_thing(\$title,"NAME");
191 if($list_type eq "DL"){
192 print HTML qq{\n<DT><STRONG>\n};
194 print HTML qq{\n</STRONG></DT>\n};
195 print HTML qq{<DD>\n};
198 print HTML qq{\n<LI>};
199 ($list_type ne "OL") && (print HTML $title,"\n");
202 print HTML ($list_type eq "DL" )? qq{</DD>} : qq{</LI>};
207 my(@lines,$p,$q,$line,,@paras,$inpre);
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
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" :
219 print HTML qq{</UL>\n};
221 elsif($lines[0] =~ /^\s/){ # preformatted code
222 if($paras[$p] =~/>>|<</){
223 print HTML qq{\n<PRE>\n};
227 print HTML qq{\n<XMP>\n};
231 while(defined($paras[$p])){
232 @lines=split(/\n/,$paras[$p]);
234 if($paras[$p]=~/>>|<</){
236 process_thing(\$q,"HTML");
239 print HTML qq{\n</XMP>\n};
240 print HTML qq{<PRE>\n};
242 process_thing(\$q,"HTML");
245 while($q =~ s/\t+/' 'x (length($&) * 8 - length($`) % 8)/e){
250 last if $paras[$p+1] !~ /^\s/;
253 print HTML ($inpre==1) ? (qq{\n</PRE>\n}) : (qq{\n</XMP>\n});
256 @lines=split(/\n/,$paras[$p]);
257 foreach $line (@lines){
258 process_thing(\$line,"HTML");
259 print HTML qq{$line\n};
267 my($thing,$htype)=@_;
269 find_refs($thing,$htype);
270 post_escapes($thing);
274 my($cmd,$title,$pod)=@_;
278 # remove any formatting information for the headers
279 s/[SFCBI]<(.*?)>/$1/g;
280 # the "don't format me" thing
282 if ($cmd eq "item") {
284 if (/^\*/) { return } # skip bullets
285 if (/^\d+\./) { return } # skip numbers
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))
295 $A->{$pod}->{"Items"}->{$1} = $A->{$pod}->{"Items"}->{$_};
296 Debug("items", "item $1 REF TO $_");
298 if ( m{^(tr|y|s|m|q[qwx])/.*[^/]} ) {
300 $pf .= "/" if $1 eq "tr" || $1 eq "y" || $1 eq "s";
302 $A->{$pod}->{"Items"}->{$pf} = $A->{$pod}->{"Items"}->{$_};
303 Debug("items", "item $pf REF TO $_");
307 elsif ($cmd =~ /^head[12]/){
308 return if defined($Headers{$_});
309 $A->{$pod}->{"Headers"}->{$_} = gensym($pod, $_);
310 Debug("headers", "header $_");
313 (warn "unrecognized header: $cmd") if $Debug;
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");
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");
334 ($pod2,$num) = split(/_/,$value,2);
335 if($htype eq "NAME"){
336 return "\n<A NAME=\"".$value."\">\n$bigkey</A>\n"
339 return "\n$type$pod2.html\#".$value."\">$bigkey<\/A>\n";
343 if ($char =~ /[IF]/) {
344 return "<EM> $bigkey </EM>";
345 } elsif($char =~ /C/) {
346 return "<CODE> $bigkey </CODE>";
348 return "<STRONG> $bigkey </STRONG>";
353 my($thing,$htype)=@_;
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;
360 $$thing=~s/([\$\@%](?!&[gl]t)([\w:]+|\W\b))/varrefs($1,$htype)/ge;
361 (($$thing eq $orig) && ($htype eq "NAME")) &&
362 ($$thing=picrefs("I", $$thing, "", $htype));
366 my($page, $item) = split(m#/#, $_[0], 2);
369 my($section) = $page =~ /\((.*)\)/;
371 if ($page =~ /^[A-Z]/ && $item) {
373 $item = "$page/$item";
375 } elsif (!$item && $page =~ /[^a-z\-]/ && $page !~ /^\$.$/) {
382 if (!defined $section && defined $Podnames{$page}) {
383 return "\n$type$page.html\">\nthe <EM> $page </EM> manpage<\/A>\n";
385 (warn "Bizarre entry $page/$item") if $Debug;
386 return "the <EM> $_[0] </EM> manpage\n";
390 if ($item =~ s/"(.*)"/$1/ || ($item =~ /[^\w\/\-]/ && $item !~ /^\$.$/)) {
391 $text = "<EM> $item </EM>";
394 $text = "<EM> $item </EM>";
397 for $podname ($pod, @inclusions){
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";
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";
416 (warn "No $ref reference for $item (@_)") if $Debug;
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";
431 Debug( "vars", "bummer, $var not a var");
432 return "<STRONG> $var </STRONG>";
436 my ($podname, $key) = @_;
438 ($key = lc($key)) =~ tr/a-z/_/cs;
439 my $name = "${podname}_${key}_0";
441 while ($sawsym{$name}++) {
442 $name =~ s/_?(\d+)$/'_' . ($1 + 1)/e;
449 $$thing=~s/&/noremap("&")/ge;
450 $$thing=~s/<</noremap("<<")/eg;
451 $$thing=~s/(?:[^ESIBLCF])</noremap("<")/eg;
452 $$thing=~s/E<([^\/][^<>]*)>/\&$1\;/g; # embedded special
457 $hide =~ tr/\000-\177/\200-\377/;
463 $$thing=~s/[^GM]>>/\>\;\>\;/g;
464 $$thing=~s/([^"MGAE])>/$1\>\;/g;
465 $$thing=~tr/\200-\377/\000-\177/;
470 print STDERR @_,"\n" if $Debug{$level};
475 print STDERR "TABLE DUMP $t\n";
476 foreach $k (sort keys %$t) {
477 printf STDERR "%-20s <%s>\n", $t->{$k}, $k;