有没有更好的方法在 Perl 中添加/删除字符串中的“B”？

Question

有很多行文本，

有些行具有以下模式 /^aaa(B+)(.*)/

• 以“aaa”开头，
• 后跟多个“B”（1 到 9），
• 其余部分该行

需要构造一个函数，得到什么：

• 标量中的文本，以及
• 移位参数如何移位 B 的数量，

例如：

change_ab(2,$text)  # and the function will add 2 B
change_ab(-1, $text) #the function will remove one B

编辑：添加了一些示例 - （结果中需要有最小 1B 或最大 9B ） - 在我的源代码是这些条件，但我忘了在这里写（sry））

 shifting   from     result
    2       aaaB     aaaBBB
    3       aaaBB    aaaBBBBB
   -2       aaaBBBB  aaaBB
   -3       aaaBB    aaaB          #min.1
    9       aaaBBBB  aaaBBBBBBBBB  #max.9    

我的解决方案是将标量文本分割成行。不是很优雅。 :(

存在一些更好/更快的解决方案 - 就像一个大的正则表达式而不需要拆分？

这是我的代码：

use 5.014;
use warnings;

my $mytext = "some text
aaaB some another text
text3 here
aaaBB some text4
another textxxx
aaaBBBBXX some text4
another textzzzz
";

say change_ab(-1,$mytext);

sub change_ab {
    my($bshift, $text) = @_;

    my $out = "";
    foreach my $line ( split(/[\r\n]/, $text) ) {
        if( $line =~ /^aaa(B+)(.*)/) {
            my $bcnt = length($1);    
            my $wantedBcnt = $bcnt + $bshift;
            $wantedBcnt = 1 if $wantedBcnt < 1;
            $wantedBcnt = 9 if $wantedBcnt > 9;
            my $wantedBstr = sprintf("aaa%s", "B" x $wantedBcnt);

            $line =~ s/^aaaB+/$wantedBstr/;
        }
        $out .= $line . "\n";
    }
    return($out);
}

基于 Zaid 答案的新版本：

use 5.014;
use warnings;

my $mytext = "some text
aaaB some another text
text3 here
aaaBB some text4
another textxxx
aaaBBBBXX some text4
another textzzzz
";

say change_ab(8, $mytext);

sub change_ab {
    $_[1] =~ s{(?<=^aaa)(B+)}{ 'B' x fixshift(length($1)+$_[0]) }gem;
    return $_[1];
}

sub fixshift {
    return 9 if $_[0] > 9;
    return 1 if $_[0] < 1;
    return $_[0];
}

Ps：如果有人可以给出更好的问题标题 - 请更改它。

Answer 1

让 /e 修饰符为您完成繁重的工作：

$mytext =~ s{(?<=^aaa)([bB]+)}{ 'B' x (length($1) + $b_shift) }gem;

---

如果 $b_shift 预计会发生变化，请将操作包装在单个子中：

sub change_ab {

    my $b_shift = +shift ;   # $_[0] = b_shift,  $_[1] = text

                             # After shift, $_[0] is text

    $_[0] =~ s{(?<=^aaa)([bB]+)}{ 'B' x (length($1) + $b_shift) }gem;

    return $_[0];  # Explicit return avoids scalar context interpolation
}

Usage

my $mytext = 
"some text
aaaB some another text
text3 here
aaaBB some text4
another textxxx
aaaBBBBXX some text4
another textzzzz
";

change_ab ( -1, $mytext );  

print $mytext;

Output

some text
aaa some another text
text3 here
aaaB some text4
another textxxx
aaaBBBXX some text4
another textzzzz

Answer 2

这也应该可以完成这项工作：

#!/usr/bin/perl

use strict;
use warnings;
use 5.10.1;

sub change_ab {
   my ($shift, $string) = @_;

   while ($string =~ m/[^#](aaaB+)/m) {
      my $numB = length($1)-3; # account for 'aaa' by '-3'

      # if the new number of 'B's would be negative, just keep
      # the old number; 0 'B's is allowed though (otherwise change
      # '>= 0' to '> 0')
      my $new_numB = ($numB + $shift >= 0) ? $numB + $shift : $numB;

      # add '#' to mark this instance of aaaB+ as modified already
      my $replacement = sprintf "#aaa%s", 'B' x $new_numB;

      # replace the FIRST non-modified instance of aaaB+, i.e. the
      # one we've just been working on
      $string =~ s/(?<=[^#])aaaB+/$replacement/;
   }

   $string =~ s/#(aaaB*)/$1/g; # remove the '#' markers
   return $string;
}

my $mytext = "some text
aaaB some another text
text3 here
aaaBB some text4
another textxxx
aaaBBBBXX some text4
another textzzzz
";

say change_ab(-1, $mytext);

当您删除一个“B”时，如上面的代码所示，输出如下：

some text
aaa some another text
text3 here
aaaB some text4
another textxxx
aaaBBBXX some text4
another textzzzz