Pod typos, pod2man bugs, and miscellaneous installation comments
[perl.git] / x2p / s2p.PL
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 =head1 NAME
43
44 s2p - Sed to Perl translator
45
46 =head1 SYNOPSIS
47
48 B<s2p [options] filename>
49
50 =head1 DESCRIPTION
51
52 I<S2p> takes a sed script specified on the command line (or from
53 standard input) and produces a comparable I<perl> script on the
54 standard output.
55
56 =head2 Options
57
58 Options include:
59
60 =over 5
61
62 =item B<-DE<lt>numberE<gt>>
63
64 sets debugging flags.
65
66 =item B<-n>
67
68 specifies that this sed script was always invoked with a B<sed -n>.
69 Otherwise a switch parser is prepended to the front of the script.
70
71 =item B<-p>
72
73 specifies that this sed script was never invoked with a B<sed -n>.
74 Otherwise a switch parser is prepended to the front of the script.
75
76 =back
77
78 =head2 Considerations
79
80 The perl script produced looks very sed-ish, and there may very well
81 be better ways to express what you want to do in perl.  For instance,
82 s2p does not make any use of the split operator, but you might want
83 to.
84
85 The perl script you end up with may be either faster or slower than
86 the original sed script.  If you're only interested in speed you'll
87 just have to try it both ways.  Of course, if you want to do something
88 sed doesn't do, you have no choice.  It's often possible to speed up
89 the perl script by various methods, such as deleting all references to
90 $\ and chop.
91
92 =head1 ENVIRONMENT
93
94 S2p uses no environment variables.
95
96 =head1 AUTHOR
97
98 Larry Wall E<lt>F<lwall@jpl-devvax.Jpl.Nasa.Gov>E<gt>
99
100 =head1 FILES
101
102 =head1 SEE ALSO
103
104  perl   The perl compiler/interpreter
105  
106  a2p    awk to perl translator
107
108 =head1 DIAGNOSTICS
109
110 =head1 BUGS
111
112 =cut
113
114 $indent = 4;
115 $shiftwidth = 4;
116 $l = '{'; $r = '}';
117
118 while ($ARGV[0] =~ /^-/) {
119     $_ = shift;
120   last if /^--/;
121     if (/^-D/) {
122         $debug++;
123         open(BODY,'>-');
124         next;
125     }
126     if (/^-n/) {
127         $assumen++;
128         next;
129     }
130     if (/^-p/) {
131         $assumep++;
132         next;
133     }
134     die "I don't recognize this switch: $_\n";
135 }
136
137 unless ($debug) {
138     open(BODY,">/tmp/sperl$$") ||
139       &Die("Can't open temp file: $!\n");
140 }
141
142 if (!$assumen && !$assumep) {
143     print BODY &q(<<'EOT');
144 :       while ($ARGV[0] =~ /^-/) {
145 :           $_ = shift;
146 :         last if /^--/;
147 :           if (/^-n/) {
148 :               $nflag++;
149 :               next;
150 :           }
151 :           die "I don't recognize this switch: $_\\n";
152 :       }
153 :       
154 EOT
155 }
156
157 print BODY &q(<<'EOT');
158 :       #ifdef PRINTIT
159 :       #ifdef ASSUMEP
160 :       $printit++;
161 :       #else
162 :       $printit++ unless $nflag;
163 :       #endif
164 :       #endif
165 :       <><>
166 :       $\ = "\n";              # automatically add newline on print
167 :       <><>
168 :       #ifdef TOPLABEL
169 :       LINE:
170 :       while (chop($_ = <>)) {
171 :       #else
172 :       LINE:
173 :       while (<>) {
174 :           chop;
175 :       #endif
176 EOT
177
178 LINE:
179 while (<>) {
180
181     # Wipe out surrounding whitespace.
182
183     s/[ \t]*(.*)\n$/$1/;
184
185     # Perhaps it's a label/comment.
186
187     if (/^:/) {
188         s/^:[ \t]*//;
189         $label = &make_label($_);
190         if ($. == 1) {
191             $toplabel = $label;
192             if (/^(top|(re)?start|redo|begin(ning)|again|input)$/i) {
193                 $_ = <>;
194                 redo LINE; # Never referenced, so delete it if not a comment.
195             }
196         }
197         $_ = "$label:";
198         if ($lastlinewaslabel++) {
199             $indent += 4;
200             print BODY &tab, ";\n";
201             $indent -= 4;
202         }
203         if ($indent >= 2) {
204             $indent -= 2;
205             $indmod = 2;
206         }
207         next;
208     } else {
209         $lastlinewaslabel = '';
210     }
211
212     # Look for one or two address clauses
213
214     $addr1 = '';
215     $addr2 = '';
216     if (s/^([0-9]+)//) {
217         $addr1 = "$1";
218         $addr1 = "\$. == $addr1" unless /^,/;
219     }
220     elsif (s/^\$//) {
221         $addr1 = 'eof()';
222     }
223     elsif (s|^/||) {
224         $addr1 = &fetchpat('/');
225     }
226     if (s/^,//) {
227         if (s/^([0-9]+)//) {
228             $addr2 = "$1";
229         } elsif (s/^\$//) {
230             $addr2 = "eof()";
231         } elsif (s|^/||) {
232             $addr2 = &fetchpat('/');
233         } else {
234             &Die("Invalid second address at line $.\n");
235         }
236         if ($addr2 =~ /^\d+$/) {
237             $addr1 .= "..$addr2";
238         }
239         else {
240             $addr1 .= "...$addr2";
241         }
242     }
243
244     # Now we check for metacommands {, }, and ! and worry
245     # about indentation.
246
247     s/^[ \t]+//;
248     # a { to keep vi happy
249     if ($_ eq '}') {
250         $indent -= 4;
251         next;
252     }
253     if (s/^!//) {
254         $if = 'unless';
255         $else = "$r else $l\n";
256     } else {
257         $if = 'if';
258         $else = '';
259     }
260     if (s/^{//) {       # a } to keep vi happy
261         $indmod = 4;
262         $redo = $_;
263         $_ = '';
264         $rmaybe = '';
265     } else {
266         $rmaybe = "\n$r";
267         if ($addr2 || $addr1) {
268             $space = ' ' x $shiftwidth;
269         } else {
270             $space = '';
271         }
272         $_ = &transmogrify();
273     }
274
275     # See if we can optimize to modifier form.
276
277     if ($addr1) {
278         if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
279           $_ !~ / if / && $_ !~ / unless /) {
280             s/;$/ $if $addr1;/;
281             $_ = substr($_,$shiftwidth,1000);
282         } else {
283             $_ = "$if ($addr1) $l\n$change$_$rmaybe";
284         }
285         $change = '';
286         next LINE;
287     }
288 } continue {
289     @lines = split(/\n/,$_);
290     for (@lines) {
291         unless (s/^ *<<--//) {
292             print BODY &tab;
293         }
294         print BODY $_, "\n";
295     }
296     $indent += $indmod;
297     $indmod = 0;
298     if ($redo) {
299         $_ = $redo;
300         $redo = '';
301         redo LINE;
302     }
303 }
304 if ($lastlinewaslabel++) {
305     $indent += 4;
306     print BODY &tab, ";\n";
307     $indent -= 4;
308 }
309
310 if ($appendseen || $tseen || !$assumen) {
311     $printit++ if $dseen || (!$assumen && !$assumep);
312     print BODY &q(<<'EOT');
313 :       #ifdef SAWNEXT
314 :       }
315 :       continue {
316 :       #endif
317 :       #ifdef PRINTIT
318 :       #ifdef DSEEN
319 :       #ifdef ASSUMEP
320 :           print if $printit++;
321 :       #else
322 :           if ($printit)
323 :               { print; }
324 :           else
325 :               { $printit++ unless $nflag; }
326 :       #endif
327 :       #else
328 :           print if $printit;
329 :       #endif
330 :       #else
331 :           print;
332 :       #endif
333 :       #ifdef TSEEN
334 :           $tflag = 0;
335 :       #endif
336 :       #ifdef APPENDSEEN
337 :           if ($atext) { chop $atext; print $atext; $atext = ''; }
338 :       #endif
339 EOT
340
341 print BODY &q(<<'EOT');
342 :       }
343 EOT
344 }
345
346 close BODY;
347
348 unless ($debug) {
349     open(HEAD,">/tmp/sperl2$$.c")
350       || &Die("Can't open temp file 2: $!\n");
351     print HEAD "#define PRINTIT\n"      if $printit;
352     print HEAD "#define APPENDSEEN\n"   if $appendseen;
353     print HEAD "#define TSEEN\n"        if $tseen;
354     print HEAD "#define DSEEN\n"        if $dseen;
355     print HEAD "#define ASSUMEN\n"      if $assumen;
356     print HEAD "#define ASSUMEP\n"      if $assumep;
357     print HEAD "#define TOPLABEL\n"     if $toplabel;
358     print HEAD "#define SAWNEXT\n"      if $sawnext;
359     if ($opens) {print HEAD "$opens\n";}
360     open(BODY,"/tmp/sperl$$")
361       || &Die("Can't reopen temp file: $!\n");
362     while (<BODY>) {
363         print HEAD $_;
364     }
365     close HEAD;
366
367     print &q(<<"EOT");
368 :       $startperl
369 :       eval 'exec perl -S \$0 \${1+"\$@"}'
370 :               if \$running_under_some_shell;
371 :       
372 EOT
373     open(BODY,"cc -E /tmp/sperl2$$.c |") ||
374         &Die("Can't reopen temp file: $!\n");
375     while (<BODY>) {
376         /^# [0-9]/ && next;
377         /^[ \t]*$/ && next;
378         s/^<><>//;
379         print;
380     }
381 }
382
383 &Cleanup;
384 exit;
385
386 sub Cleanup {
387     chdir "/tmp";
388     unlink "sperl$$", "sperl2$$", "sperl2$$.c";
389 }
390 sub Die {
391     &Cleanup;
392     die $_[0];
393 }
394 sub tab {
395     "\t" x ($indent / 8) . ' ' x ($indent % 8);
396 }
397 sub make_filehandle {
398     local($_) = $_[0];
399     local($fname) = $_;
400     if (!$seen{$fname}) {
401         $_ = "FH_" . $_ if /^\d/;
402         s/[^a-zA-Z0-9]/_/g;
403         s/^_*//;
404         $_ = "\U$_";
405         if ($fhseen{$_}) {
406             for ($tmp = "a"; $fhseen{"$_$tmp"}; $a++) {}
407             $_ .= $tmp;
408         }
409         $fhseen{$_} = 1;
410         $opens .= &q(<<"EOT");
411 :       open($_, '>$fname') || die "Can't create $fname: \$!";
412 EOT
413         $seen{$fname} = $_;
414     }
415     $seen{$fname};
416 }
417
418 sub make_label {
419     local($label) = @_;
420     $label =~ s/[^a-zA-Z0-9]/_/g;
421     if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
422     $label = substr($label,0,8);
423
424     # Could be a reserved word, so capitalize it.
425     substr($label,0,1) =~ y/a-z/A-Z/
426       if $label =~ /^[a-z]/;
427
428     $label;
429 }
430
431 sub transmogrify {
432     {   # case
433         if (/^d/) {
434             $dseen++;
435             chop($_ = &q(<<'EOT'));
436 :       <<--#ifdef PRINTIT
437 :       $printit = 0;
438 :       <<--#endif
439 :       next LINE;
440 EOT
441             $sawnext++;
442             next;
443         }
444
445         if (/^n/) {
446             chop($_ = &q(<<'EOT'));
447 :       <<--#ifdef PRINTIT
448 :       <<--#ifdef DSEEN
449 :       <<--#ifdef ASSUMEP
450 :       print if $printit++;
451 :       <<--#else
452 :       if ($printit)
453 :           { print; }
454 :       else
455 :           { $printit++ unless $nflag; }
456 :       <<--#endif
457 :       <<--#else
458 :       print if $printit;
459 :       <<--#endif
460 :       <<--#else
461 :       print;
462 :       <<--#endif
463 :       <<--#ifdef APPENDSEEN
464 :       if ($atext) {chop $atext; print $atext; $atext = '';}
465 :       <<--#endif
466 :       $_ = <>;
467 :       chop;
468 :       <<--#ifdef TSEEN
469 :       $tflag = 0;
470 :       <<--#endif
471 EOT
472             next;
473         }
474
475         if (/^a/) {
476             $appendseen++;
477             $command = $space . "\$atext .= <<'End_Of_Text';\n<<--";
478             $lastline = 0;
479             while (<>) {
480                 s/^[ \t]*//;
481                 s/^[\\]//;
482                 unless (s|\\$||) { $lastline = 1;}
483                 s/^([ \t]*\n)/<><>$1/;
484                 $command .= $_;
485                 $command .= '<<--';
486                 last if $lastline;
487             }
488             $_ = $command . "End_Of_Text";
489             last;
490         }
491
492         if (/^[ic]/) {
493             if (/^c/) { $change = 1; }
494             $addr1 = 1 if $addr1 eq '';
495             $addr1 = '$iter = (' . $addr1 . ')';
496             $command = $space .
497               "    if (\$iter == 1) { print <<'End_Of_Text'; }\n<<--";
498             $lastline = 0;
499             while (<>) {
500                 s/^[ \t]*//;
501                 s/^[\\]//;
502                 unless (s/\\$//) { $lastline = 1;}
503                 s/'/\\'/g;
504                 s/^([ \t]*\n)/<><>$1/;
505                 $command .= $_;
506                 $command .= '<<--';
507                 last if $lastline;
508             }
509             $_ = $command . "End_Of_Text";
510             if ($change) {
511                 $dseen++;
512                 $change = "$_\n";
513                 chop($_ = &q(<<"EOT"));
514 :       <<--#ifdef PRINTIT
515 :       $space\$printit = 0;
516 :       <<--#endif
517 :       ${space}next LINE;
518 EOT
519                 $sawnext++;
520             }
521             last;
522         }
523
524         if (/^s/) {
525             $delim = substr($_,1,1);
526             $len = length($_);
527             $repl = $end = 0;
528             $inbracket = 0;
529             for ($i = 2; $i < $len; $i++) {
530                 $c = substr($_,$i,1);
531                 if ($c eq $delim) {
532                     if ($inbracket) {
533                         substr($_, $i, 0) = '\\';
534                         $i++;
535                         $len++;
536                     }
537                     else {
538                         if ($repl) {
539                             $end = $i;
540                             last;
541                         } else {
542                             $repl = $i;
543                         }
544                     }
545                 }
546                 elsif ($c eq '\\') {
547                     $i++;
548                     if ($i >= $len) {
549                         $_ .= 'n';
550                         $_ .= <>;
551                         $len = length($_);
552                         $_ = substr($_,0,--$len);
553                     }
554                     elsif (substr($_,$i,1) =~ /^[n]$/) {
555                         ;
556                     }
557                     elsif (!$repl &&
558                       substr($_,$i,1) =~ /^[(){}\w]$/) {
559                         $i--;
560                         $len--;
561                         substr($_, $i, 1) = '';
562                     }
563                     elsif (!$repl &&
564                       substr($_,$i,1) =~ /^[<>]$/) {
565                         substr($_,$i,1) = 'b';
566                     }
567                     elsif ($repl && substr($_,$i,1) =~ /^\d$/) {
568                         substr($_,$i-1,1) = '$';
569                     }
570                 }
571                 elsif ($c eq '&' && $repl) {
572                     substr($_, $i, 0) = '$';
573                     $i++;
574                     $len++;
575                 }
576                 elsif ($c eq '$' && $repl) {
577                     substr($_, $i, 0) = '\\';
578                     $i++;
579                     $len++;
580                 }
581                 elsif ($c eq '[' && !$repl) {
582                     $i++ if substr($_,$i,1) eq '^';
583                     $i++ if substr($_,$i,1) eq ']';
584                     $inbracket = 1;
585                 }
586                 elsif ($c eq ']') {
587                     $inbracket = 0;
588                 }
589                 elsif ($c eq "\t") {
590                     substr($_, $i, 1) = '\\t';
591                     $i++;
592                     $len++;
593                 }
594                 elsif (!$repl && index("()+",$c) >= 0) {
595                     substr($_, $i, 0) = '\\';
596                     $i++;
597                     $len++;
598                 }
599             }
600             &Die("Malformed substitution at line $.\n")
601               unless $end;
602             $pat = substr($_, 0, $repl + 1);
603             $repl = substr($_, $repl+1, $end-$repl-1);
604             $end = substr($_, $end + 1, 1000);
605             &simplify($pat);
606             $dol = '$';
607             $subst = "$pat$repl$delim";
608             $cmd = '';
609             while ($end) {
610                 if ($end =~ s/^g//) {
611                     $subst .= 'g';
612                     next;
613                 }
614                 if ($end =~ s/^p//) {
615                     $cmd .= ' && (print)';
616                     next;
617                 }
618                 if ($end =~ s/^w[ \t]*//) {
619                     $fh = &make_filehandle($end);
620                     $cmd .= " && (print $fh \$_)";
621                     $end = '';
622                     next;
623                 }
624                 &Die("Unrecognized substitution command".
625                   "($end) at line $.\n");
626             }
627             chop ($_ = &q(<<"EOT"));
628 :       <<--#ifdef TSEEN
629 :       $subst && \$tflag++$cmd;
630 :       <<--#else
631 :       $subst$cmd;
632 :       <<--#endif
633 EOT
634             next;
635         }
636
637         if (/^p/) {
638             $_ = 'print;';
639             next;
640         }
641
642         if (/^w/) {
643             s/^w[ \t]*//;
644             $fh = &make_filehandle($_);
645             $_ = "print $fh \$_;";
646             next;
647         }
648
649         if (/^r/) {
650             $appendseen++;
651             s/^r[ \t]*//;
652             $file = $_;
653             $_ = "\$atext .= `cat $file 2>/dev/null`;";
654             next;
655         }
656
657         if (/^P/) {
658             $_ = 'print $1 if /^(.*)/;';
659             next;
660         }
661
662         if (/^D/) {
663             chop($_ = &q(<<'EOT'));
664 :       s/^.*\n?//;
665 :       redo LINE if $_;
666 :       next LINE;
667 EOT
668             $sawnext++;
669             next;
670         }
671
672         if (/^N/) {
673             chop($_ = &q(<<'EOT'));
674 :       $_ .= "\n";
675 :       $len1 = length;
676 :       $_ .= <>;
677 :       chop if $len1 < length;
678 :       <<--#ifdef TSEEN
679 :       $tflag = 0;
680 :       <<--#endif
681 EOT
682             next;
683         }
684
685         if (/^h/) {
686             $_ = '$hold = $_;';
687             next;
688         }
689
690         if (/^H/) {
691             $_ = '$hold .= "\n"; $hold .= $_;';
692             next;
693         }
694
695         if (/^g/) {
696             $_ = '$_ = $hold;';
697             next;
698         }
699
700         if (/^G/) {
701             $_ = '$_ .= "\n"; $_ .= $hold;';
702             next;
703         }
704
705         if (/^x/) {
706             $_ = '($_, $hold) = ($hold, $_);';
707             next;
708         }
709
710         if (/^b$/) {
711             $_ = 'next LINE;';
712             $sawnext++;
713             next;
714         }
715
716         if (/^b/) {
717             s/^b[ \t]*//;
718             $lab = &make_label($_);
719             if ($lab eq $toplabel) {
720                 $_ = 'redo LINE;';
721             } else {
722                 $_ = "goto $lab;";
723             }
724             next;
725         }
726
727         if (/^t$/) {
728             $_ = 'next LINE if $tflag;';
729             $sawnext++;
730             $tseen++;
731             next;
732         }
733
734         if (/^t/) {
735             s/^t[ \t]*//;
736             $lab = &make_label($_);
737             $_ = q/if ($tflag) {$tflag = 0; /;
738             if ($lab eq $toplabel) {
739                 $_ .= 'redo LINE;}';
740             } else {
741                 $_ .= "goto $lab;}";
742             }
743             $tseen++;
744             next;
745         }
746
747         if (/^y/) {
748             s/abcdefghijklmnopqrstuvwxyz/a-z/g;
749             s/ABCDEFGHIJKLMNOPQRSTUVWXYZ/A-Z/g;
750             s/abcdef/a-f/g;
751             s/ABCDEF/A-F/g;
752             s/0123456789/0-9/g;
753             s/01234567/0-7/g;
754             $_ .= ';';
755         }
756
757         if (/^=/) {
758             $_ = 'print $.;';
759             next;
760         }
761
762         if (/^q/) {
763             chop($_ = &q(<<'EOT'));
764 :       close(ARGV);
765 :       @ARGV = ();
766 :       next LINE;
767 EOT
768             $sawnext++;
769             next;
770         }
771     } continue {
772         if ($space) {
773             s/^/$space/;
774             s/(\n)(.)/$1$space$2/g;
775         }
776         last;
777     }
778     $_;
779 }
780
781 sub fetchpat {
782     local($outer) = @_;
783     local($addr) = $outer;
784     local($inbracket);
785     local($prefix,$delim,$ch);
786
787     # Process pattern one potential delimiter at a time.
788
789     DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
790         $prefix = $1;
791         $delim = $2;
792         if ($delim eq '\\') {
793             s/(.)//;
794             $ch = $1;
795             $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
796             $ch = 'b' if $ch =~ /^[<>]$/;
797             $delim .= $ch;
798         }
799         elsif ($delim eq '[') {
800             $inbracket = 1;
801             s/^\^// && ($delim .= '^');
802             s/^]// && ($delim .= ']');
803         }
804         elsif ($delim eq ']') {
805             $inbracket = 0;
806         }
807         elsif ($inbracket || $delim ne $outer) {
808             $delim = '\\' . $delim;
809         }
810         $addr .= $prefix;
811         $addr .= $delim;
812         if ($delim eq $outer && !$inbracket) {
813             last DELIM;
814         }
815     }
816     $addr =~ s/\t/\\t/g;
817     &simplify($addr);
818     $addr;
819 }
820
821 sub q {
822     local($string) = @_;
823     local($*) = 1;
824     $string =~ s/^:\t?//g;
825     $string;
826 }
827
828 sub simplify {
829     $_[0] =~ s/_a-za-z0-9/\\w/ig;
830     $_[0] =~ s/a-z_a-z0-9/\\w/ig;
831     $_[0] =~ s/a-za-z_0-9/\\w/ig;
832     $_[0] =~ s/a-za-z0-9_/\\w/ig;
833     $_[0] =~ s/_0-9a-za-z/\\w/ig;
834     $_[0] =~ s/0-9_a-za-z/\\w/ig;
835     $_[0] =~ s/0-9a-z_a-z/\\w/ig;
836     $_[0] =~ s/0-9a-za-z_/\\w/ig;
837     $_[0] =~ s/\[\\w\]/\\w/g;
838     $_[0] =~ s/\[^\\w\]/\\W/g;
839     $_[0] =~ s/\[0-9\]/\\d/g;
840     $_[0] =~ s/\[^0-9\]/\\D/g;
841     $_[0] =~ s/\\d\\d\*/\\d+/g;
842     $_[0] =~ s/\\D\\D\*/\\D+/g;
843     $_[0] =~ s/\\w\\w\*/\\w+/g;
844     $_[0] =~ s/\\t\\t\*/\\t+/g;
845     $_[0] =~ s/(\[.[^]]*\])\1\*/$1+/g;
846     $_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g;
847 }
848
849 !NO!SUBS!
850
851 close OUT or die "Can't close $file: $!";
852 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
853 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';