Есть ли лучший способ добавить / удалить B из моей строки в Perl?

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 или максимум 9Bs) - в моем исходном коде есть эти условия, но я забыл написать это здесь (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);
}

новая версия, основанная наОтвет Зайда:

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