: die "Couldn't link $from to $to: $!\n";
};
if ($@) {
- warn $@;
require File::Copy;
File::Copy::copy($from, $to)
? $success++
# (p)sed - a stream editor
# History: Aug 12 2000: Original version.
# Mar 25 2002: Rearrange generated Perl program.
+# Jul 23 2007: Fix bug in regex stripping (M.Thorland)
use strict;
use integer;
my $doAutoPrint = 1; # automatic printing of pattern space (-n => 0)
my $doOpenWrite = 1; # open w command output files at start (-a => 0)
my $svOpenWrite = 0; # save $doOpenWrite
-my $doGenerate = $0 eq 's2p';
+
+# lower case $0 below as a VMSism. The VMS build procedure creates the
+# s2p file traditionally in upper case on the disk. When VMS is in a
+# case preserved or case sensitive mode, $0 will be returned in the exact
+# case which will be on the disk, and that is not predictable at this time.
+
+my $doGenerate = lc($0) eq 's2p';
# Collected and compiled script
#
0;
}
-
-sub stripRegex($$){
- my( $del, $sref ) = @_;
+# stripRegex from the current command. If we're in the first
+# part of s///, trailing spaces have to be kept as the initial
+# part of the replacement string.
+#
+sub stripRegex($$;$){
+ my( $del, $sref, $sub ) = @_;
my $regex = $del;
print "stripRegex:$del:$$sref:\n" if $useDEBUG;
while( $$sref =~ s{^(.*?)(\\*)\Q$del\E(\s*)}{}s ){
my $sl = $2;
$regex .= $1.$sl.$del;
if( length( $sl ) % 2 == 0 ){
+ if( $sub && (length( $3 ) > 0) ){
+ $$sref = $3 . $$sref;
+ }
return $regex;
}
$regex .= $3;
my $fc = substr($fr,$i,1);
my $tc = substr($to,$i,1);
if( exists( $tr{$fc} ) && $tr{$fc} ne $tc ){
- Warn( "ambiguos translation for character `$fc' in `y' command",
+ Warn( "ambiguous translation for character `$fc' in `y' command",
$fl );
$error++;
}
}
if( $cmd =~ s{^([^\\\n])}{} ){
my $del = $1;
- my $regex = stripRegex( $del, \$cmd );
+ my $regex = stripRegex( $del, \$cmd, "s" );
if( ! defined( $regex ) ){
Warn( "malformed regular expression", $fl );
$error++;
=over 4
-=item ambiguos translation for character `%s' in `y' command
+=item ambiguous translation for character `%s' in `y' command
The indicated character appears twice, with different translations.
=item string lengths in `y' command differ
-The translation table strings in a B<y> commanf must have equal lengths.
+The translation table strings in a B<y> command must have equal lengths.
=item undefined label `%s'
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
unlink 'psed';
-print "Linking s2p to psed.\n";
+print "Linking $file to psed.\n";
if (defined $Config{d_link}) {
- link 's2p', 'psed';
+ link $file, 'psed';
} else {
unshift @INC, '../lib';
require File::Copy;