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;

    }
[download]