home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / perl-5.003-src.tgz / tar.out / fsf / perl / x2p / s2p.PL < prev    next >
Perl Script  |  1996-09-28  |  15KB  |  782 lines
  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$//
  18.     if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
  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!";
  28. $Config{'startperl'}
  29.     eval 'exec perl -S \$0 "\$@"'
  30.     if 0;
  31. \$startperl = "$Config{startperl}";
  32. !GROK!THIS!
  33.  
  34. # In the following, perl variables are not expanded during extraction.
  35.  
  36. print OUT <<'!NO!SUBS!';
  37.  
  38. # $RCSfile: s2p.SH,v $$Revision: 4.1 $$Date: 92/08/07 18:29:23 $
  39. #
  40. # $Log:    s2p.SH,v $
  41.  
  42. $indent = 4;
  43. $shiftwidth = 4;
  44. $l = '{'; $r = '}';
  45.  
  46. while ($ARGV[0] =~ /^-/) {
  47.     $_ = shift;
  48.   last if /^--/;
  49.     if (/^-D/) {
  50.     $debug++;
  51.     open(BODY,'>-');
  52.     next;
  53.     }
  54.     if (/^-n/) {
  55.     $assumen++;
  56.     next;
  57.     }
  58.     if (/^-p/) {
  59.     $assumep++;
  60.     next;
  61.     }
  62.     die "I don't recognize this switch: $_\n";
  63. }
  64.  
  65. unless ($debug) {
  66.     open(BODY,">/tmp/sperl$$") ||
  67.       &Die("Can't open temp file: $!\n");
  68. }
  69.  
  70. if (!$assumen && !$assumep) {
  71.     print BODY &q(<<'EOT');
  72. :    while ($ARGV[0] =~ /^-/) {
  73. :        $_ = shift;
  74. :      last if /^--/;
  75. :        if (/^-n/) {
  76. :        $nflag++;
  77. :        next;
  78. :        }
  79. :        die "I don't recognize this switch: $_\\n";
  80. :    }
  81. :    
  82. EOT
  83. }
  84.  
  85. print BODY &q(<<'EOT');
  86. :    #ifdef PRINTIT
  87. :    #ifdef ASSUMEP
  88. :    $printit++;
  89. :    #else
  90. :    $printit++ unless $nflag;
  91. :    #endif
  92. :    #endif
  93. :    <><>
  94. :    $\ = "\n";        # automatically add newline on print
  95. :    <><>
  96. :    #ifdef TOPLABEL
  97. :    LINE:
  98. :    while (chop($_ = <>)) {
  99. :    #else
  100. :    LINE:
  101. :    while (<>) {
  102. :        chop;
  103. :    #endif
  104. EOT
  105.  
  106. LINE:
  107. while (<>) {
  108.  
  109.     # Wipe out surrounding whitespace.
  110.  
  111.     s/[ \t]*(.*)\n$/$1/;
  112.  
  113.     # Perhaps it's a label/comment.
  114.  
  115.     if (/^:/) {
  116.     s/^:[ \t]*//;
  117.     $label = &make_label($_);
  118.     if ($. == 1) {
  119.         $toplabel = $label;
  120.         if (/^(top|(re)?start|redo|begin(ning)|again|input)$/i) {
  121.         $_ = <>;
  122.         redo LINE; # Never referenced, so delete it if not a comment.
  123.         }
  124.     }
  125.     $_ = "$label:";
  126.     if ($lastlinewaslabel++) {
  127.         $indent += 4;
  128.         print BODY &tab, ";\n";
  129.         $indent -= 4;
  130.     }
  131.     if ($indent >= 2) {
  132.         $indent -= 2;
  133.         $indmod = 2;
  134.     }
  135.     next;
  136.     } else {
  137.     $lastlinewaslabel = '';
  138.     }
  139.  
  140.     # Look for one or two address clauses
  141.  
  142.     $addr1 = '';
  143.     $addr2 = '';
  144.     if (s/^([0-9]+)//) {
  145.     $addr1 = "$1";
  146.     $addr1 = "\$. == $addr1" unless /^,/;
  147.     }
  148.     elsif (s/^\$//) {
  149.     $addr1 = 'eof()';
  150.     }
  151.     elsif (s|^/||) {
  152.     $addr1 = &fetchpat('/');
  153.     }
  154.     if (s/^,//) {
  155.     if (s/^([0-9]+)//) {
  156.         $addr2 = "$1";
  157.     } elsif (s/^\$//) {
  158.         $addr2 = "eof()";
  159.     } elsif (s|^/||) {
  160.         $addr2 = &fetchpat('/');
  161.     } else {
  162.         &Die("Invalid second address at line $.\n");
  163.     }
  164.     if ($addr2 =~ /^\d+$/) {
  165.         $addr1 .= "..$addr2";
  166.     }
  167.     else {
  168.         $addr1 .= "...$addr2";
  169.     }
  170.     }
  171.  
  172.     # Now we check for metacommands {, }, and ! and worry
  173.     # about indentation.
  174.  
  175.     s/^[ \t]+//;
  176.     # a { to keep vi happy
  177.     if ($_ eq '}') {
  178.     $indent -= 4;
  179.     next;
  180.     }
  181.     if (s/^!//) {
  182.     $if = 'unless';
  183.     $else = "$r else $l\n";
  184.     } else {
  185.     $if = 'if';
  186.     $else = '';
  187.     }
  188.     if (s/^{//) {    # a } to keep vi happy
  189.     $indmod = 4;
  190.     $redo = $_;
  191.     $_ = '';
  192.     $rmaybe = '';
  193.     } else {
  194.     $rmaybe = "\n$r";
  195.     if ($addr2 || $addr1) {
  196.         $space = ' ' x $shiftwidth;
  197.     } else {
  198.         $space = '';
  199.     }
  200.     $_ = &transmogrify();
  201.     }
  202.  
  203.     # See if we can optimize to modifier form.
  204.  
  205.     if ($addr1) {
  206.     if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
  207.       $_ !~ / if / && $_ !~ / unless /) {
  208.         s/;$/ $if $addr1;/;
  209.         $_ = substr($_,$shiftwidth,1000);
  210.     } else {
  211.         $_ = "$if ($addr1) $l\n$change$_$rmaybe";
  212.     }
  213.     $change = '';
  214.     next LINE;
  215.     }
  216. } continue {
  217.     @lines = split(/\n/,$_);
  218.     for (@lines) {
  219.     unless (s/^ *<<--//) {
  220.         print BODY &tab;
  221.     }
  222.     print BODY $_, "\n";
  223.     }
  224.     $indent += $indmod;
  225.     $indmod = 0;
  226.     if ($redo) {
  227.     $_ = $redo;
  228.     $redo = '';
  229.     redo LINE;
  230.     }
  231. }
  232. if ($lastlinewaslabel++) {
  233.     $indent += 4;
  234.     print BODY &tab, ";\n";
  235.     $indent -= 4;
  236. }
  237.  
  238. if ($appendseen || $tseen || !$assumen) {
  239.     $printit++ if $dseen || (!$assumen && !$assumep);
  240.     print BODY &q(<<'EOT');
  241. :    #ifdef SAWNEXT
  242. :    }
  243. :    continue {
  244. :    #endif
  245. :    #ifdef PRINTIT
  246. :    #ifdef DSEEN
  247. :    #ifdef ASSUMEP
  248. :        print if $printit++;
  249. :    #else
  250. :        if ($printit)
  251. :        { print; }
  252. :        else
  253. :        { $printit++ unless $nflag; }
  254. :    #endif
  255. :    #else
  256. :        print if $printit;
  257. :    #endif
  258. :    #else
  259. :        print;
  260. :    #endif
  261. :    #ifdef TSEEN
  262. :        $tflag = 0;
  263. :    #endif
  264. :    #ifdef APPENDSEEN
  265. :        if ($atext) { chop $atext; print $atext; $atext = ''; }
  266. :    #endif
  267. EOT
  268.  
  269. print BODY &q(<<'EOT');
  270. :    }
  271. EOT
  272. }
  273.  
  274. close BODY;
  275.  
  276. unless ($debug) {
  277.     open(HEAD,">/tmp/sperl2$$.c")
  278.       || &Die("Can't open temp file 2: $!\n");
  279.     print HEAD "#define PRINTIT\n"    if $printit;
  280.     print HEAD "#define APPENDSEEN\n"    if $appendseen;
  281.     print HEAD "#define TSEEN\n"    if $tseen;
  282.     print HEAD "#define DSEEN\n"    if $dseen;
  283.     print HEAD "#define ASSUMEN\n"    if $assumen;
  284.     print HEAD "#define ASSUMEP\n"    if $assumep;
  285.     print HEAD "#define TOPLABEL\n"    if $toplabel;
  286.     print HEAD "#define SAWNEXT\n"    if $sawnext;
  287.     if ($opens) {print HEAD "$opens\n";}
  288.     open(BODY,"/tmp/sperl$$")
  289.       || &Die("Can't reopen temp file: $!\n");
  290.     while (<BODY>) {
  291.     print HEAD $_;
  292.     }
  293.     close HEAD;
  294.  
  295.     print &q(<<"EOT");
  296. :    $startperl
  297. :    eval 'exec perl -S \$0 \${1+"\$@"}'
  298. :        if \$running_under_some_shell;
  299. :    
  300. EOT
  301.     open(BODY,"cc -E /tmp/sperl2$$.c |") ||
  302.     &Die("Can't reopen temp file: $!\n");
  303.     while (<BODY>) {
  304.     /^# [0-9]/ && next;
  305.     /^[ \t]*$/ && next;
  306.     s/^<><>//;
  307.     print;
  308.     }
  309. }
  310.  
  311. &Cleanup;
  312. exit;
  313.  
  314. sub Cleanup {
  315.     chdir "/tmp";
  316.     unlink "sperl$$", "sperl2$$", "sperl2$$.c";
  317. }
  318. sub Die {
  319.     &Cleanup;
  320.     die $_[0];
  321. }
  322. sub tab {
  323.     "\t" x ($indent / 8) . ' ' x ($indent % 8);
  324. }
  325. sub make_filehandle {
  326.     local($_) = $_[0];
  327.     local($fname) = $_;
  328.     if (!$seen{$fname}) {
  329.     $_ = "FH_" . $_ if /^\d/;
  330.     s/[^a-zA-Z0-9]/_/g;
  331.     s/^_*//;
  332.     $_ = "\U$_";
  333.     if ($fhseen{$_}) {
  334.         for ($tmp = "a"; $fhseen{"$_$tmp"}; $a++) {}
  335.         $_ .= $tmp;
  336.     }
  337.     $fhseen{$_} = 1;
  338.     $opens .= &q(<<"EOT");
  339. :    open($_, '>$fname') || die "Can't create $fname: \$!";
  340. EOT
  341.     $seen{$fname} = $_;
  342.     }
  343.     $seen{$fname};
  344. }
  345.  
  346. sub make_label {
  347.     local($label) = @_;
  348.     $label =~ s/[^a-zA-Z0-9]/_/g;
  349.     if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
  350.     $label = substr($label,0,8);
  351.  
  352.     # Could be a reserved word, so capitalize it.
  353.     substr($label,0,1) =~ y/a-z/A-Z/
  354.       if $label =~ /^[a-z]/;
  355.  
  356.     $label;
  357. }
  358.  
  359. sub transmogrify {
  360.     {    # case
  361.     if (/^d/) {
  362.         $dseen++;
  363.         chop($_ = &q(<<'EOT'));
  364. :    <<--#ifdef PRINTIT
  365. :    $printit = 0;
  366. :    <<--#endif
  367. :    next LINE;
  368. EOT
  369.         $sawnext++;
  370.         next;
  371.     }
  372.  
  373.     if (/^n/) {
  374.         chop($_ = &q(<<'EOT'));
  375. :    <<--#ifdef PRINTIT
  376. :    <<--#ifdef DSEEN
  377. :    <<--#ifdef ASSUMEP
  378. :    print if $printit++;
  379. :    <<--#else
  380. :    if ($printit)
  381. :        { print; }
  382. :    else
  383. :        { $printit++ unless $nflag; }
  384. :    <<--#endif
  385. :    <<--#else
  386. :    print if $printit;
  387. :    <<--#endif
  388. :    <<--#else
  389. :    print;
  390. :    <<--#endif
  391. :    <<--#ifdef APPENDSEEN
  392. :    if ($atext) {chop $atext; print $atext; $atext = '';}
  393. :    <<--#endif
  394. :    $_ = <>;
  395. :    chop;
  396. :    <<--#ifdef TSEEN
  397. :    $tflag = 0;
  398. :    <<--#endif
  399. EOT
  400.         next;
  401.     }
  402.  
  403.     if (/^a/) {
  404.         $appendseen++;
  405.         $command = $space . "\$atext .= <<'End_Of_Text';\n<<--";
  406.         $lastline = 0;
  407.         while (<>) {
  408.         s/^[ \t]*//;
  409.         s/^[\\]//;
  410.         unless (s|\\$||) { $lastline = 1;}
  411.         s/^([ \t]*\n)/<><>$1/;
  412.         $command .= $_;
  413.         $command .= '<<--';
  414.         last if $lastline;
  415.         }
  416.         $_ = $command . "End_Of_Text";
  417.         last;
  418.     }
  419.  
  420.     if (/^[ic]/) {
  421.         if (/^c/) { $change = 1; }
  422.         $addr1 = 1 if $addr1 eq '';
  423.         $addr1 = '$iter = (' . $addr1 . ')';
  424.         $command = $space .
  425.           "    if (\$iter == 1) { print <<'End_Of_Text'; }\n<<--";
  426.         $lastline = 0;
  427.         while (<>) {
  428.         s/^[ \t]*//;
  429.         s/^[\\]//;
  430.         unless (s/\\$//) { $lastline = 1;}
  431.         s/'/\\'/g;
  432.         s/^([ \t]*\n)/<><>$1/;
  433.         $command .= $_;
  434.         $command .= '<<--';
  435.         last if $lastline;
  436.         }
  437.         $_ = $command . "End_Of_Text";
  438.         if ($change) {
  439.         $dseen++;
  440.         $change = "$_\n";
  441.         chop($_ = &q(<<"EOT"));
  442. :    <<--#ifdef PRINTIT
  443. :    $space\$printit = 0;
  444. :    <<--#endif
  445. :    ${space}next LINE;
  446. EOT
  447.         $sawnext++;
  448.         }
  449.         last;
  450.     }
  451.  
  452.     if (/^s/) {
  453.         $delim = substr($_,1,1);
  454.         $len = length($_);
  455.         $repl = $end = 0;
  456.         $inbracket = 0;
  457.         for ($i = 2; $i < $len; $i++) {
  458.         $c = substr($_,$i,1);
  459.         if ($c eq $delim) {
  460.             if ($inbracket) {
  461.             substr($_, $i, 0) = '\\';
  462.             $i++;
  463.             $len++;
  464.             }
  465.             else {
  466.             if ($repl) {
  467.                 $end = $i;
  468.                 last;
  469.             } else {
  470.                 $repl = $i;
  471.             }
  472.             }
  473.         }
  474.         elsif ($c eq '\\') {
  475.             $i++;
  476.             if ($i >= $len) {
  477.             $_ .= 'n';
  478.             $_ .= <>;
  479.             $len = length($_);
  480.             $_ = substr($_,0,--$len);
  481.             }
  482.             elsif (substr($_,$i,1) =~ /^[n]$/) {
  483.             ;
  484.             }
  485.             elsif (!$repl &&
  486.               substr($_,$i,1) =~ /^[(){}\w]$/) {
  487.             $i--;
  488.             $len--;
  489.             substr($_, $i, 1) = '';
  490.             }
  491.             elsif (!$repl &&
  492.               substr($_,$i,1) =~ /^[<>]$/) {
  493.             substr($_,$i,1) = 'b';
  494.             }
  495.             elsif ($repl && substr($_,$i,1) =~ /^\d$/) {
  496.             substr($_,$i-1,1) = '$';
  497.             }
  498.         }
  499.         elsif ($c eq '&' && $repl) {
  500.             substr($_, $i, 0) = '$';
  501.             $i++;
  502.             $len++;
  503.         }
  504.         elsif ($c eq '$' && $repl) {
  505.             substr($_, $i, 0) = '\\';
  506.             $i++;
  507.             $len++;
  508.         }
  509.         elsif ($c eq '[' && !$repl) {
  510.             $i++ if substr($_,$i,1) eq '^';
  511.             $i++ if substr($_,$i,1) eq ']';
  512.             $inbracket = 1;
  513.         }
  514.         elsif ($c eq ']') {
  515.             $inbracket = 0;
  516.         }
  517.         elsif ($c eq "\t") {
  518.             substr($_, $i, 1) = '\\t';
  519.             $i++;
  520.             $len++;
  521.         }
  522.         elsif (!$repl && index("()+",$c) >= 0) {
  523.             substr($_, $i, 0) = '\\';
  524.             $i++;
  525.             $len++;
  526.         }
  527.         }
  528.         &Die("Malformed substitution at line $.\n")
  529.           unless $end;
  530.         $pat = substr($_, 0, $repl + 1);
  531.         $repl = substr($_, $repl+1, $end-$repl-1);
  532.         $end = substr($_, $end + 1, 1000);
  533.         &simplify($pat);
  534.         $dol = '$';
  535.         $subst = "$pat$repl$delim";
  536.         $cmd = '';
  537.         while ($end) {
  538.         if ($end =~ s/^g//) {
  539.             $subst .= 'g';
  540.             next;
  541.         }
  542.         if ($end =~ s/^p//) {
  543.             $cmd .= ' && (print)';
  544.             next;
  545.         }
  546.         if ($end =~ s/^w[ \t]*//) {
  547.             $fh = &make_filehandle($end);
  548.             $cmd .= " && (print $fh \$_)";
  549.             $end = '';
  550.             next;
  551.         }
  552.         &Die("Unrecognized substitution command".
  553.           "($end) at line $.\n");
  554.         }
  555.         chop ($_ = &q(<<"EOT"));
  556. :    <<--#ifdef TSEEN
  557. :    $subst && \$tflag++$cmd;
  558. :    <<--#else
  559. :    $subst$cmd;
  560. :    <<--#endif
  561. EOT
  562.         next;
  563.     }
  564.  
  565.     if (/^p/) {
  566.         $_ = 'print;';
  567.         next;
  568.     }
  569.  
  570.     if (/^w/) {
  571.         s/^w[ \t]*//;
  572.         $fh = &make_filehandle($_);
  573.         $_ = "print $fh \$_;";
  574.         next;
  575.     }
  576.  
  577.     if (/^r/) {
  578.         $appendseen++;
  579.         s/^r[ \t]*//;
  580.         $file = $_;
  581.         $_ = "\$atext .= `cat $file 2>/dev/null`;";
  582.         next;
  583.     }
  584.  
  585.     if (/^P/) {
  586.         $_ = 'print $1 if /^(.*)/;';
  587.         next;
  588.     }
  589.  
  590.     if (/^D/) {
  591.         chop($_ = &q(<<'EOT'));
  592. :    s/^.*\n?//;
  593. :    redo LINE if $_;
  594. :    next LINE;
  595. EOT
  596.         $sawnext++;
  597.         next;
  598.     }
  599.  
  600.     if (/^N/) {
  601.         chop($_ = &q(<<'EOT'));
  602. :    $_ .= "\n";
  603. :    $len1 = length;
  604. :    $_ .= <>;
  605. :    chop if $len1 < length;
  606. :    <<--#ifdef TSEEN
  607. :    $tflag = 0;
  608. :    <<--#endif
  609. EOT
  610.         next;
  611.     }
  612.  
  613.     if (/^h/) {
  614.         $_ = '$hold = $_;';
  615.         next;
  616.     }
  617.  
  618.     if (/^H/) {
  619.         $_ = '$hold .= "\n"; $hold .= $_;';
  620.         next;
  621.     }
  622.  
  623.     if (/^g/) {
  624.         $_ = '$_ = $hold;';
  625.         next;
  626.     }
  627.  
  628.     if (/^G/) {
  629.         $_ = '$_ .= "\n"; $_ .= $hold;';
  630.         next;
  631.     }
  632.  
  633.     if (/^x/) {
  634.         $_ = '($_, $hold) = ($hold, $_);';
  635.         next;
  636.     }
  637.  
  638.     if (/^b$/) {
  639.         $_ = 'next LINE;';
  640.         $sawnext++;
  641.         next;
  642.     }
  643.  
  644.     if (/^b/) {
  645.         s/^b[ \t]*//;
  646.         $lab = &make_label($_);
  647.         if ($lab eq $toplabel) {
  648.         $_ = 'redo LINE;';
  649.         } else {
  650.         $_ = "goto $lab;";
  651.         }
  652.         next;
  653.     }
  654.  
  655.     if (/^t$/) {
  656.         $_ = 'next LINE if $tflag;';
  657.         $sawnext++;
  658.         $tseen++;
  659.         next;
  660.     }
  661.  
  662.     if (/^t/) {
  663.         s/^t[ \t]*//;
  664.         $lab = &make_label($_);
  665.         $_ = q/if ($tflag) {$tflag = 0; /;
  666.         if ($lab eq $toplabel) {
  667.         $_ .= 'redo LINE;}';
  668.         } else {
  669.         $_ .= "goto $lab;}";
  670.         }
  671.         $tseen++;
  672.         next;
  673.     }
  674.  
  675.     if (/^y/) {
  676.         s/abcdefghijklmnopqrstuvwxyz/a-z/g;
  677.         s/ABCDEFGHIJKLMNOPQRSTUVWXYZ/A-Z/g;
  678.         s/abcdef/a-f/g;
  679.         s/ABCDEF/A-F/g;
  680.         s/0123456789/0-9/g;
  681.         s/01234567/0-7/g;
  682.         $_ .= ';';
  683.     }
  684.  
  685.     if (/^=/) {
  686.         $_ = 'print $.;';
  687.         next;
  688.     }
  689.  
  690.     if (/^q/) {
  691.         chop($_ = &q(<<'EOT'));
  692. :    close(ARGV);
  693. :    @ARGV = ();
  694. :    next LINE;
  695. EOT
  696.         $sawnext++;
  697.         next;
  698.     }
  699.     } continue {
  700.     if ($space) {
  701.         s/^/$space/;
  702.         s/(\n)(.)/$1$space$2/g;
  703.     }
  704.     last;
  705.     }
  706.     $_;
  707. }
  708.  
  709. sub fetchpat {
  710.     local($outer) = @_;
  711.     local($addr) = $outer;
  712.     local($inbracket);
  713.     local($prefix,$delim,$ch);
  714.  
  715.     # Process pattern one potential delimiter at a time.
  716.  
  717.     DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
  718.     $prefix = $1;
  719.     $delim = $2;
  720.     if ($delim eq '\\') {
  721.         s/(.)//;
  722.         $ch = $1;
  723.         $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
  724.         $ch = 'b' if $ch =~ /^[<>]$/;
  725.         $delim .= $ch;
  726.     }
  727.     elsif ($delim eq '[') {
  728.         $inbracket = 1;
  729.         s/^\^// && ($delim .= '^');
  730.         s/^]// && ($delim .= ']');
  731.     }
  732.     elsif ($delim eq ']') {
  733.         $inbracket = 0;
  734.     }
  735.     elsif ($inbracket || $delim ne $outer) {
  736.         $delim = '\\' . $delim;
  737.     }
  738.     $addr .= $prefix;
  739.     $addr .= $delim;
  740.     if ($delim eq $outer && !$inbracket) {
  741.         last DELIM;
  742.     }
  743.     }
  744.     $addr =~ s/\t/\\t/g;
  745.     &simplify($addr);
  746.     $addr;
  747. }
  748.  
  749. sub q {
  750.     local($string) = @_;
  751.     local($*) = 1;
  752.     $string =~ s/^:\t?//g;
  753.     $string;
  754. }
  755.  
  756. sub simplify {
  757.     $_[0] =~ s/_a-za-z0-9/\\w/ig;
  758.     $_[0] =~ s/a-z_a-z0-9/\\w/ig;
  759.     $_[0] =~ s/a-za-z_0-9/\\w/ig;
  760.     $_[0] =~ s/a-za-z0-9_/\\w/ig;
  761.     $_[0] =~ s/_0-9a-za-z/\\w/ig;
  762.     $_[0] =~ s/0-9_a-za-z/\\w/ig;
  763.     $_[0] =~ s/0-9a-z_a-z/\\w/ig;
  764.     $_[0] =~ s/0-9a-za-z_/\\w/ig;
  765.     $_[0] =~ s/\[\\w\]/\\w/g;
  766.     $_[0] =~ s/\[^\\w\]/\\W/g;
  767.     $_[0] =~ s/\[0-9\]/\\d/g;
  768.     $_[0] =~ s/\[^0-9\]/\\D/g;
  769.     $_[0] =~ s/\\d\\d\*/\\d+/g;
  770.     $_[0] =~ s/\\D\\D\*/\\D+/g;
  771.     $_[0] =~ s/\\w\\w\*/\\w+/g;
  772.     $_[0] =~ s/\\t\\t\*/\\t+/g;
  773.     $_[0] =~ s/(\[.[^]]*\])\1\*/$1+/g;
  774.     $_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g;
  775. }
  776.  
  777. !NO!SUBS!
  778.  
  779. close OUT or die "Can't close $file: $!";
  780. chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
  781. exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
  782.