Commit | Line | Data |
4633a7c4 |
1 | #!/usr/local/bin/perl |
2 | |
3 | use Config; |
4 | use File::Basename qw(&basename &dirname); |
5 | |
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 |
10 | # $startperl |
11 | # to ensure Configure will look for $Config{startperl}. |
12 | |
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. |
44a8e56a |
15 | chdir dirname($0); |
16 | $file = basename($0, '.PL'); |
774d564b |
17 | $file .= '.com' if $^O eq 'VMS'; |
4633a7c4 |
18 | |
19 | open OUT,">$file" or die "Can't create $file: $!"; |
20 | |
21 | print "Extracting $file (with variable substitutions)\n"; |
22 | |
23 | # In this section, perl variables will be expanded during extraction. |
24 | # You can use $Config{...} to use Configure variables. |
25 | |
26 | print OUT <<"!GROK!THIS!"; |
5f05dabc |
27 | $Config{startperl} |
28 | eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' |
29 | if \$running_under_some_shell; |
4633a7c4 |
30 | !GROK!THIS! |
31 | |
32 | # In the following, perl variables are not expanded during extraction. |
33 | |
34 | print OUT <<'!NO!SUBS!'; |
5f05dabc |
35 | |
4633a7c4 |
36 | # |
37 | # pod2html - convert pod format to html |
5e71e875 |
38 | # Version 1.21 |
4633a7c4 |
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. |
42 | # |
43 | # Many helps, suggestions, and fixes from the perl5 porters, and all over. |
44 | # Bill Middleton - wjm@metronet.com |
45 | # |
46 | # Please send patches/fixes/features to me |
47 | # |
5e71e875 |
48 | |
49 | require 'find.pl'; |
50 | |
4633a7c4 |
51 | *RS = */; |
52 | *ERRNO = *!; |
53 | |
5e71e875 |
54 | |
4633a7c4 |
55 | ################################################################################ |
56 | # Invoke with various levels of debugging possible |
57 | ################################################################################ |
58 | while ($ARGV[0] =~ /^-d(.*)/) { |
59 | shift; |
60 | $Debug{ lc($1 || shift) }++; |
61 | } |
62 | |
63 | # ck for podnames on command line |
64 | while ($ARGV[0]) { |
65 | push(@Pods,shift); |
66 | } |
67 | |
68 | ################################################################################ |
5e71e875 |
69 | # CONFIGURE - change the following to suit your OS and taste |
70 | ################################################################################ |
4633a7c4 |
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 |
b7fcee5a |
76 | |
385588b3 |
77 | $type = '<A HREF="'; |
b7fcee5a |
78 | |
5e71e875 |
79 | ################################################################################ |
80 | # location of all podfiles unless on command line |
7f9f50e6 |
81 | # $installprivlib='HD:usr:local:lib:perl5'; # uncomment for Mac |
82 | # $installprivlib='C:\usr\local\lib\perl5'; # uncomment for DOS (I hope) |
83 | # $installprivlib='/usr/local/lib/perl5'; # Unix |
5e71e875 |
84 | $installprivlib="./"; # Standard perl pod directory for intallation |
85 | |
86 | ################################################################################ |
87 | # Where to write out the html files |
7f9f50e6 |
88 | # $installhtmldir='HD:usr:local:lib:perl5:html'; # uncomment for Mac |
89 | # $installhtmldir='C:\usr\local\lib\perl5\html'; # uncomment for DOS (I hope) |
90 | $installhtmldir = './'; |
5e71e875 |
91 | |
92 | # test for validness |
93 | |
94 | if(!(-d $installhtmldir)){ |
95 | print "Installation directory $installhtmldir does not exist, using cwd\n"; |
96 | print "Hit ^C now to edit this script and configure installhtmldir\n"; |
97 | $installhtmldir = '.'; |
98 | } |
99 | |
100 | ################################################################################ |
101 | # the html extension, change to htm for DOS |
102 | |
103 | $htmlext = "html"; |
104 | |
105 | ################################################################################ |
106 | # arbitrary name for this group of pods |
107 | |
108 | $package = "perl"; |
109 | |
110 | ################################################################################ |
111 | # look in these pods for links to things not found within the current pod |
4633a7c4 |
112 | # be careful tho, namespace collisions cause stupid links |
113 | |
5e71e875 |
114 | @inclusions = qw[ perlfunc perlvar perlrun perlop ]; |
115 | |
116 | ################################################################################ |
117 | # Directory path separator |
118 | # $sep= ":"; # uncomment for Mac |
119 | # $sep= "\"; # uncomment for DOS |
120 | |
121 | $sep= "/"; |
122 | |
123 | ################################################################################ |
124 | # Create 8.3 html files if this equals 1 |
125 | |
126 | $DOSify=0; |
127 | |
128 | ################################################################################ |
129 | # Create maximum 32 character html files if this equals 1 |
130 | $MACify=0; |
131 | |
4633a7c4 |
132 | ################################################################################ |
133 | # END CONFIGURE |
5e71e875 |
134 | # Beyond here be dragons. :-) |
4633a7c4 |
135 | ################################################################################ |
136 | |
137 | $A = {}; # The beginning of all things |
138 | |
5e71e875 |
139 | unless(@Pods){ |
140 | find($installprivlib); |
141 | splice(@Pods,$#Pods+1,0,@modpods);; |
4633a7c4 |
142 | } |
385588b3 |
143 | |
5e71e875 |
144 | @Pods or die "aak, expected pods"; |
145 | open(INDEX,">".$installhtmldir.$sep."index.".$htmlext) or |
146 | (die "cant open index.$htmlext"); |
147 | print INDEX "\n<HTML>\n<HEAD>\n<TITLE>Index of all pods for $package</TITLE></HEAD>\n<BODY>\n"; |
148 | print INDEX "<H1>Index of all pods for $package</H1>\n<hr><UL>\n"; |
4633a7c4 |
149 | # loop twice through the pods, first to learn the links, then to produce html |
150 | for $count (0,1) { |
347a6e91 |
151 | print STDERR "Scanning pods...\n" unless $count; |
5e71e875 |
152 | loop1: |
4633a7c4 |
153 | foreach $podfh ( @Pods ) { |
5e71e875 |
154 | $didindex = 0; |
155 | $refname = $podfh; |
7f9f50e6 |
156 | $refname =~ s/\Q$installprivlib${sep}\E?//; |
5e71e875 |
157 | $refname =~ s/${sep}/::/g; |
158 | $refname =~ s/\.p(m|od)$//; |
159 | $refname =~ s/^pod:://; |
160 | $savename = $refname; |
161 | $refname =~ s/::/_/g; |
162 | if($DOSify && !$count){ # shorten the name for DOS |
163 | (length($refname) > 8) and ( $refname = substr($refname,0,8)); |
164 | while(defined($DosNames{$refname})){ |
165 | @refname=split(//,$refname); |
166 | # allow 25 of em |
167 | ($refname[$#refname] eq "z") and ($refname[$#refname] = "a"); |
168 | $refname[$#refname]++; |
169 | $refname=join('',@refname); |
170 | $refname =~ s/\W/_/g; |
171 | } |
172 | $DosNames{$refname} = 1; |
173 | $Podnames{$savename} = $refname . ".$htmlext"; |
174 | } |
175 | elsif(!$DOSify and !$count){ |
176 | $Podnames{$savename} = $refname . ".$htmlext"; |
177 | } |
178 | $pod = $savename; |
4633a7c4 |
179 | Debug("files", "opening 2 $podfh" ); |
5e71e875 |
180 | print "Creating $Podnames{$savename} from $podfh\n" if $count; |
4633a7c4 |
181 | $RS = "\n="; # grok pods by item (Nonstandard but effecient) |
182 | open($podfh,"<".$podfh) || die "can't open $podfh: $ERRNO"; |
183 | @all = <$podfh>; |
184 | close($podfh); |
185 | $RS = "\n"; |
5e71e875 |
186 | ($all[0] =~ s/^=//) || pop(@all); |
187 | for ($i=0;$i <= $#all;$i++){ splice(@all,$i+1,1) unless |
188 | (($all[$i] =~ s/=$//) && ($all[$i+1] !~ /^cut/)) ; # whoa.. |
189 | } |
4633a7c4 |
190 | $in_list = 0; |
5e71e875 |
191 | unless (grep(/NAME/,@all)){ |
192 | print STDERR "NAME header not found in $podfh, skipping\n"; |
193 | #delete($Podnames{$savename}); |
194 | next loop1; |
4633a7c4 |
195 | } |
5e71e875 |
196 | if ($count) { |
197 | next unless length($Podnames{$savename}); |
198 | open(HTML,">".$installhtmldir.$sep.$Podnames{$savename}) or |
199 | (die "can't create $Podnames{$savename}: $ERRNO"); |
200 | print HTML "<HTML><HEAD>"; |
201 | print HTML "<TITLE>$refname</TITLE>\n</HEAD>\n<BODY>"; |
202 | } |
203 | |
4633a7c4 |
204 | for ($i = 0; $i <= $#all; $i++) { # decide what to do with each chunk |
205 | $all[$i] =~ /^(\w+)\s*(.*)\n?([^\0]*)$/ ; |
206 | ($cmd, $title, $rest) = ($1,$2,$3); |
5e71e875 |
207 | if(length($cmd)){$cutting =0;} |
208 | next if $cutting; |
209 | if(($title =~ /NAME/) and ($didindex == 0) and $count){ |
210 | print INDEX "<LI><A HREF=\"$Podnames{$savename}\">$rest</A>\n"; |
211 | $didindex=1; |
212 | } |
4633a7c4 |
213 | if ($cmd eq "item") { |
214 | if ($count ) { # producing html |
215 | do_list("over",$all[$i],\$in_list,\$depth) unless $depth; |
216 | do_item($title,$rest,$in_list); |
217 | } |
218 | else { |
219 | # scan item |
220 | scan_thing("item",$title,$pod); |
221 | } |
222 | } |
223 | elsif ($cmd =~ /^head([12])/) { |
224 | $num = $1; |
225 | if ($count) { # producing html |
226 | do_hdr($num,$title,$rest,$depth); |
227 | } |
228 | else { |
229 | # header scan |
230 | scan_thing($cmd,$title,$pod); # skip head1 |
231 | } |
232 | } |
233 | elsif ($cmd =~ /^over/) { |
234 | $count and $depth and do_list("over",$all[$i+1],\$in_list,\$depth); |
235 | } |
236 | elsif ($cmd =~ /^back/) { |
237 | if ($count) { # producing html |
238 | ($depth) or next; # just skip it |
239 | do_list("back",$all[$i+1],\$in_list,\$depth); |
5e71e875 |
240 | do_rest("$title$rest"); |
4633a7c4 |
241 | } |
242 | } |
243 | elsif ($cmd =~ /^cut/) { |
244 | next; |
245 | } |
246 | elsif ($cmd =~ /^for/) { # experimental pragma html |
247 | if ($count) { # producing html |
248 | if ($title =~ s/^html//) { |
249 | $in_html =1; |
5e71e875 |
250 | do_rest("$title$rest"); |
4633a7c4 |
251 | } |
252 | } |
253 | } |
254 | elsif ($cmd =~ /^begin/) { # experimental pragma html |
255 | if ($count) { # producing html |
256 | if ($title =~ s/^html//) { |
257 | print HTML $title,"\n",$rest; |
258 | } |
259 | elsif ($title =~ /^end/) { |
260 | next; |
261 | } |
262 | } |
263 | } |
264 | elsif ($Debug{"misc"}) { |
265 | warn("unrecognized header: $cmd"); |
266 | } |
267 | } |
268 | # close open lists without '=back' stmts |
269 | if ($count) { # producing html |
270 | while ($depth) { |
271 | do_list("back",$all[$i+1],\$in_list,\$depth); |
272 | } |
273 | print HTML "\n</BODY>\n</HTML>\n"; |
274 | } |
275 | } |
276 | } |
5e71e875 |
277 | print INDEX "\n</UL></BODY>\n</HTML>\n"; |
4633a7c4 |
278 | |
279 | sub do_list{ # setup a list type, depending on some grok logic |
280 | my($which,$next_one,$list_type,$depth) = @_; |
281 | my($key); |
282 | if ($which eq "over") { |
283 | unless ($next_one =~ /^item\s+(.*)/) { |
284 | warn "Bad list, $1\n" if $Debug{"misc"}; |
285 | } |
286 | $key = $1; |
287 | |
288 | if ($key =~ /^1\.?/) { |
289 | $$list_type = "OL"; |
290 | } elsif ($key =~ /\*\s*$/) { |
291 | $$list_type = "UL"; |
292 | } elsif ($key =~ /\*?\s*\w/) { |
293 | $$list_type = "DL"; |
294 | } else { |
295 | warn "unknown list type for item $key" if $Debug{"misc"}; |
296 | } |
297 | |
298 | print HTML qq{\n}; |
5e71e875 |
299 | print HTML qq{<$$list_type>}; |
4633a7c4 |
300 | $$depth++; |
301 | } |
302 | elsif ($which eq "back") { |
303 | print HTML qq{\n</$$list_type>\n}; |
304 | $$depth--; |
305 | } |
306 | } |
307 | |
308 | sub do_hdr{ # headers |
309 | my($num,$title,$rest,$depth) = @_; |
5e71e875 |
310 | my($savename,$restofname); |
4633a7c4 |
311 | print HTML qq{<p><hr>\n} if $num == 1; |
5e71e875 |
312 | ($savename = $title) =~ s/^(\w+)([\s,]+.*)/$1/; |
313 | $restofname = $2; |
314 | (defined($Podnames{$savename})) ? ($savename = $savename) : ($savename = 0); |
4633a7c4 |
315 | process_thing(\$title,"NAME"); |
316 | print HTML qq{\n<H$num> }; |
5e71e875 |
317 | if($savename){ |
318 | print HTML "<A HREF=\"$Podnames{$savename}\">$savename$restofname</A>"; |
319 | } |
320 | else{ |
321 | print HTML $title; |
322 | } |
4633a7c4 |
323 | print HTML qq{</H$num>\n}; |
324 | do_rest($rest); |
325 | } |
326 | |
327 | sub do_item{ # list items |
328 | my($title,$rest,$list_type) = @_; |
5e71e875 |
329 | my $bullet_only; |
330 | $bullet_only = ($title eq '*' and $list_type eq 'UL') ? 1 : 0; |
331 | my($savename); |
332 | $savename = $title; |
333 | (defined($Podnames{$savename})) ? ($savename = $savename) : ($savename = 0); |
4633a7c4 |
334 | process_thing(\$title,"NAME"); |
335 | if ($list_type eq "DL") { |
5e71e875 |
336 | print HTML qq{\n<DT>\n}; |
337 | if($savename){ |
338 | print HTML "<A HREF=\"$Podnames{$savename}\">$savename $rest</A>\n</DT>"; |
339 | } |
340 | |
341 | else{ |
342 | (print HTML qq{\n<STRONG>\n}) unless ($title =~ /STRONG/); |
343 | print HTML $title; |
344 | if($title !~ /STRONG/){ |
345 | print HTML "\n</STRONG></DT>\n"; |
346 | } else { |
347 | print HTML "</DT>\n"; |
348 | } |
349 | } |
4633a7c4 |
350 | print HTML qq{<DD>\n}; |
351 | } |
352 | else { |
353 | print HTML qq{\n<LI>}; |
354 | unless ($bullet_only or $list_type eq "OL") { |
5e71e875 |
355 | if($savename){ |
356 | print HTML "<A HREF=\"$savename.$htmlext\">$savename</A>"; |
357 | } |
358 | else{ |
359 | print HTML $title,"\n"; |
360 | } |
4633a7c4 |
361 | } |
362 | } |
363 | do_rest($rest); |
364 | } |
365 | |
366 | sub do_rest{ # the rest of the chunk handled here |
367 | my($rest) = @_; |
368 | my(@lines,$p,$q,$line,,@paras,$inpre); |
369 | @paras = split(/\n\n\n*/,$rest); |
370 | for ($p = 0; $p <= $#paras; $p++) { |
371 | $paras[$p] =~ s/^\n//mg; |
372 | @lines = split(/\n/,$paras[$p]); |
373 | if ($in_html) { # handle =for html paragraphs |
374 | print HTML $paras[0]; |
375 | $in_html = 0; |
376 | next; |
377 | } |
378 | elsif ($lines[0] =~ /^\s+\w*\t.*/) { # listing or unordered list |
379 | print HTML qq{<UL>}; |
380 | foreach $line (@lines) { |
381 | ($line =~ /^\s+(\w*)\t(.*)/) && (($key,$rem) = ($1,$2)); |
382 | print HTML defined($Podnames{$key}) |
5e71e875 |
383 | ? "<LI>$type$Podnames{$key}\">$key<\/A>\t$rem</LI>\n" |
4633a7c4 |
384 | : "<LI>$line</LI>\n"; |
385 | } |
386 | print HTML qq{</UL>\n}; |
387 | } |
388 | elsif ($lines[0] =~ /^\s/) { # preformatted code |
389 | if ($paras[$p] =~/>>|<</) { |
390 | print HTML qq{\n<PRE>\n}; |
391 | $inpre=1; |
392 | } |
393 | else { # Still cant beat XMP. Yes, I know |
5e71e875 |
394 | print HTML qq{\n<XMP>\n}; # it's been obsoleted... suggestions? |
4633a7c4 |
395 | $inpre = 0; |
396 | } |
397 | while (defined($paras[$p])) { |
398 | @lines = split(/\n/,$paras[$p]); |
399 | foreach $q (@lines) { # mind your p's and q's here :-) |
400 | if ($paras[$p] =~ />>|<</) { |
401 | if ($inpre) { |
402 | process_thing(\$q,"HTML"); |
403 | } |
404 | else { |
405 | print HTML qq{\n</XMP>\n}; |
406 | print HTML qq{<PRE>\n}; |
407 | $inpre=1; |
408 | process_thing(\$q,"HTML"); |
409 | } |
410 | } |
411 | 1 while $q =~ s/\t+/' 'x (length($&) * 8 - length($`) % 8)/e; |
412 | print HTML $q,"\n"; |
413 | } |
414 | last if $paras[$p+1] !~ /^\s/; |
415 | $p++; |
416 | } |
417 | print HTML ($inpre==1) ? (qq{\n</PRE>\n}) : (qq{\n</XMP>\n}); |
418 | } |
419 | else { # other text |
420 | @lines = split(/\n/,$paras[$p]); |
421 | foreach $line (@lines) { |
422 | process_thing(\$line,"HTML"); |
5e71e875 |
423 | $line =~ s/STRONG([^>])/STRONG>$1/; # lame attempt to fix strong |
4633a7c4 |
424 | print HTML qq{$line\n}; |
425 | } |
426 | } |
427 | print HTML qq{<p>}; |
428 | } |
429 | } |
430 | |
431 | sub process_thing{ # process a chunk, order important |
432 | my($thing,$htype) = @_; |
433 | pre_escapes($thing); |
434 | find_refs($thing,$htype); |
435 | post_escapes($thing); |
436 | } |
437 | |
438 | sub scan_thing{ # scan a chunk for later references |
439 | my($cmd,$title,$pod) = @_; |
440 | $_ = $title; |
441 | s/\n$//; |
442 | s/E<(.*?)>/&$1;/g; |
443 | # remove any formatting information for the headers |
444 | s/[SFCBI]<(.*?)>/$1/g; |
445 | # the "don't format me" thing |
446 | s/Z<>//g; |
447 | if ($cmd eq "item") { |
448 | /^\*/ and return; # skip bullets |
449 | /^\d+\./ and return; # skip numbers |
450 | s/(-[a-z]).*/$1/i; |
451 | trim($_); |
452 | return if defined $A->{$pod}->{"Items"}->{$_}; |
453 | $A->{$pod}->{"Items"}->{$_} = gensym($pod, $_); |
454 | $A->{$pod}->{"Items"}->{(split(' ',$_))[0]}=$A->{$pod}->{"Items"}->{$_}; |
455 | Debug("items", "item $_"); |
456 | if (!/^-\w$/ && /([%\$\@\w]+)/ && $1 ne $_ |
457 | && !defined($A->{$pod}->{"Items"}->{$_}) && ($_ ne $1)) |
458 | { |
459 | $A->{$pod}->{"Items"}->{$1} = $A->{$pod}->{"Items"}->{$_}; |
460 | Debug("items", "item $1 REF TO $_"); |
461 | } |
462 | if ( m{^(tr|y|s|m|q[qwx])/.*[^/]} ) { |
463 | my $pf = $1 . '//'; |
464 | $pf .= "/" if $1 eq "tr" || $1 eq "y" || $1 eq "s"; |
465 | if ($pf ne $_) { |
466 | $A->{$pod}->{"Items"}->{$pf} = $A->{$pod}->{"Items"}->{$_}; |
467 | Debug("items", "item $pf REF TO $_"); |
468 | } |
469 | } |
470 | } |
471 | elsif ($cmd =~ /^head[12]/) { |
472 | return if defined($A->{$pod}->{"Headers"}->{$_}); |
473 | $A->{$pod}->{"Headers"}->{$_} = gensym($pod, $_); |
474 | Debug("headers", "header $_"); |
475 | } |
476 | else { |
477 | warn "unrecognized header: $cmd" if $Debug; |
478 | } |
479 | } |
480 | |
481 | |
482 | sub picrefs { |
483 | my($char, $bigkey, $lilkey,$htype) = @_; |
484 | my($key,$ref,$podname); |
485 | for $podname ($pod,@inclusions) { |
486 | for $ref ( "Items", "Headers" ) { |
487 | if (defined $A->{$podname}->{$ref}->{$bigkey}) { |
488 | $value = $A->{$podname}->{$ref}->{$key = $bigkey}; |
489 | Debug("subs", "bigkey is $bigkey, value is $value\n"); |
490 | } |
491 | elsif (defined $A->{$podname}->{$ref}->{$lilkey}) { |
492 | $value = $A->{$podname}->{$ref}->{$key = $lilkey}; |
493 | return "" if $lilkey eq ''; |
494 | Debug("subs", "lilkey is $lilkey, value is $value\n"); |
495 | } |
496 | } |
497 | if (length($key)) { |
5e71e875 |
498 | ($pod2, $num) = $value =~ /^(.*)_(\S+_\d+)$/; |
4633a7c4 |
499 | if ($htype eq "NAME") { |
5e71e875 |
500 | return "\n<A NAME=\"".$value."\">\n$bigkey</A>\n" |
4633a7c4 |
501 | } |
502 | else { |
5e71e875 |
503 | 1; # break here |
504 | return "\n$type$Podnames{$pod2}\#".$value."\">$bigkey<\/A>\n"; |
4633a7c4 |
505 | } |
506 | } |
507 | } |
508 | if ($char =~ /[IF]/) { |
509 | return "<EM>$bigkey</EM>"; |
510 | } elsif ($char =~ /C/) { |
5e71e875 |
511 | return "<CODE>$bigkey</CODE>"; |
4633a7c4 |
512 | } else { |
5e71e875 |
513 | if($bigkey =~ /STRONG/){ |
514 | return $bigkey; |
515 | } |
516 | else { |
517 | return "<STRONG>$bigkey</STRONG>"; |
518 | } |
4633a7c4 |
519 | } |
520 | } |
521 | |
522 | sub find_refs { |
523 | my($thing,$htype) = @_; |
524 | my($orig) = $$thing; |
525 | # LREF: a manpage(3f) we don't know about |
526 | for ($$thing) { |
527 | #s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))>:the I<$1>$2 manpage:g; |
528 | s@(\S+?://\S*[^.,;!?\s])@noremap(qq{<A HREF="$1">$1</A>})@ge; |
529 | s,([a-z0-9_.-]+\@([a-z0-9_-]+\.)+([a-z0-9_-]+)),noremap(qq{<A HREF="MAILTO:$1">$1</A>}),gie; |
530 | s/L<([^>]*)>/lrefs($1,$htype)/ge; |
531 | s/([CIBF])<(\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge; |
532 | s/(S)<([^\/]\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge; |
533 | s/((\w+)\(\))/picrefs("I", $1, $2,$htype)/ge; |
534 | s/([\$\@%](?!&[gl]t)([\w:]+|\W\b))/varrefs($1,$htype)/ge; |
535 | } |
536 | if ($$thing eq $orig && $htype eq "NAME") { |
537 | $$thing = picrefs("I", $$thing, "", $htype); |
538 | } |
539 | |
540 | } |
541 | |
542 | sub lrefs { |
543 | my($page, $item) = split(m#/#, $_[0], 2); |
544 | my($htype) = $_[1]; |
545 | my($podname); |
546 | my($section) = $page =~ /\((.*)\)/; |
547 | my $selfref; |
548 | if ($page =~ /^[A-Z]/ && $item) { |
549 | $selfref++; |
550 | $item = "$page/$item"; |
551 | $page = $pod; |
552 | } elsif (!$item && $page =~ /[^a-z\-]/ && $page !~ /^\$.$/) { |
553 | $selfref++; |
554 | $item = $page; |
555 | $page = $pod; |
556 | } |
557 | $item =~ s/\(\)$//; |
558 | if (!$item) { |
559 | if (!defined $section && defined $Podnames{$page}) { |
5e71e875 |
560 | return "\n$type$Podnames{$page}\">\nthe <EM>$page</EM> manpage<\/A>\n"; |
4633a7c4 |
561 | } else { |
562 | (warn "Bizarre entry $page/$item") if $Debug; |
563 | return "the <EM>$_[0]</EM> manpage\n"; |
564 | } |
565 | } |
566 | |
567 | if ($item =~ s/"(.*)"/$1/ || ($item =~ /[^\w\/\-]/ && $item !~ /^\$.$/)) { |
568 | $text = "<EM>$item</EM>"; |
569 | $ref = "Headers"; |
570 | } else { |
571 | $text = "<EM>$item</EM>"; |
572 | $ref = "Items"; |
573 | } |
574 | for $podname ($pod, @inclusions) { |
575 | undef $value; |
576 | if ($ref eq "Items") { |
577 | if (defined($value = $A->{$podname}->{$ref}->{$item})) { |
5e71e875 |
578 | ($pod2,$num) = split(/_/,$value,2); # break here |
579 | return (($pod eq $pod2) && ($htype eq "NAME")) |
580 | ? "\n<A NAME=\"".$value."\">\n$text</A>\n" |
581 | : "\n$type$Podnames{$pod2}\#".$value."\">$text<\/A>\n"; |
582 | } |
583 | } |
4633a7c4 |
584 | elsif ($ref eq "Headers") { |
585 | if (defined($value = $A->{$podname}->{$ref}->{$item})) { |
5e71e875 |
586 | ($pod2,$num) = split(/_/,$value,2); # break here |
4633a7c4 |
587 | return (($pod eq $pod2) && ($htype eq "NAME")) |
588 | ? "\n<A NAME=\"".$value."\">\n$text</A>\n" |
5e71e875 |
589 | : "\n$type$Podnames{$pod2}\#".$value."\">$text<\/A>\n"; |
4633a7c4 |
590 | } |
591 | } |
592 | } |
593 | warn "No $ref reference for $item (@_)" if $Debug; |
594 | return $text; |
595 | } |
596 | |
597 | sub varrefs { |
598 | my ($var,$htype) = @_; |
599 | for $podname ($pod,@inclusions) { |
600 | if ($value = $A->{$podname}->{"Items"}->{$var}) { |
601 | ($pod2,$num) = split(/_/,$value,2); |
602 | Debug("vars", "way cool -- var ref on $var"); |
603 | return (($pod eq $pod2) && ($htype eq "NAME")) # INHERIT $_, $pod |
604 | ? "\n<A NAME=\"".$value."\">\n$var</A>\n" |
5e71e875 |
605 | : "\n$type$Podnames{$pod2}\#".$value."\">$var<\/A>\n"; |
4633a7c4 |
606 | } |
607 | } |
608 | Debug( "vars", "bummer, $var not a var"); |
5e71e875 |
609 | if($var =~ /STRONG/){ |
610 | return $var; |
611 | } |
612 | else{ |
613 | return "<STRONG>$var</STRONG>"; |
614 | } |
4633a7c4 |
615 | } |
616 | |
617 | sub gensym { |
618 | my ($podname, $key) = @_; |
619 | $key =~ s/\s.*//; |
620 | ($key = lc($key)) =~ tr/a-z/_/cs; |
621 | my $name = "${podname}_${key}_0"; |
622 | $name =~ s/__/_/g; |
623 | while ($sawsym{$name}++) { |
624 | $name =~ s/_?(\d+)$/'_' . ($1 + 1)/e; |
625 | } |
626 | return $name; |
627 | } |
628 | |
629 | sub pre_escapes { # twiddle these, and stay up late :-) |
630 | my($thing) = @_; |
631 | for ($$thing) { |
5e71e875 |
632 | s/([\200-\377])/noremap("&#".ord($1).";")/ge; |
633 | s/"(.*?)"/``$1''/gs; |
634 | s/&/noremap("&")/ge; |
635 | s/<</noremap("<<")/eg; |
636 | s/([^ESIBLCF])</$1\<\;/g; |
637 | s/E<(\d+)>/\&#$1\;/g; # embedded numeric special |
638 | s/E<([^\/][^<>]*)>/\&$1\;/g; # embedded special |
4633a7c4 |
639 | } |
640 | } |
641 | sub noremap { # adding translator for hibit chars soon |
642 | my $hide = $_[0]; |
643 | $hide =~ tr/\000-\177/\200-\377/; |
644 | $hide; |
645 | } |
646 | |
647 | |
648 | sub post_escapes { |
649 | my($thing) = @_; |
650 | for ($$thing) { |
651 | s/([^GM])>>/$1\>\;\>\;/g; |
652 | s/([^D][^"MGA])>/$1\>\;/g; |
653 | tr/\200-\377/\000-\177/; |
654 | } |
655 | } |
656 | |
657 | sub Debug { |
658 | my $level = shift; |
659 | print STDERR @_,"\n" if $Debug{$level}; |
660 | } |
661 | |
662 | sub dumptable { |
663 | my $t = shift; |
664 | print STDERR "TABLE DUMP $t\n"; |
665 | foreach $k (sort keys %$t) { |
666 | printf STDERR "%-20s <%s>\n", $t->{$k}, $k; |
667 | } |
668 | } |
669 | sub trim { |
670 | for (@_) { |
671 | s/^\s+//; |
672 | s/\s\n?$//; |
673 | } |
674 | } |
5e71e875 |
675 | sub wanted { |
676 | my $name = $name; |
677 | if (-f $_) { |
678 | if ($name =~ /\.p(m|od)$/){ |
679 | push(@modpods, $name) if ($name =~ /\.p(m|od)$/); |
680 | } |
681 | } |
682 | } |
683 | |
4633a7c4 |
684 | !NO!SUBS! |
685 | |
686 | close OUT or die "Can't close $file: $!"; |
687 | chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; |
688 | exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; |