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