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