2
\$\begingroup\$

I have written a program where the user inputs a regular expression and a replacement string, and the program will search through a set of files and do the replacements.

The user is allowed to use backreferences in the replacement string (to refer to capture groups in the regex). The part of the program I would like you to consider is the sub routine substitute_regex_backref below that searches a input string (for example the contents of a file) and does the replacements:

#! /usr/bin/env perl

use feature qw(say);
use strict;
use warnings;

my $old_str = '$1B<$ <hello> $> aba B<$ <kk> $>$1';
my $str = $old_str;
my $regex = qr'B<\$ <(.*?)> \$>';
my $replace = 'I<\$1$1\$1>';

(my $cnt, $str) = substitute_regex_backref( $str, $regex, $replace );

say "Old string: '$old_str'";
say "Number of replacements: $cnt";
say "New string: '$str'";

exit;

#
#
# ($num_substitutions, $new_str) =
#     substitute_regex_backref( $str, $regex, $replace )
#
#
# This sub routine is based on a stackoverflow.com answer
# by username Kent Fredric, see http://stackoverflow.com/a/392649/2173773
#
# Replace all occurences of $regex in $str with $replace.
# Returns number of replacements and the new string.
#
# The $regex input is assumed to be a regex quoted string. For example:
#  my $regex = qr/A simple (\w+) example/;
#
# The replacement string $replace is allowed to have backreferences:
#   Example: $replace = "a $1 b"
# "$1" is here treated as a backreference. It corresponds to capture group number 1
# in the $regex string.
#
# The replacement string $replace can also have backslash escaped dollar signs,
#  Example:  $replace = "\$1 a $1 b" 
# Such escaped dollar signs should be replaced by
#  a literal '$' (and not treated as a backreference) 

# Note: This subroutine was written to avoid using the ee modifier technique:
#   $var =~ s/$find/$replace/ee;
# which has sequrity risks if the $replace string comes from user input.
#
sub substitute_regex_backref {
    my ( $str, $regex, $replace ) = @_;

    # First obtain an array @m of matches
    my @m = $str =~ /$regex/g;
    if (@m == 0) {
        return (0, $str);
    }
    my $special_character_seq = "\x41\x42\x43\x44";

    # Remove any dollar signs from $str
    $str =~ s/\$/$special_character_seq/g;

    # If $regex contain escaped dollar signs (to be treated as
    # literal dollar signs), we need to replace
    # them with $special_character_seq since we have removed all
    # dollar signs in the previous line
    $regex =~ s/\\\$/$special_character_seq/g;

    # Do the replacement, but dollar signs in the $replace variable
    # are left as literal dollar signs 
    $str =~ s/$regex/$replace/g;

    # Replace backslash escaped dollar signs with special string
    $str =~ s/\\\$/$special_character_seq/g;

    # use "reverse" function to cope with mixed one- and two-digit back references
    # For example, $12 should be dealt with before $1, in order to avoid confusion.
    for( reverse 0 .. $#m ){ 
        my $n = $_ + 1;
        my $val = $m[$_];

        # Replace "$n" with the value of capture group
        $str =~ s/\$$n/$val/g;
        }
        # Reinsert all literal dollar signs:
        $str =~ s/$special_character_seq/\$/g ;
    return (@m + 0, $str); 
}

Any comments and suggestions are appreciated. I am especially concerned with the use of the $special_character_seq variable, if it is necessary or how to avoid using it..

\$\endgroup\$

1 Answer 1

1
\$\begingroup\$

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) < 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 < @$captures) {
              $buffer .= $captures->[$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.

\$\endgroup\$
9
  • \$\begingroup\$ Thanks @ammon for this great review! To get an understanding of how this works, I started by running some simple tests, see pastebin.com/N784ru1g . I wonder, why do test #2 fail here? \$\endgroup\$ Mar 15, 2015 at 7:04
  • \$\begingroup\$ I modified the test logic a little bit: pastebin.com/w6bEw0pp , now it passes all tests! \$\endgroup\$ Mar 15, 2015 at 8:37
  • \$\begingroup\$ Here is an updated script: pastebin.com/uQzfspxF .. I found that I had to first make a copy the string, and do search in one copy, and replacements in the other. This, in order to not mix up the pos after doing replacements.. \$\endgroup\$ Mar 15, 2015 at 11:21
  • 1
    \$\begingroup\$ @HåkonHægland The backslash always takes a reference – in that case, to the result of the $n - 1 expression. The target of a reference need not be writable, and here I'm using the ref just to denote the meta-information that it's not a literal but a backref. I use an anon sub to make the replacement string implementation self-contained and encapsulated; otherwise we would leak the implementation detail of @tokens and would also require the user of that sub to remember to pass the correct argument. That's too many things that can go wrong; this code tries to be correct by design. \$\endgroup\$
    – amon
    Mar 15, 2015 at 12:25
  • 1
    \$\begingroup\$ @HåkonHægland Yes, that branch is unreachable, since the next character must either be a backslash, a dollar sign, or any other character, and there is no fourth possibility. However, it's often a good idea to error on cases even when we think they cannot occur. For example, I made a typo and used the charclass [\$\\] in the first case, i.e. I forgot the negation [^…]. When I took the code for a small test run, I was greeted by that error, which allowed me to locate the problem within a few seconds rather than wondering why the code went into an infinite loop. \$\endgroup\$
    – amon
    Mar 15, 2015 at 15:42

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.