Как заменить строку и сохранить ее в верхнем / нижнем регистре

Question

Я хочу заменить одну строку другой в Perl;оба имеют одинаковую длину.Я хочу заменить все вхождения строки (без учета регистра), но я хочу, чтобы регистр буквы был сохранен.Поэтому, если первая буква была в верхнем регистре, первая буква после замены будет также в верхнем регистре.

Например, если я хочу заменить "foo" на "bar", я хочу, чтобы

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

Есть ли простой способ сделать это в Perl?

Answer 1

Это может быть то, что вам нужно:

Как заменить регистр нечувствительно на LHS при сохранении регистра на RHS?

Это скопировано почти напрямуюпо вышеуказанной ссылке:

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 дает некоторые идеи:

Как заменить регистр без учета регистра на LHS при сохранении регистра на RHS?

Вот прекрасное решение Perlish Ларри Рослера. Это эксплуатирует свойства побитового xor в строках ASCII.

$_= "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;

Answer 5

Вот «полу-perlish» решение, которое должно работать для произвольных регулярных выражений и Unicode-данные:

sub adjust_case {
    my ($text, $case) = @_;
    $case .= substr($case, -1) x (length($text) - length($case));
    $_ = [ split // ] for $text, $case;
    return join "", map {
        $case->[$_] =~ /\p{Upper}/ ? uc $text->[$_] :
        $case->[$_] =~ /\p{Lower}/ ? lc $text->[$_] : $text->[$_]
    } 0 .. $#$text;
}

my $regexp  = qr/\b(abc\w*)\b/i;
my $replace = "Xyzzy";

s/$regexp/adjust_case $replace, ${^MATCH}/egp;

Answer 6

Немного хак, используя экспериментальное расширенное регулярное выражение кода:

$text =~ s/\b([Aa])(?{ $n=chr(ord($^N)+23) })bc/${n}yz/

Сначала сопоставьте букву A с ([Aa]).Следующий (?{...}) содержит произвольный код, а $^N содержит текст последней захваченной подгруппы.23 - это разница в кодах ASCII между A и X (для прописных и строчных букв), поэтому $n содержит букву X в том же регистре, что и соответствующий A.

(это не следуетодобрение написания такого кода, но в качестве интересного примера этого экспериментального регулярного выражения.)

Answer 7

Вы можете сделать это:

my %trans = (
    'Abc' => Xyz, 
    'abc' => xyz,
);
$text =~s/\b(Abc|abc)\b/$trans{$1}/ge;

Answer 8

Вы знаете, что каждая строка имеет одинаковую длину, поэтому вы можете:

index = Pos(string, oldString)
for i = index to index + strlen(oldString)
  if (oldString[i] >= 'a') && (oldString[i] <= 'z'')
    string[i] = ToLower(newString[i])
  else
    string[i] = ToUpper(newString[i])0x20

Answer 9

Вот хитрый трюк, который использует неразрушающую транслитерацию (доступно в Perl 5.14) в результате замены.

use 5.014;
$string =~ s/\b(f)(o)(o)\b/ ($1 =~ tr{fF}{bB}r) . ($2 =~ tr{oO}{aA}r) . ($3 =~ tr{oO}{rR}r) /egi;

Вы можете даже сократить его, если последовательные группы букв имеют одинаковые замены, например,

# foo ==> see, FoO ==> SeE, etc.
$string =~ s/\b(foo)\b/ $1 =~ tr{fFoO}{sSeE}r /egi;

Answer 10

Проверьте символ за символом. Если значение ASCII символа попадает в верхний регистр значений ASCII, замените его на верхний регистр, в противном случае строчный.