4 use File::Basename qw(&basename &dirname);
6 # List explicitly here the variables you want Configure to
7 # generate. Metaconfig only looks for shell variables, so you
8 # have to mention them as if they were shell variables, not
9 # %Config entries. Thus you write
11 # to ensure Configure will look for $Config{startperl}.
13 # This forces PL files to create target in same directory as PL file.
14 # This is so that make depend always knows where to find PL derivatives.
16 $file = basename($0, '.PL');
17 $file .= '.com' if $^O eq 'VMS';
19 open OUT,">$file" or die "Can't create $file: $!";
21 print "Extracting $file (with variable substitutions)\n";
23 # In this section, perl variables will be expanded during extraction.
24 # You can use $Config{...} to use Configure variables.
26 print OUT <<"!GROK!THIS!";
28 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
29 if \$running_under_some_shell;
32 # In the following, perl variables are not expanded during extraction.
34 print OUT <<'!NO!SUBS!';
37 # pod2html - convert pod format to html
39 # usage: pod2html [podfiles]
40 # Will read the cwd and parse all files with .pod extension
41 # if no arguments are given on the command line.
43 # Many helps, suggestions, and fixes from the perl5 porters, and all over.
44 # Bill Middleton - wjm@metronet.com
46 # Please send patches/fixes/features to me
55 ################################################################################
56 # Invoke with various levels of debugging possible
57 ################################################################################
58 while ($ARGV[0] =~ /^-d(.*)/) {
60 $Debug{ lc($1 || shift) }++;
63 # ck for podnames on command line
68 ################################################################################
69 # CONFIGURE - change the following to suit your OS and taste
70 ################################################################################
71 # The beginning of the url for the anchors to the other sections.
72 # Edit $type to suit. It's configured for relative url's now.
73 # Other possibilities are:
74 # $type = '<A HREF="file://localhost/usr/local/htmldir/'; # file url
75 # $type = '<A HREF="http://www.bozo.com/perl/manual/html/' # server
79 ################################################################################
80 # location of all podfiles unless on command line
81 # $installprivlib="HD:usr:local:lib:perl5"; # uncomment and reset for Mac
82 # $installprivlib="C:\usr\local\lib\perl5"; # uncomment and reset for DOS (I hope)
84 # $installprivlib="/usr/local/lib/perl5"; # Unix
85 $installprivlib="./"; # Standard perl pod directory for intallation
87 ################################################################################
88 # Where to write out the html files
89 # $installhtmldir="HD:usr:local:lib:perl5:html"; # uncomment and reset for Mac
90 # $installhtmldir="C:\usr\local\lib\perl5\html"; # uncomment and reset for DOS (I hope)
91 $installhtmldir = "./";
95 if(!(-d $installhtmldir)){
96 print "Installation directory $installhtmldir does not exist, using cwd\n";
97 print "Hit ^C now to edit this script and configure installhtmldir\n";
98 $installhtmldir = '.';
101 ################################################################################
102 # the html extension, change to htm for DOS
106 ################################################################################
107 # arbitrary name for this group of pods
111 ################################################################################
112 # look in these pods for links to things not found within the current pod
113 # be careful tho, namespace collisions cause stupid links
115 @inclusions = qw[ perlfunc perlvar perlrun perlop ];
117 ################################################################################
118 # Directory path separator
119 # $sep= ":"; # uncomment for Mac
120 # $sep= "\"; # uncomment for DOS
124 ################################################################################
125 # Create 8.3 html files if this equals 1
129 ################################################################################
130 # Create maximum 32 character html files if this equals 1
133 ################################################################################
135 # Beyond here be dragons. :-)
136 ################################################################################
138 $A = {}; # The beginning of all things
141 find($installprivlib);
142 splice(@Pods,$#Pods+1,0,@modpods);;
145 @Pods or die "aak, expected pods";
146 open(INDEX,">".$installhtmldir.$sep."index.".$htmlext) or
147 (die "cant open index.$htmlext");
148 print INDEX "\n<HTML>\n<HEAD>\n<TITLE>Index of all pods for $package</TITLE></HEAD>\n<BODY>\n";
149 print INDEX "<H1>Index of all pods for $package</H1>\n<hr><UL>\n";
150 # loop twice through the pods, first to learn the links, then to produce html
152 print STDERR "Scanning pods...\n" unless $count;
154 foreach $podfh ( @Pods ) {
157 $refname =~ s/$installprivlib${sep}?//;
158 $refname =~ s/${sep}/::/g;
159 $refname =~ s/\.p(m|od)$//;
160 $refname =~ s/^pod:://;
161 $savename = $refname;
162 $refname =~ s/::/_/g;
163 if($DOSify && !$count){ # shorten the name for DOS
164 (length($refname) > 8) and ( $refname = substr($refname,0,8));
165 while(defined($DosNames{$refname})){
166 @refname=split(//,$refname);
168 ($refname[$#refname] eq "z") and ($refname[$#refname] = "a");
169 $refname[$#refname]++;
170 $refname=join('',@refname);
171 $refname =~ s/\W/_/g;
173 $DosNames{$refname} = 1;
174 $Podnames{$savename} = $refname . ".$htmlext";
176 elsif(!$DOSify and !$count){
177 $Podnames{$savename} = $refname . ".$htmlext";
180 Debug("files", "opening 2 $podfh" );
181 print "Creating $Podnames{$savename} from $podfh\n" if $count;
182 $RS = "\n="; # grok pods by item (Nonstandard but effecient)
183 open($podfh,"<".$podfh) || die "can't open $podfh: $ERRNO";
187 ($all[0] =~ s/^=//) || pop(@all);
188 for ($i=0;$i <= $#all;$i++){ splice(@all,$i+1,1) unless
189 (($all[$i] =~ s/=$//) && ($all[$i+1] !~ /^cut/)) ; # whoa..
192 unless (grep(/NAME/,@all)){
193 print STDERR "NAME header not found in $podfh, skipping\n";
194 #delete($Podnames{$savename});
198 next unless length($Podnames{$savename});
199 open(HTML,">".$installhtmldir.$sep.$Podnames{$savename}) or
200 (die "can't create $Podnames{$savename}: $ERRNO");
201 print HTML "<HTML><HEAD>";
202 print HTML "<TITLE>$refname</TITLE>\n</HEAD>\n<BODY>";
205 for ($i = 0; $i <= $#all; $i++) { # decide what to do with each chunk
206 $all[$i] =~ /^(\w+)\s*(.*)\n?([^\0]*)$/ ;
207 ($cmd, $title, $rest) = ($1,$2,$3);
208 if(length($cmd)){$cutting =0;}
210 if(($title =~ /NAME/) and ($didindex == 0) and $count){
211 print INDEX "<LI><A HREF=\"$Podnames{$savename}\">$rest</A>\n";
214 if ($cmd eq "item") {
215 if ($count ) { # producing html
216 do_list("over",$all[$i],\$in_list,\$depth) unless $depth;
217 do_item($title,$rest,$in_list);
221 scan_thing("item",$title,$pod);
224 elsif ($cmd =~ /^head([12])/) {
226 if ($count) { # producing html
227 do_hdr($num,$title,$rest,$depth);
231 scan_thing($cmd,$title,$pod); # skip head1
234 elsif ($cmd =~ /^over/) {
235 $count and $depth and do_list("over",$all[$i+1],\$in_list,\$depth);
237 elsif ($cmd =~ /^back/) {
238 if ($count) { # producing html
239 ($depth) or next; # just skip it
240 do_list("back",$all[$i+1],\$in_list,\$depth);
241 do_rest("$title$rest");
244 elsif ($cmd =~ /^cut/) {
247 elsif ($cmd =~ /^for/) { # experimental pragma html
248 if ($count) { # producing html
249 if ($title =~ s/^html//) {
251 do_rest("$title$rest");
255 elsif ($cmd =~ /^begin/) { # experimental pragma html
256 if ($count) { # producing html
257 if ($title =~ s/^html//) {
258 print HTML $title,"\n",$rest;
260 elsif ($title =~ /^end/) {
265 elsif ($Debug{"misc"}) {
266 warn("unrecognized header: $cmd");
269 # close open lists without '=back' stmts
270 if ($count) { # producing html
272 do_list("back",$all[$i+1],\$in_list,\$depth);
274 print HTML "\n</BODY>\n</HTML>\n";
278 print INDEX "\n</UL></BODY>\n</HTML>\n";
280 sub do_list{ # setup a list type, depending on some grok logic
281 my($which,$next_one,$list_type,$depth) = @_;
283 if ($which eq "over") {
284 unless ($next_one =~ /^item\s+(.*)/) {
285 warn "Bad list, $1\n" if $Debug{"misc"};
289 if ($key =~ /^1\.?/) {
291 } elsif ($key =~ /\*\s*$/) {
293 } elsif ($key =~ /\*?\s*\w/) {
296 warn "unknown list type for item $key" if $Debug{"misc"};
300 print HTML qq{<$$list_type>};
303 elsif ($which eq "back") {
304 print HTML qq{\n</$$list_type>\n};
309 sub do_hdr{ # headers
310 my($num,$title,$rest,$depth) = @_;
311 my($savename,$restofname);
312 print HTML qq{<p><hr>\n} if $num == 1;
313 ($savename = $title) =~ s/^(\w+)([\s,]+.*)/$1/;
315 (defined($Podnames{$savename})) ? ($savename = $savename) : ($savename = 0);
316 process_thing(\$title,"NAME");
317 print HTML qq{\n<H$num> };
319 print HTML "<A HREF=\"$Podnames{$savename}\">$savename$restofname</A>";
324 print HTML qq{</H$num>\n};
328 sub do_item{ # list items
329 my($title,$rest,$list_type) = @_;
331 $bullet_only = ($title eq '*' and $list_type eq 'UL') ? 1 : 0;
334 (defined($Podnames{$savename})) ? ($savename = $savename) : ($savename = 0);
335 process_thing(\$title,"NAME");
336 if ($list_type eq "DL") {
337 print HTML qq{\n<DT>\n};
339 print HTML "<A HREF=\"$Podnames{$savename}\">$savename $rest</A>\n</DT>";
343 (print HTML qq{\n<STRONG>\n}) unless ($title =~ /STRONG/);
345 if($title !~ /STRONG/){
346 print HTML "\n</STRONG></DT>\n";
348 print HTML "</DT>\n";
351 print HTML qq{<DD>\n};
354 print HTML qq{\n<LI>};
355 unless ($bullet_only or $list_type eq "OL") {
357 print HTML "<A HREF=\"$savename.$htmlext\">$savename</A>";
360 print HTML $title,"\n";
367 sub do_rest{ # the rest of the chunk handled here
369 my(@lines,$p,$q,$line,,@paras,$inpre);
370 @paras = split(/\n\n\n*/,$rest);
371 for ($p = 0; $p <= $#paras; $p++) {
372 $paras[$p] =~ s/^\n//mg;
373 @lines = split(/\n/,$paras[$p]);
374 if ($in_html) { # handle =for html paragraphs
375 print HTML $paras[0];
379 elsif ($lines[0] =~ /^\s+\w*\t.*/) { # listing or unordered list
381 foreach $line (@lines) {
382 ($line =~ /^\s+(\w*)\t(.*)/) && (($key,$rem) = ($1,$2));
383 print HTML defined($Podnames{$key})
384 ? "<LI>$type$Podnames{$key}\">$key<\/A>\t$rem</LI>\n"
385 : "<LI>$line</LI>\n";
387 print HTML qq{</UL>\n};
389 elsif ($lines[0] =~ /^\s/) { # preformatted code
390 if ($paras[$p] =~/>>|<</) {
391 print HTML qq{\n<PRE>\n};
394 else { # Still cant beat XMP. Yes, I know
395 print HTML qq{\n<XMP>\n}; # it's been obsoleted... suggestions?
398 while (defined($paras[$p])) {
399 @lines = split(/\n/,$paras[$p]);
400 foreach $q (@lines) { # mind your p's and q's here :-)
401 if ($paras[$p] =~ />>|<</) {
403 process_thing(\$q,"HTML");
406 print HTML qq{\n</XMP>\n};
407 print HTML qq{<PRE>\n};
409 process_thing(\$q,"HTML");
412 1 while $q =~ s/\t+/' 'x (length($&) * 8 - length($`) % 8)/e;
415 last if $paras[$p+1] !~ /^\s/;
418 print HTML ($inpre==1) ? (qq{\n</PRE>\n}) : (qq{\n</XMP>\n});
421 @lines = split(/\n/,$paras[$p]);
422 foreach $line (@lines) {
423 process_thing(\$line,"HTML");
424 $line =~ s/STRONG([^>])/STRONG>$1/; # lame attempt to fix strong
425 print HTML qq{$line\n};
432 sub process_thing{ # process a chunk, order important
433 my($thing,$htype) = @_;
435 find_refs($thing,$htype);
436 post_escapes($thing);
439 sub scan_thing{ # scan a chunk for later references
440 my($cmd,$title,$pod) = @_;
444 # remove any formatting information for the headers
445 s/[SFCBI]<(.*?)>/$1/g;
446 # the "don't format me" thing
448 if ($cmd eq "item") {
449 /^\*/ and return; # skip bullets
450 /^\d+\./ and return; # skip numbers
453 return if defined $A->{$pod}->{"Items"}->{$_};
454 $A->{$pod}->{"Items"}->{$_} = gensym($pod, $_);
455 $A->{$pod}->{"Items"}->{(split(' ',$_))[0]}=$A->{$pod}->{"Items"}->{$_};
456 Debug("items", "item $_");
457 if (!/^-\w$/ && /([%\$\@\w]+)/ && $1 ne $_
458 && !defined($A->{$pod}->{"Items"}->{$_}) && ($_ ne $1))
460 $A->{$pod}->{"Items"}->{$1} = $A->{$pod}->{"Items"}->{$_};
461 Debug("items", "item $1 REF TO $_");
463 if ( m{^(tr|y|s|m|q[qwx])/.*[^/]} ) {
465 $pf .= "/" if $1 eq "tr" || $1 eq "y" || $1 eq "s";
467 $A->{$pod}->{"Items"}->{$pf} = $A->{$pod}->{"Items"}->{$_};
468 Debug("items", "item $pf REF TO $_");
472 elsif ($cmd =~ /^head[12]/) {
473 return if defined($A->{$pod}->{"Headers"}->{$_});
474 $A->{$pod}->{"Headers"}->{$_} = gensym($pod, $_);
475 Debug("headers", "header $_");
478 warn "unrecognized header: $cmd" if $Debug;
484 my($char, $bigkey, $lilkey,$htype) = @_;
485 my($key,$ref,$podname);
486 for $podname ($pod,@inclusions) {
487 for $ref ( "Items", "Headers" ) {
488 if (defined $A->{$podname}->{$ref}->{$bigkey}) {
489 $value = $A->{$podname}->{$ref}->{$key = $bigkey};
490 Debug("subs", "bigkey is $bigkey, value is $value\n");
492 elsif (defined $A->{$podname}->{$ref}->{$lilkey}) {
493 $value = $A->{$podname}->{$ref}->{$key = $lilkey};
494 return "" if $lilkey eq '';
495 Debug("subs", "lilkey is $lilkey, value is $value\n");
499 ($pod2, $num) = $value =~ /^(.*)_(\S+_\d+)$/;
500 if ($htype eq "NAME") {
501 return "\n<A NAME=\"".$value."\">\n$bigkey</A>\n"
505 return "\n$type$Podnames{$pod2}\#".$value."\">$bigkey<\/A>\n";
509 if ($char =~ /[IF]/) {
510 return "<EM>$bigkey</EM>";
511 } elsif ($char =~ /C/) {
512 return "<CODE>$bigkey</CODE>";
514 if($bigkey =~ /STRONG/){
518 return "<STRONG>$bigkey</STRONG>";
524 my($thing,$htype) = @_;
526 # LREF: a manpage(3f) we don't know about
528 #s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))>:the I<$1>$2 manpage:g;
529 s@(\S+?://\S*[^.,;!?\s])@noremap(qq{<A HREF="$1">$1</A>})@ge;
530 s,([a-z0-9_.-]+\@([a-z0-9_-]+\.)+([a-z0-9_-]+)),noremap(qq{<A HREF="MAILTO:$1">$1</A>}),gie;
531 s/L<([^>]*)>/lrefs($1,$htype)/ge;
532 s/([CIBF])<(\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge;
533 s/(S)<([^\/]\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge;
534 s/((\w+)\(\))/picrefs("I", $1, $2,$htype)/ge;
535 s/([\$\@%](?!&[gl]t)([\w:]+|\W\b))/varrefs($1,$htype)/ge;
537 if ($$thing eq $orig && $htype eq "NAME") {
538 $$thing = picrefs("I", $$thing, "", $htype);
544 my($page, $item) = split(m#/#, $_[0], 2);
547 my($section) = $page =~ /\((.*)\)/;
549 if ($page =~ /^[A-Z]/ && $item) {
551 $item = "$page/$item";
553 } elsif (!$item && $page =~ /[^a-z\-]/ && $page !~ /^\$.$/) {
560 if (!defined $section && defined $Podnames{$page}) {
561 return "\n$type$Podnames{$page}\">\nthe <EM>$page</EM> manpage<\/A>\n";
563 (warn "Bizarre entry $page/$item") if $Debug;
564 return "the <EM>$_[0]</EM> manpage\n";
568 if ($item =~ s/"(.*)"/$1/ || ($item =~ /[^\w\/\-]/ && $item !~ /^\$.$/)) {
569 $text = "<EM>$item</EM>";
572 $text = "<EM>$item</EM>";
575 for $podname ($pod, @inclusions) {
577 if ($ref eq "Items") {
578 if (defined($value = $A->{$podname}->{$ref}->{$item})) {
579 ($pod2,$num) = split(/_/,$value,2); # break here
580 return (($pod eq $pod2) && ($htype eq "NAME"))
581 ? "\n<A NAME=\"".$value."\">\n$text</A>\n"
582 : "\n$type$Podnames{$pod2}\#".$value."\">$text<\/A>\n";
585 elsif ($ref eq "Headers") {
586 if (defined($value = $A->{$podname}->{$ref}->{$item})) {
587 ($pod2,$num) = split(/_/,$value,2); # break here
588 return (($pod eq $pod2) && ($htype eq "NAME"))
589 ? "\n<A NAME=\"".$value."\">\n$text</A>\n"
590 : "\n$type$Podnames{$pod2}\#".$value."\">$text<\/A>\n";
594 warn "No $ref reference for $item (@_)" if $Debug;
599 my ($var,$htype) = @_;
600 for $podname ($pod,@inclusions) {
601 if ($value = $A->{$podname}->{"Items"}->{$var}) {
602 ($pod2,$num) = split(/_/,$value,2);
603 Debug("vars", "way cool -- var ref on $var");
604 return (($pod eq $pod2) && ($htype eq "NAME")) # INHERIT $_, $pod
605 ? "\n<A NAME=\"".$value."\">\n$var</A>\n"
606 : "\n$type$Podnames{$pod2}\#".$value."\">$var<\/A>\n";
609 Debug( "vars", "bummer, $var not a var");
610 if($var =~ /STRONG/){
614 return "<STRONG>$var</STRONG>";
619 my ($podname, $key) = @_;
621 ($key = lc($key)) =~ tr/a-z/_/cs;
622 my $name = "${podname}_${key}_0";
624 while ($sawsym{$name}++) {
625 $name =~ s/_?(\d+)$/'_' . ($1 + 1)/e;
630 sub pre_escapes { # twiddle these, and stay up late :-)
633 s/([\200-\377])/noremap("&#".ord($1).";")/ge;
635 s/&/noremap("&")/ge;
636 s/<</noremap("<<")/eg;
637 s/([^ESIBLCF])</$1\<\;/g;
638 s/E<(\d+)>/\&#$1\;/g; # embedded numeric special
639 s/E<([^\/][^<>]*)>/\&$1\;/g; # embedded special
642 sub noremap { # adding translator for hibit chars soon
644 $hide =~ tr/\000-\177/\200-\377/;
652 s/([^GM])>>/$1\>\;\>\;/g;
653 s/([^D][^"MGA])>/$1\>\;/g;
654 tr/\200-\377/\000-\177/;
660 print STDERR @_,"\n" if $Debug{$level};
665 print STDERR "TABLE DUMP $t\n";
666 foreach $k (sort keys %$t) {
667 printf STDERR "%-20s <%s>\n", $t->{$k}, $k;
679 if ($name =~ /\.p(m|od)$/){
680 push(@modpods, $name) if ($name =~ /\.p(m|od)$/);
687 close OUT or die "Can't close $file: $!";
688 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
689 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';