如何替换字符串并保留其大写/小写

Question

我想在Perl中用另一个字符串替换一个字符串; 两者的长度相同.我想替换所有出现的字符串(不区分大小写),但我希望保留字母的大小写.因此,如果第一个字母是大写字母,则替换后的第一个字母也是大写字母.

例如,如果我想用"bar"替换"foo",那么我想要那样

foo ==> bar
Foo ==> Bar
FOO ==> BAR

在Perl中有一个简单的方法吗？

Answer 1

这可能就是你所追求的:

在保留RHS案例的同时,如何在LHS上不区分大小写？

这几乎是直接从上面的链接复制的:

sub preserve_case($$) {
    my ($old, $new) = @_;
    my $mask = uc $old ^ $old;
    uc $new | $mask .
    substr($mask, -1) x (length($new) - length($old))
}

my $string;

$string = "this is a Foo case";
$string =~ s/(Foo)/preserve_case($1, "bar")/egi;
print "$string\n";

# this is a Bar case

$string = "this is a foo case";
$string =~ s/(Foo)/preserve_case($1, "bar")/egi;
print "$string\n";

# this is a bar case

$string = "this is a FOO case";
$string =~ s/(Foo)/preserve_case($1, "bar")/egi;
print "$string\n";

# this is a BAR case

Answer 2

perldoc perlfaq6 提供一些见解:

在保留RHS案例的同时,如何在LHS上不区分大小写？

这是Larry Rosler的一个可爱的Perlish解决方案.它利用xorASCII字符串的按位属性.

$_= "this is a TEsT case";
$old = 'test';
$new = 'success';
s{(\Q$old\E)}
    { uc $new | (uc $1 ^ $1) .
            (uc(substr $1, -1) ^ substr $1, -1) x
            (length($new) - length $1)
    }egi;
print;    # 'this is a SUcCESS case'

在这里它是一个子程序,模仿以上:

sub preserve_case {
        my ($old, $new) = @_;
        my $mask = uc $old ^ $old;
        uc $new | $mask .
            substr($mask, -1) x (length($new) - length($old))
    }

$string = "this is a TEsT case";
$string =~ s/(test)/preserve_case($1, "success")/egi;
print "$string\n";

这打印:

this is a SUcCESS case

所以你可以preserve_case()像这样使用子程序.只是不要指望Unicode奇迹:)

s[\b(abc)\b][preserve_case($1,'xyz')]ei ;

Answer 3

$text =~ s/\b(?:(Abc)|abc)\b/ $1 ? 'Xyz' : 'xyz' /eg;

如果实际列表较长,则可以使用查找表.

my %translations = (
   'Abc' => 'Xyz',  'abc' => 'xyz',
   'Def' => 'Ghi',  'def' => 'ghi',
   'Jkl' => 'Mno',  'jkl' => 'mno',
);

my $alt_pat = join '|', map quotemeta, keys(%translations);

$text =~ s/\b($alt_pat)\b/$translations{$1}/g;

但是,这仍然会留下一些重复,可以通过派生小写版本来删除.

my %translations = (
   'Abc' => 'Xyz',
   'Def' => 'Ghi',
   'Jkl' => 'Mno',
);

%translations = ( ( map lc, %translations ), %translations );

my $alt_pat = join '|', map quotemeta, keys(%translations);

$text =~ s/\b($alt_pat)\b/$translations{$1}/g;

Answer 4

这是一个解决方案,它将"将一个字符串与另一个字符串的大小写相匹配"的想法纳入一个函数,并调用该函数来构建替换.

sub matchcap
{
  my ($s,$r) = @_;
  return $s eq ucfirst($s) ? ucfirst($r) : lcfirst($r);
}

s/\b(Abc|abc)\b/matchcap($1,'xyz')/ge;