It's hard to tell just what your requirements are from the posted code and of course there's no test set (please see How to ask better questions using Test::More and sample data), but here's a regex-based attempt. More degenerate and edge/corner-case test cases are needed.
File replace_1.pl:
use 5.010; # needs // (defined-or), \K regex extension
use strict;
use warnings;
use Test::More 'no_plan';
use Test::NoWarnings;
use Data::Dump qw(dd); # for debug
my @Tests = (
'replace ALL instances of search string (left-to-right)',
[ 'ABC ABC CBA ACB CAB BAC CAB CAB CARAB CACBA AXCK',
' A', '-@', undef,
'ABC-@BC CBA-@CB CAB BAC CAB CAB CARAB CACBA-@XCK',
'unlimited replacements',
],
[ 'ABABA', 'A', 'xx', undef, 'xxBxxBxx', 'unlimited replacements', ]
+,
[ 'ABC ABC CBA ACB CAB BAC CAB CAB CARAB CACBA AXCK',
' A', '-@', 3,
'ABC-@BC CBA-@CB CAB BAC CAB CAB CARAB CACBA-@XCK',
],
[ 'ABABA', 'A', 'xx', 3, 'xxBxxBxx', 'unlimited replacements', ],
[ 'ABC ABC CBA ACB CAB BAC CAB CAB CARAB CACBA AXCK',
' A', '-@', 4,
'ABC-@BC CBA-@CB CAB BAC CAB CAB CARAB CACBA-@XCK',
],
[ 'ABABA', 'A', 'xx', 4, 'xxBxxBxx', 'unlimited replacements', ],
[ 'ABC ABC CBA ACB CAB BAC CAB CAB CARAB CACBA AXCK',
' A', '-@', 99,
'ABC-@BC CBA-@CB CAB BAC CAB CAB CARAB CACBA-@XCK',
],
[ 'ABABA', 'A', 'xx', 99, 'xxBxxBxx', 'unlimited replacements', ],
'replace ALL instances of search string (right-to-left)',
[ 'ABC ABC CBA ACB CAB BAC CAB CAB CARAB CACBA AXCK',
' A', '-@', -3,
'ABC-@BC CBA-@CB CAB BAC CAB CAB CARAB CACBA-@XCK',
],
[ 'ABABA', 'A', 'xx', -3, 'xxBxxBxx', 'unlimited replacements', ],
[ 'ABC ABC CBA ACB CAB BAC CAB CAB CARAB CACBA AXCK',
' A', '-@', -4,
'ABC-@BC CBA-@CB CAB BAC CAB CAB CARAB CACBA-@XCK',
],
[ 'ABABA', 'A', 'xx', -4, 'xxBxxBxx', 'unlimited replacements', ],
[ 'ABC ABC CBA ACB CAB BAC CAB CAB CARAB CACBA AXCK',
' A', '-@', -99,
'ABC-@BC CBA-@CB CAB BAC CAB CAB CARAB CACBA-@XCK',
],
[ 'ABABA', 'A', 'xx', -99, 'xxBxxBxx', 'unlimited replacements', ],
'replace N instances of search string (left-to-right)',
[ 'ABC ABC CBA ACB CAB BAC CAB CAB CARAB CACBA AXCK',
' A', '-@', 0,
'ABC ABC CBA ACB CAB BAC CAB CAB CARAB CACBA AXCK',
],
[ 'ABABA', 'A', 'xx', 0, 'ABABA', ],
[ 'ABC ABC CBA ACB CAB BAC CAB CAB CARAB CACBA AXCK',
' A', '-@', 1,
'ABC-@BC CBA ACB CAB BAC CAB CAB CARAB CACBA AXCK',
],
[ 'ABABA', 'A', 'xx', 1, 'xxBABA', ],
[ 'ABC ABC CBA ACB CAB BAC CAB CAB CARAB CACBA AXCK',
' A', '-@', 2,
'ABC-@BC CBA-@CB CAB BAC CAB CAB CARAB CACBA AXCK',
],
[ 'ABABA', 'A', 'xx', 2, 'xxBxxBA', ],
'replace N instances of search string (right-to-left)',
[ 'ABC ABC CBA ACB CAB BAC CAB CAB CARAB CACBA AXCK',
' A', '-@', -1,
'ABC ABC CBA ACB CAB BAC CAB CAB CARAB CACBA-@XCK',
'1 right-most replacement',
],
[ 'ABABA', 'A', 'xx', -1, 'ABABxx', '1 right-most replacement', ],
[ 'ABC ABC CBA ACB CAB BAC CAB CAB CARAB CACBA AXCK',
' A', '-@', -2,
'ABC ABC CBA-@CB CAB BAC CAB CAB CARAB CACBA-@XCK',
'2 right-most replacements',
],
[ 'ABABA', 'A', 'xx', -2, 'ABxxBxx', '2 right-most replacements', ],
); # end @Tests
VECTOR:
for my $ar_vector (@Tests) {
if (not ref $ar_vector) {
note $ar_vector;
next VECTOR;
}
my ($str, $srch, $repl, $n, $expect, $cmnt) = @$ar_vector;
my $n_cmnt = $n // 'max';
my $comment = "'$srch' -> '$repl' $n_cmnt times";
$comment .= " ($cmnt)" if defined $cmnt;
is Replace($str, $srch, $repl, $n), $expect, $comment;
} # end for VECTOR
done_testing;
exit;
# subroutines ################################################
sub Replace {
# dd '===', \@_, '==='; # for debug
my ($string, # string to search/replace
$srch, # search string (no regex metacharacters)
$repl, # optional: replacement string (default: '')
$n, # optional: number of replacements (default: infinit
+e)
) = @_;
# handle degenerate cases.
return '' unless defined $string;
return $string unless defined $srch;
# default replacement string: empty string.
$repl //= '';
# replace left-to-right if n is not defined or >= 0.
my $replace_left_to_right = ! defined($n) || $n >= 0;
# make replacement count positive unless undefined/infinite.
$n = defined $n ? abs($n) : -1;
# escape all regex metacharacters in search substring.
$srch = quotemeta $srch;
# dd '===', [ $string, $srch, $repl, $n, ], '==='; # for debug
# regex pattern matches if a search string is not present.
my $rx_not_srch = qr{ (?! $srch) . }xms;
my $rx_srch = $replace_left_to_right
# replace search string n times from left.
? qr{ $rx_not_srch* \K $srch }xms
# replace search string n times from right.
: qr{ (?: $rx_not_srch* $srch)* $rx_not_srch* \K $srch }xms
;
# dd '===', $rx_srch, $n, '==='; # for debug
# n > 0: replace if replacement possible.
1 while $n-- && $string =~ s{ \G $rx_srch }{$repl}xms;
return $string;
}
works with all the test cases posted above and a few more I've added since posting. (And