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