Regex substitution using a variable replacement string containing backreferences in Perl
This is incredibly hackish and broken code. Input that contains the magic substitution string (ABCD) will lead to incorrect output, and no steps to guard against this were taken. Even worse, the documentation is misleading since it uses double-quoted strings.

If you perform some escape encoding, then you must also escape the escape mechanism whenever it occurs in the input. For example, in single-quoted or q()-style strings, the closing delimiter is a forbidden symbol and must be escaped with a backslash \. However, there must also be a way to escape the backslash itself so that we can express both the strings ' via '\'' and \' via '\\\''. An alternative encoding in languages where two string literals cannot be directly adjacent is to use the delimiter as an escape character. If ' is the delimiter then '' cannot occur naturally except when denoting the empty string, so ' can be encoded as '''' and \' can be encoded as '\'''.

In our case, dollar symbols are forbidden and are escaped by the sequence ABCD, but that sequence itself is not escaped.



Instead of figuring out a proper way to escape this so that you can cobble together a half-solution using successive substitutions, let's take a step back and treat your substitution syntax as a serious language of its own. And languages get a parser. In particular, your language is a concatenation of three elements:


literal parts that consist of anything that's not a backslash or a dollar sign,
escaped characters that must at least contain $ via \$ and \ via \\,
backrefs that are a dollar sign followed by a positive non-zero integer.


The point that backslashes need escaping as well follows directly from the discussion above.

The syntax for backrefs is problematic since there's no way to properly delimit the number. Assume that we want to surround the capture group 1 with the letter a, and we can use the replacement directive 'a$1a', but assume we want to surround it with the digit 4, and '4$14' would parse more sensibly as the digit 4 followed by the backref $14. Perl – following established shell syntax – offers a ${1} syntax for these cases, and we should as well. Your code tries to deal with this problem by looping through all possible backrefs starting with the largest number, but given ten backrefs we wouldn't be able to discern $10 from ${1}0!

Therefore, the backref syntax ought to be a dollar symbol followed by either a sequence of decimal digits not starting with zero or else by such a sequence enclosed in matching curly braces. Clearly specifying it like this allows us to die when there is an unknown backref such as $666 when we only have three matches.

If we want to parse this substitution language in Perl, m/\G.../gc-style parsing is a viable option since the language is regular. The below function takes a replacement string, parses it, and returns a function that given a list of captures returns the fully substituted string.

use Carp;
use Scalar::Util 'reftype';

sub parse_replacement {
  my ($replacement) = @_;
  my @tokens;  # literals are strings, backrefs are refs
  pos($replacement) = 0;
  while (pos($replacement) &lt; length($replacement)) {
    # normal literals
    if ($replacement =~ /\G( [^\$\\]+ )/xgc) {
          # if the previous token was literal, concatenate rather than pushing
          if (@tokens and not defined reftype $tokens[-1]) {
            $tokens[-1] .= $1;
          }
          else {
            push @tokens, $1;
          }
        }
        # escapes
        elsif ($replacement =~ /\G [\\]/xgc) {
          if ($replacement =~ /\G ([\$\\])/xgc) {
            # if the previous token was literal, concatenate rather than pushing
            if (@tokens and not defined reftype $tokens[-1]) {
              $tokens[-1] .= $1;
            }
            else {
              push @tokens, $1;
            }
          }
          elsif ($replacement =~ /\G\z/xgc) {
            croak "Illegal trailing backslash";
          }
          else {
            $replacement =~ /\G (.)/smxgc;
            croak sprintf "Escape can only contain backslash or dollar sign, not U+%4X '%s'", ord $1, $1;
          }
        }
        # backrefs
        elsif ($replacement =~ /\G [\$]/xgc) {
      if ($replacement =~ /\G [{]/xgc) {
        if ($replacement =~ /\G( [1-9][0-9]* )/xgc) {
          my $n = $1;
          push @tokens, \($n - 1);
          if ($replacement =~ /\G [}]/xgc) {
            # all is OK
          }
          else {
            croak "Expected closing curly brace for \${$n} identifier";
          }
        }
        else {
          croak 'Expected ${123} style numeric identifier inside ${...}';
        } 
      }
      elsif ($replacement =~ /\G( [1-9][0-9]* )/xgc) {
        my $n = $1;
        push @tokens, \($n - 1);
      }
      else {
        croak 'Expected $123 or ${123} style number after dollar sign';
      }
    }
    else {
      croak sprintf "Illegal state – expected literal, escape or backref at position %d", pos($replacement);
    }
  }

  return sub {
    my ($captures) = @_;
    my $buffer = '';
    for my $token (@tokens) {
      if (reftype $token) {
        my $i = $$token;
            if ($i &lt; @$captures) {
              $buffer .= $captures-&gt;[$i];
            }
            else {
              croak sprintf 'Unknown backref $%d; there are only %d captures', $$token, 0+@$captures;
        }
      }
      else {
        $buffer .= $token;
      }
    }
    return $buffer;
  };
}


Note that this code handles any eventuality and is therefore clearly correct and tries to provide meaningful error messages. It could further be improved by including the exact position and context in the error message.



There are various other problems with your code – I immediately see minor stylistic problems and another large-scale logical problem – but I'll leave those to another answer to tackle.

Your development would benefit from using a stringent set of test cases that handles edge cases and deliberately difficult inputs in order to find out whether your code actually matches your implementation. The Test::More module is an excellent place to start testing with Perl.