This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
2f617e73817f6c5a5b5ddb6117e6176e1de70ece
[perl5.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 '&' && $repl) {
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                     $i++ if substr($_,$i,1) eq '^';
567                     $i++ if substr($_,$i,1) eq ']';
568                     $inbracket = 1;
569                 }
570                 elsif ($c eq ']') {
571                     $inbracket = 0;
572                 }
573                 elsif ($c eq "\t") {
574                     substr($_, $i, 1) = '\\t';
575                     $i++;
576                     $len++;
577                 }
578                 elsif (!$repl && index("()+",$c) >= 0) {
579                     substr($_, $i, 0) = '\\';
580                     $i++;
581                     $len++;
582                 }
583             }
584             &Die("Malformed substitution at line $.\n")
585               unless $end;
586             $pat = substr($_, 0, $repl + 1);
587             $repl = substr($_, $repl+1, $end-$repl-1);
588             $end = substr($_, $end + 1, 1000);
589             &simplify($pat);
590             $subst = "$pat$repl$delim";
591             $cmd = '';
592             while ($end) {
593                 if ($end =~ s/^g//) {
594                     $subst .= 'g';
595                     next;
596                 }
597                 if ($end =~ s/^p//) {
598                     $cmd .= ' && (print)';
599                     next;
600                 }
601                 if ($end =~ s/^w[ \t]*//) {
602                     $fh = &make_filehandle($end);
603                     $cmd .= " && (print $fh \$_)";
604                     $end = '';
605                     next;
606                 }
607                 &Die("Unrecognized substitution command".
608                   "($end) at line $.\n");
609             }
610             chop ($_ = &q(<<"EOT"));
611 :       <<--#ifdef TSEEN
612 :       $subst && \$tflag++$cmd;
613 :       <<--#else
614 :       $subst$cmd;
615 :       <<--#endif
616 EOT
617             next;
618         }
619
620         if (/^p/) {
621             $_ = 'print;';
622             next;
623         }
624
625         if (/^w/) {
626             s/^w[ \t]*//;
627             $fh = &make_filehandle($_);
628             $_ = "print $fh \$_;";
629             next;
630         }
631
632         if (/^r/) {
633             $appendseen++;
634             s/^r[ \t]*//;
635             $file = $_;
636             $_ = "\$atext .= `cat $file 2>/dev/null`;";
637             next;
638         }
639
640         if (/^P/) {
641             $_ = 'print $1 if /^(.*)/;';
642             next;
643         }
644
645         if (/^D/) {
646             chop($_ = &q(<<'EOT'));
647 :       s/^.*\n?//;
648 :       redo LINE if $_;
649 :       next LINE;
650 EOT
651             $sawnext++;
652             next;
653         }
654
655         if (/^N/) {
656             chop($_ = &q(<<'EOT'));
657 :       $_ .= "\n";
658 :       $len1 = length;
659 :       $_ .= <>;
660 :       chop if $len1 < length;
661 :       <<--#ifdef TSEEN
662 :       $tflag = 0;
663 :       <<--#endif
664 EOT
665             next;
666         }
667
668         if (/^h/) {
669             $_ = '$hold = $_;';
670             next;
671         }
672
673         if (/^H/) {
674             $_ = '$hold .= "\n", $hold .= $_;';
675             next;
676         }
677
678         if (/^g/) {
679             $_ = '$_ = $hold;';
680             next;
681         }
682
683         if (/^G/) {
684             $_ = '$_ .= "\n", $_ .= $hold;';
685             next;
686         }
687
688         if (/^x/) {
689             $_ = '($_, $hold) = ($hold, $_);';
690             next;
691         }
692
693         if (/^b$/) {
694             $_ = 'next LINE;';
695             $sawnext++;
696             next;
697         }
698
699         if (/^b/) {
700             s/^b[ \t]*//;
701             $lab = &make_label($_);
702             if ($lab eq $toplabel) {
703                 $_ = 'redo LINE;';
704             } else {
705                 $_ = "goto $lab;";
706             }
707             next;
708         }
709
710         if (/^t$/) {
711             $_ = 'next LINE if $tflag;';
712             $sawnext++;
713             $tseen++;
714             next;
715         }
716
717         if (/^t/) {
718             s/^t[ \t]*//;
719             $lab = &make_label($_);
720             $_ = q/if ($tflag) {$tflag = 0; /;
721             if ($lab eq $toplabel) {
722                 $_ .= 'redo LINE;}';
723             } else {
724                 $_ .= "goto $lab;}";
725             }
726             $tseen++;
727             next;
728         }
729
730         if (/^y/) {
731             s/abcdefghijklmnopqrstuvwxyz/a-z/g;
732             s/ABCDEFGHIJKLMNOPQRSTUVWXYZ/A-Z/g;
733             s/abcdef/a-f/g;
734             s/ABCDEF/A-F/g;
735             s/0123456789/0-9/g;
736             s/01234567/0-7/g;
737             $_ .= ';';
738         }
739
740         if (/^=/) {
741             $_ = 'print $.;';
742             next;
743         }
744
745         if (/^q/) {
746             chop($_ = &q(<<'EOT'));
747 :       close(ARGV);
748 :       @ARGV = ();
749 :       next LINE;
750 EOT
751             $sawnext++;
752             next;
753         }
754     } continue {
755         if ($space) {
756             s/^/$space/;
757             s/(\n)(.)/$1$space$2/g;
758         }
759         last;
760     }
761     $_;
762 }
763
764 sub fetchpat {
765     local($outer) = @_;
766     local($addr) = $outer;
767     local($inbracket);
768     local($prefix,$delim,$ch);
769
770     # Process pattern one potential delimiter at a time.
771
772     DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
773         $prefix = $1;
774         $delim = $2;
775         if ($delim eq '\\') {
776             s/(.)//;
777             $ch = $1;
778             $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
779             $ch = 'b' if $ch =~ /^[<>]$/;
780             $delim .= $ch;
781         }
782         elsif ($delim eq '[') {
783             $inbracket = 1;
784             s/^\^// && ($delim .= '^');
785             s/^]// && ($delim .= ']');
786         }
787         elsif ($delim eq ']') {
788             $inbracket = 0;
789         }
790         elsif ($inbracket || $delim ne $outer) {
791             $delim = '\\' . $delim;
792         }
793         $addr .= $prefix;
794         $addr .= $delim;
795         if ($delim eq $outer && !$inbracket) {
796             last DELIM;
797         }
798     }
799     $addr =~ s/\t/\\t/g;
800     &simplify($addr);
801     $addr;
802 }
803
804 sub q {
805     local($string) = @_;
806     local($*) = 1;
807     $string =~ s/^:\t?//g;
808     $string;
809 }
810
811 sub simplify {
812     $_[0] =~ s/_a-za-z0-9/\\w/ig;
813     $_[0] =~ s/a-z_a-z0-9/\\w/ig;
814     $_[0] =~ s/a-za-z_0-9/\\w/ig;
815     $_[0] =~ s/a-za-z0-9_/\\w/ig;
816     $_[0] =~ s/_0-9a-za-z/\\w/ig;
817     $_[0] =~ s/0-9_a-za-z/\\w/ig;
818     $_[0] =~ s/0-9a-z_a-z/\\w/ig;
819     $_[0] =~ s/0-9a-za-z_/\\w/ig;
820     $_[0] =~ s/\[\\w\]/\\w/g;
821     $_[0] =~ s/\[^\\w\]/\\W/g;
822     $_[0] =~ s/\[0-9\]/\\d/g;
823     $_[0] =~ s/\[^0-9\]/\\D/g;
824     $_[0] =~ s/\\d\\d\*/\\d+/g;
825     $_[0] =~ s/\\D\\D\*/\\D+/g;
826     $_[0] =~ s/\\w\\w\*/\\w+/g;
827     $_[0] =~ s/\\t\\t\*/\\t+/g;
828     $_[0] =~ s/(\[.[^]]*\])\1\*/$1+/g;
829     $_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g;
830 }
831
832 sub skip {
833     local($level) = 0;
834
835     while(<BODY>) {
836         /^#ifdef/ && $level++;
837         /^#else/  && !$level && return;
838         /^#endif/ && !$level-- && return;
839     }
840
841     die "Unterminated `#ifdef' conditional\n";
842 }
843 !NO!SUBS!
844
845 close OUT or die "Can't close $file: $!";
846 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
847 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
848 chdir $origdir;