Question

有多行文字

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

以“aaa”开头
后跟一些“B”（1到9）
该行的剩余部分

需要构建一个得到的函数：

标量中的文字和
移位参数如何移动Bs的数量

例如：

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
}

用法

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;

输出

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

有没有更好的方法来添加/删除Perl中我的字符串中的'B'？

2 个答案:

用法

输出