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