Commit | Line | Data |
---|---|---|
4633a7c4 LW |
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'); | |
4633a7c4 LW |
17 | |
18 | open OUT,">$file" or die "Can't create $file: $!"; | |
19 | ||
20 | print "Extracting $file (with variable substitutions)\n"; | |
21 | ||
22 | # In this section, perl variables will be expanded during extraction. | |
23 | # You can use $Config{...} to use Configure variables. | |
24 | ||
25 | print OUT <<"!GROK!THIS!"; | |
5f05dabc | 26 | $Config{startperl} |
27 | eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' | |
28 | if \$running_under_some_shell; | |
4633a7c4 LW |
29 | !GROK!THIS! |
30 | ||
31 | # In the following, perl variables are not expanded during extraction. | |
32 | ||
33 | print OUT <<'!NO!SUBS!'; | |
5f05dabc | 34 | |
4633a7c4 LW |
35 | # |
36 | # pod2html - convert pod format to html | |
37 | # Version 1.15 | |
38 | # usage: pod2html [podfiles] | |
39 | # Will read the cwd and parse all files with .pod extension | |
40 | # if no arguments are given on the command line. | |
41 | # | |
42 | # Many helps, suggestions, and fixes from the perl5 porters, and all over. | |
43 | # Bill Middleton - wjm@metronet.com | |
44 | # | |
45 | # Please send patches/fixes/features to me | |
46 | # | |
47 | # | |
48 | # | |
49 | *RS = */; | |
50 | *ERRNO = *!; | |
51 | ||
52 | ################################################################################ | |
53 | # Invoke with various levels of debugging possible | |
54 | ################################################################################ | |
55 | while ($ARGV[0] =~ /^-d(.*)/) { | |
56 | shift; | |
57 | $Debug{ lc($1 || shift) }++; | |
58 | } | |
59 | ||
60 | # ck for podnames on command line | |
61 | while ($ARGV[0]) { | |
62 | push(@Pods,shift); | |
63 | } | |
64 | ||
65 | ################################################################################ | |
66 | # CONFIGURE | |
67 | # | |
68 | # The beginning of the url for the anchors to the other sections. | |
69 | # Edit $type to suit. It's configured for relative url's now. | |
70 | # Other possibilities are: | |
71 | # $type = '<A HREF="file://localhost/usr/local/htmldir/'; # file url | |
72 | # $type = '<A HREF="http://www.bozo.com/perl/manual/html/' # server | |
73 | # | |
74 | ################################################################################ | |
75 | ||
76 | $type = '<A HREF="'; | |
77 | $dir = "."; # location of pods | |
78 | ||
79 | # look in these pods for things not found within the current pod | |
80 | # be careful tho, namespace collisions cause stupid links | |
81 | ||
82 | @inclusions = qw[ | |
83 | perlfunc perlvar perlrun perlop | |
84 | ]; | |
85 | ################################################################################ | |
86 | # END CONFIGURE | |
87 | ################################################################################ | |
88 | ||
89 | $A = {}; # The beginning of all things | |
90 | ||
91 | unless (@Pods) { | |
92 | opendir(DIR,$dir) or die "Can't opendir $dir: $ERRNO"; | |
93 | @Pods = grep(/\.pod$/,readdir(DIR)); | |
94 | closedir(DIR) or die "Can't closedir $dir: $ERRNO"; | |
95 | } | |
96 | @Pods or die "aak, expected pods"; | |
97 | ||
98 | # loop twice through the pods, first to learn the links, then to produce html | |
99 | for $count (0,1) { | |
347a6e91 | 100 | print STDERR "Scanning pods...\n" unless $count; |
4633a7c4 | 101 | foreach $podfh ( @Pods ) { |
347a6e91 | 102 | ($pod = $podfh) =~ s/\.(?:pod|pm)$//; |
4633a7c4 LW |
103 | Debug("files", "opening 2 $podfh" ); |
104 | print "Creating $pod.html from $podfh\n" if $count; | |
105 | $RS = "\n="; # grok pods by item (Nonstandard but effecient) | |
106 | open($podfh,"<".$podfh) || die "can't open $podfh: $ERRNO"; | |
107 | @all = <$podfh>; | |
108 | close($podfh); | |
109 | $RS = "\n"; | |
110 | ||
111 | $all[0] =~ s/^=//; | |
112 | for (@all) { s/=$// } | |
113 | $Podnames{$pod} = 1; | |
114 | $in_list = 0; | |
115 | $html = $pod.".html"; | |
116 | if ($count) { # give us a html and rcs header | |
117 | open(HTML,">$html") || die "can't create $html: $ERRNO"; | |
118 | print HTML '<!-- $Id$ -->',"\n",'<HTML><HEAD>',"\n"; | |
119 | print HTML "<CENTER>" unless $NO_NS; | |
a4165598 | 120 | print HTML "<TITLE>$pod</TITLE>"; |
4633a7c4 | 121 | print HTML "</CENTER>" unless $NO_NS; |
a4165598 | 122 | print HTML "\n</HEAD>\n<BODY>"; |
4633a7c4 LW |
123 | } |
124 | for ($i = 0; $i <= $#all; $i++) { # decide what to do with each chunk | |
125 | $all[$i] =~ /^(\w+)\s*(.*)\n?([^\0]*)$/ ; | |
126 | ($cmd, $title, $rest) = ($1,$2,$3); | |
127 | if ($cmd eq "item") { | |
128 | if ($count ) { # producing html | |
129 | do_list("over",$all[$i],\$in_list,\$depth) unless $depth; | |
130 | do_item($title,$rest,$in_list); | |
131 | } | |
132 | else { | |
133 | # scan item | |
134 | scan_thing("item",$title,$pod); | |
135 | } | |
136 | } | |
137 | elsif ($cmd =~ /^head([12])/) { | |
138 | $num = $1; | |
139 | if ($count) { # producing html | |
140 | do_hdr($num,$title,$rest,$depth); | |
141 | } | |
142 | else { | |
143 | # header scan | |
144 | scan_thing($cmd,$title,$pod); # skip head1 | |
145 | } | |
146 | } | |
147 | elsif ($cmd =~ /^over/) { | |
148 | $count and $depth and do_list("over",$all[$i+1],\$in_list,\$depth); | |
149 | } | |
150 | elsif ($cmd =~ /^back/) { | |
151 | if ($count) { # producing html | |
152 | ($depth) or next; # just skip it | |
153 | do_list("back",$all[$i+1],\$in_list,\$depth); | |
347a6e91 | 154 | do_rest($title.$rest); |
4633a7c4 LW |
155 | } |
156 | } | |
157 | elsif ($cmd =~ /^cut/) { | |
158 | next; | |
159 | } | |
160 | elsif ($cmd =~ /^for/) { # experimental pragma html | |
161 | if ($count) { # producing html | |
162 | if ($title =~ s/^html//) { | |
163 | $in_html =1; | |
347a6e91 | 164 | do_rest($title.$rest); |
4633a7c4 LW |
165 | } |
166 | } | |
167 | } | |
168 | elsif ($cmd =~ /^begin/) { # experimental pragma html | |
169 | if ($count) { # producing html | |
170 | if ($title =~ s/^html//) { | |
171 | print HTML $title,"\n",$rest; | |
172 | } | |
173 | elsif ($title =~ /^end/) { | |
174 | next; | |
175 | } | |
176 | } | |
177 | } | |
178 | elsif ($Debug{"misc"}) { | |
179 | warn("unrecognized header: $cmd"); | |
180 | } | |
181 | } | |
182 | # close open lists without '=back' stmts | |
183 | if ($count) { # producing html | |
184 | while ($depth) { | |
185 | do_list("back",$all[$i+1],\$in_list,\$depth); | |
186 | } | |
187 | print HTML "\n</BODY>\n</HTML>\n"; | |
188 | } | |
189 | } | |
190 | } | |
191 | ||
192 | sub do_list{ # setup a list type, depending on some grok logic | |
193 | my($which,$next_one,$list_type,$depth) = @_; | |
194 | my($key); | |
195 | if ($which eq "over") { | |
196 | unless ($next_one =~ /^item\s+(.*)/) { | |
197 | warn "Bad list, $1\n" if $Debug{"misc"}; | |
198 | } | |
199 | $key = $1; | |
200 | ||
201 | if ($key =~ /^1\.?/) { | |
202 | $$list_type = "OL"; | |
203 | } elsif ($key =~ /\*\s*$/) { | |
204 | $$list_type = "UL"; | |
205 | } elsif ($key =~ /\*?\s*\w/) { | |
206 | $$list_type = "DL"; | |
207 | } else { | |
208 | warn "unknown list type for item $key" if $Debug{"misc"}; | |
209 | } | |
210 | ||
211 | print HTML qq{\n}; | |
212 | print HTML $$list_type eq 'DL' ? qq{<DL COMPACT>} : qq{<$$list_type>}; | |
213 | $$depth++; | |
214 | } | |
215 | elsif ($which eq "back") { | |
216 | print HTML qq{\n</$$list_type>\n}; | |
217 | $$depth--; | |
218 | } | |
219 | } | |
220 | ||
221 | sub do_hdr{ # headers | |
222 | my($num,$title,$rest,$depth) = @_; | |
223 | print HTML qq{<p><hr>\n} if $num == 1; | |
224 | process_thing(\$title,"NAME"); | |
225 | print HTML qq{\n<H$num> }; | |
226 | print HTML $title; | |
227 | print HTML qq{</H$num>\n}; | |
228 | do_rest($rest); | |
229 | } | |
230 | ||
231 | sub do_item{ # list items | |
232 | my($title,$rest,$list_type) = @_; | |
233 | my $bullet_only = $title eq '*' and $list_type eq 'UL'; | |
234 | process_thing(\$title,"NAME"); | |
235 | if ($list_type eq "DL") { | |
236 | print HTML qq{\n<DT><STRONG>\n}; | |
237 | print HTML $title; | |
238 | print HTML qq{\n</STRONG>\n}; | |
239 | print HTML qq{<DD>\n}; | |
240 | } | |
241 | else { | |
242 | print HTML qq{\n<LI>}; | |
243 | unless ($bullet_only or $list_type eq "OL") { | |
244 | print HTML $title,"\n"; | |
245 | } | |
246 | } | |
247 | do_rest($rest); | |
248 | } | |
249 | ||
250 | sub do_rest{ # the rest of the chunk handled here | |
251 | my($rest) = @_; | |
252 | my(@lines,$p,$q,$line,,@paras,$inpre); | |
253 | @paras = split(/\n\n\n*/,$rest); | |
254 | for ($p = 0; $p <= $#paras; $p++) { | |
255 | $paras[$p] =~ s/^\n//mg; | |
256 | @lines = split(/\n/,$paras[$p]); | |
257 | if ($in_html) { # handle =for html paragraphs | |
258 | print HTML $paras[0]; | |
259 | $in_html = 0; | |
260 | next; | |
261 | } | |
262 | elsif ($lines[0] =~ /^\s+\w*\t.*/) { # listing or unordered list | |
263 | print HTML qq{<UL>}; | |
264 | foreach $line (@lines) { | |
265 | ($line =~ /^\s+(\w*)\t(.*)/) && (($key,$rem) = ($1,$2)); | |
266 | print HTML defined($Podnames{$key}) | |
267 | ? "<LI>$type$key.html\">$key<\/A>\t$rem</LI>\n" | |
268 | : "<LI>$line</LI>\n"; | |
269 | } | |
270 | print HTML qq{</UL>\n}; | |
271 | } | |
272 | elsif ($lines[0] =~ /^\s/) { # preformatted code | |
273 | if ($paras[$p] =~/>>|<</) { | |
274 | print HTML qq{\n<PRE>\n}; | |
275 | $inpre=1; | |
276 | } | |
277 | else { # Still cant beat XMP. Yes, I know | |
278 | print HTML qq{\n<XMP>\n}; # it's been obsoleted... suggestions? | |
279 | $inpre = 0; | |
280 | } | |
281 | while (defined($paras[$p])) { | |
282 | @lines = split(/\n/,$paras[$p]); | |
283 | foreach $q (@lines) { # mind your p's and q's here :-) | |
284 | if ($paras[$p] =~ />>|<</) { | |
285 | if ($inpre) { | |
286 | process_thing(\$q,"HTML"); | |
287 | } | |
288 | else { | |
289 | print HTML qq{\n</XMP>\n}; | |
290 | print HTML qq{<PRE>\n}; | |
291 | $inpre=1; | |
292 | process_thing(\$q,"HTML"); | |
293 | } | |
294 | } | |
295 | 1 while $q =~ s/\t+/' 'x (length($&) * 8 - length($`) % 8)/e; | |
296 | print HTML $q,"\n"; | |
297 | } | |
298 | last if $paras[$p+1] !~ /^\s/; | |
299 | $p++; | |
300 | } | |
301 | print HTML ($inpre==1) ? (qq{\n</PRE>\n}) : (qq{\n</XMP>\n}); | |
302 | } | |
303 | else { # other text | |
304 | @lines = split(/\n/,$paras[$p]); | |
305 | foreach $line (@lines) { | |
306 | process_thing(\$line,"HTML"); | |
307 | print HTML qq{$line\n}; | |
308 | } | |
309 | } | |
310 | print HTML qq{<p>}; | |
311 | } | |
312 | } | |
313 | ||
314 | sub process_thing{ # process a chunk, order important | |
315 | my($thing,$htype) = @_; | |
316 | pre_escapes($thing); | |
317 | find_refs($thing,$htype); | |
318 | post_escapes($thing); | |
319 | } | |
320 | ||
321 | sub scan_thing{ # scan a chunk for later references | |
322 | my($cmd,$title,$pod) = @_; | |
323 | $_ = $title; | |
324 | s/\n$//; | |
7f3dfc00 | 325 | s/E<(\d+)>/&#$1;/g; |
4633a7c4 LW |
326 | s/E<(.*?)>/&$1;/g; |
327 | # remove any formatting information for the headers | |
328 | s/[SFCBI]<(.*?)>/$1/g; | |
329 | # the "don't format me" thing | |
330 | s/Z<>//g; | |
331 | if ($cmd eq "item") { | |
332 | /^\*/ and return; # skip bullets | |
333 | /^\d+\./ and return; # skip numbers | |
334 | s/(-[a-z]).*/$1/i; | |
335 | trim($_); | |
336 | return if defined $A->{$pod}->{"Items"}->{$_}; | |
337 | $A->{$pod}->{"Items"}->{$_} = gensym($pod, $_); | |
338 | $A->{$pod}->{"Items"}->{(split(' ',$_))[0]}=$A->{$pod}->{"Items"}->{$_}; | |
339 | Debug("items", "item $_"); | |
340 | if (!/^-\w$/ && /([%\$\@\w]+)/ && $1 ne $_ | |
341 | && !defined($A->{$pod}->{"Items"}->{$_}) && ($_ ne $1)) | |
342 | { | |
343 | $A->{$pod}->{"Items"}->{$1} = $A->{$pod}->{"Items"}->{$_}; | |
344 | Debug("items", "item $1 REF TO $_"); | |
345 | } | |
346 | if ( m{^(tr|y|s|m|q[qwx])/.*[^/]} ) { | |
347 | my $pf = $1 . '//'; | |
348 | $pf .= "/" if $1 eq "tr" || $1 eq "y" || $1 eq "s"; | |
349 | if ($pf ne $_) { | |
350 | $A->{$pod}->{"Items"}->{$pf} = $A->{$pod}->{"Items"}->{$_}; | |
351 | Debug("items", "item $pf REF TO $_"); | |
352 | } | |
353 | } | |
354 | } | |
355 | elsif ($cmd =~ /^head[12]/) { | |
356 | return if defined($A->{$pod}->{"Headers"}->{$_}); | |
357 | $A->{$pod}->{"Headers"}->{$_} = gensym($pod, $_); | |
358 | Debug("headers", "header $_"); | |
359 | } | |
360 | else { | |
361 | warn "unrecognized header: $cmd" if $Debug; | |
362 | } | |
363 | } | |
364 | ||
365 | ||
366 | sub picrefs { | |
367 | my($char, $bigkey, $lilkey,$htype) = @_; | |
368 | my($key,$ref,$podname); | |
369 | for $podname ($pod,@inclusions) { | |
370 | for $ref ( "Items", "Headers" ) { | |
371 | if (defined $A->{$podname}->{$ref}->{$bigkey}) { | |
372 | $value = $A->{$podname}->{$ref}->{$key = $bigkey}; | |
373 | Debug("subs", "bigkey is $bigkey, value is $value\n"); | |
374 | } | |
375 | elsif (defined $A->{$podname}->{$ref}->{$lilkey}) { | |
376 | $value = $A->{$podname}->{$ref}->{$key = $lilkey}; | |
377 | return "" if $lilkey eq ''; | |
378 | Debug("subs", "lilkey is $lilkey, value is $value\n"); | |
379 | } | |
380 | } | |
381 | if (length($key)) { | |
a4165598 | 382 | ($pod2, $num) = $value =~ /^(.*)_(\S+_\d+)$/; |
4633a7c4 LW |
383 | if ($htype eq "NAME") { |
384 | return "\n<A NAME=\"".$value."\">\n$bigkey</A>\n" | |
385 | } | |
386 | else { | |
387 | return "\n$type$pod2.html\#".$value."\">$bigkey<\/A>\n"; | |
388 | } | |
389 | } | |
390 | } | |
391 | if ($char =~ /[IF]/) { | |
392 | return "<EM>$bigkey</EM>"; | |
393 | } elsif ($char =~ /C/) { | |
394 | return "<CODE>$bigkey</CODE>"; | |
395 | } else { | |
396 | return "<STRONG>$bigkey</STRONG>"; | |
397 | } | |
398 | } | |
399 | ||
400 | sub find_refs { | |
401 | my($thing,$htype) = @_; | |
402 | my($orig) = $$thing; | |
403 | # LREF: a manpage(3f) we don't know about | |
404 | for ($$thing) { | |
405 | #s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))>:the I<$1>$2 manpage:g; | |
406 | s@(\S+?://\S*[^.,;!?\s])@noremap(qq{<A HREF="$1">$1</A>})@ge; | |
407 | s,([a-z0-9_.-]+\@([a-z0-9_-]+\.)+([a-z0-9_-]+)),noremap(qq{<A HREF="MAILTO:$1">$1</A>}),gie; | |
408 | s/L<([^>]*)>/lrefs($1,$htype)/ge; | |
409 | s/([CIBF])<(\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge; | |
410 | s/(S)<([^\/]\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge; | |
411 | s/((\w+)\(\))/picrefs("I", $1, $2,$htype)/ge; | |
412 | s/([\$\@%](?!&[gl]t)([\w:]+|\W\b))/varrefs($1,$htype)/ge; | |
413 | } | |
414 | if ($$thing eq $orig && $htype eq "NAME") { | |
415 | $$thing = picrefs("I", $$thing, "", $htype); | |
416 | } | |
417 | ||
418 | } | |
419 | ||
420 | sub lrefs { | |
421 | my($page, $item) = split(m#/#, $_[0], 2); | |
422 | my($htype) = $_[1]; | |
423 | my($podname); | |
424 | my($section) = $page =~ /\((.*)\)/; | |
425 | my $selfref; | |
426 | if ($page =~ /^[A-Z]/ && $item) { | |
427 | $selfref++; | |
428 | $item = "$page/$item"; | |
429 | $page = $pod; | |
430 | } elsif (!$item && $page =~ /[^a-z\-]/ && $page !~ /^\$.$/) { | |
431 | $selfref++; | |
432 | $item = $page; | |
433 | $page = $pod; | |
434 | } | |
435 | $item =~ s/\(\)$//; | |
436 | if (!$item) { | |
437 | if (!defined $section && defined $Podnames{$page}) { | |
438 | return "\n$type$page.html\">\nthe <EM>$page</EM> manpage<\/A>\n"; | |
439 | } else { | |
440 | (warn "Bizarre entry $page/$item") if $Debug; | |
441 | return "the <EM>$_[0]</EM> manpage\n"; | |
442 | } | |
443 | } | |
444 | ||
445 | if ($item =~ s/"(.*)"/$1/ || ($item =~ /[^\w\/\-]/ && $item !~ /^\$.$/)) { | |
446 | $text = "<EM>$item</EM>"; | |
447 | $ref = "Headers"; | |
448 | } else { | |
449 | $text = "<EM>$item</EM>"; | |
450 | $ref = "Items"; | |
451 | } | |
452 | for $podname ($pod, @inclusions) { | |
453 | undef $value; | |
454 | if ($ref eq "Items") { | |
455 | if (defined($value = $A->{$podname}->{$ref}->{$item})) { | |
456 | ($pod2,$num) = split(/_/,$value,2); | |
457 | return (($pod eq $pod2) && ($htype eq "NAME")) | |
458 | ? "\n<A NAME=\"".$value."\">\n$text</A>\n" | |
459 | : "\n$type$pod2.html\#".$value."\">$text<\/A>\n"; | |
460 | } | |
461 | } | |
462 | elsif ($ref eq "Headers") { | |
463 | if (defined($value = $A->{$podname}->{$ref}->{$item})) { | |
464 | ($pod2,$num) = split(/_/,$value,2); | |
465 | return (($pod eq $pod2) && ($htype eq "NAME")) | |
466 | ? "\n<A NAME=\"".$value."\">\n$text</A>\n" | |
467 | : "\n$type$pod2.html\#".$value."\">$text<\/A>\n"; | |
468 | } | |
469 | } | |
470 | } | |
471 | warn "No $ref reference for $item (@_)" if $Debug; | |
472 | return $text; | |
473 | } | |
474 | ||
475 | sub varrefs { | |
476 | my ($var,$htype) = @_; | |
477 | for $podname ($pod,@inclusions) { | |
478 | if ($value = $A->{$podname}->{"Items"}->{$var}) { | |
479 | ($pod2,$num) = split(/_/,$value,2); | |
480 | Debug("vars", "way cool -- var ref on $var"); | |
481 | return (($pod eq $pod2) && ($htype eq "NAME")) # INHERIT $_, $pod | |
482 | ? "\n<A NAME=\"".$value."\">\n$var</A>\n" | |
483 | : "\n$type$pod2.html\#".$value."\">$var<\/A>\n"; | |
484 | } | |
485 | } | |
486 | Debug( "vars", "bummer, $var not a var"); | |
487 | return "<STRONG>$var</STRONG>"; | |
488 | } | |
489 | ||
490 | sub gensym { | |
491 | my ($podname, $key) = @_; | |
492 | $key =~ s/\s.*//; | |
493 | ($key = lc($key)) =~ tr/a-z/_/cs; | |
494 | my $name = "${podname}_${key}_0"; | |
495 | $name =~ s/__/_/g; | |
496 | while ($sawsym{$name}++) { | |
497 | $name =~ s/_?(\d+)$/'_' . ($1 + 1)/e; | |
498 | } | |
499 | return $name; | |
500 | } | |
501 | ||
502 | sub pre_escapes { # twiddle these, and stay up late :-) | |
503 | my($thing) = @_; | |
504 | for ($$thing) { | |
347a6e91 | 505 | s/([\200-\377])/noremap("&".ord($1).";")/ge; |
4633a7c4 LW |
506 | s/"(.*?)"/``$1''/gs; |
507 | s/&/noremap("&")/ge; | |
508 | s/<</noremap("<<")/eg; | |
509 | s/([^ESIBLCF])</$1\<\;/g; | |
7f3dfc00 | 510 | s/E<(\d+)>/\&#$1\;/g; # embedded numeric special |
4633a7c4 LW |
511 | s/E<([^\/][^<>]*)>/\&$1\;/g; # embedded special |
512 | } | |
513 | } | |
514 | sub noremap { # adding translator for hibit chars soon | |
515 | my $hide = $_[0]; | |
516 | $hide =~ tr/\000-\177/\200-\377/; | |
517 | $hide; | |
518 | } | |
519 | ||
520 | ||
521 | sub post_escapes { | |
522 | my($thing) = @_; | |
523 | for ($$thing) { | |
524 | s/([^GM])>>/$1\>\;\>\;/g; | |
525 | s/([^D][^"MGA])>/$1\>\;/g; | |
526 | tr/\200-\377/\000-\177/; | |
527 | } | |
528 | } | |
529 | ||
530 | sub Debug { | |
531 | my $level = shift; | |
532 | print STDERR @_,"\n" if $Debug{$level}; | |
533 | } | |
534 | ||
535 | sub dumptable { | |
536 | my $t = shift; | |
537 | print STDERR "TABLE DUMP $t\n"; | |
538 | foreach $k (sort keys %$t) { | |
539 | printf STDERR "%-20s <%s>\n", $t->{$k}, $k; | |
540 | } | |
541 | } | |
542 | sub trim { | |
543 | for (@_) { | |
544 | s/^\s+//; | |
545 | s/\s\n?$//; | |
546 | } | |
547 | } | |
548 | !NO!SUBS! | |
549 | ||
550 | close OUT or die "Can't close $file: $!"; | |
551 | chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; | |
552 | exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; |