Question

Have many lines of text

some lines has the following pattern /^aaa(B+)(.*)/

• start with “aaa”
• followed by a number of “B” (1 up to 9)
• remainder of the line

need construct a function what get:

• the text in a scalar, and
• the shifting parameter how to shift the number of Bs

for example:

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

EDIT: added some examples – (in the result need to have min 1B or max 9Bs) – in my source code are these conditions, but i forgot write it here (sry))

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

my solution is splitting the scalar text into lines. Not very elegant. 🙁

Exists some better/faster solution – like one big regex without the need of splitting?

Here is my code:

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);
}

the new version based on Zaid’s answer:

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: if someone can give a better question title – pls. change it.

Answer 1

Let the /e modifier do the heavy-lifting for you:

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

---

If $b_shift is expected to vary, wrap the operation in a single sub:

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