| 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, '.PL'); |
| 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!"; |
| 26 | $Config{startperl} |
| 27 | eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' |
| 28 | if \$running_under_some_shell; |
| 29 | !GROK!THIS! |
| 30 | |
| 31 | # In the following, perl variables are not expanded during extraction. |
| 32 | |
| 33 | print OUT <<'!NO!SUBS!'; |
| 34 | |
| 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) { |
| 100 | print STDERR "Scanning pods...\n" unless $count; |
| 101 | foreach $podfh ( @Pods ) { |
| 102 | ($pod = $podfh) =~ s/\.(?:pod|pm)$//; |
| 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; |
| 120 | print HTML "<TITLE>$pod</TITLE>"; |
| 121 | print HTML "</CENTER>" unless $NO_NS; |
| 122 | print HTML "\n</HEAD>\n<BODY>"; |
| 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); |
| 154 | do_rest($title.$rest); |
| 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; |
| 164 | do_rest($title.$rest); |
| 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$//; |
| 325 | s/E<(\d+)>/&#$1;/g; |
| 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)) { |
| 382 | ($pod2, $num) = $value =~ /^(.*)_(\S+_\d+)$/; |
| 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) { |
| 505 | s/([\200-\377])/noremap("&".ord($1).";")/ge; |
| 506 | s/"(.*?)"/``$1''/gs; |
| 507 | s/&/noremap("&")/ge; |
| 508 | s/<</noremap("<<")/eg; |
| 509 | s/([^ESIBLCF])</$1\<\;/g; |
| 510 | s/E<(\d+)>/\&#$1\;/g; # embedded numeric special |
| 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 ':'; |