Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Re: Evaluating user-entered captured groups during Perl substitution

by jo37 (Deacon)
on Mar 16, 2020 at 07:37 UTC ( [id://11114327]=note: print w/replies, xml ) Need Help??


in reply to [SOLVED] Evaluating user-entered captured groups during Perl substitution

Some quotes were wrong - use warnings would have told you. And an eval was in the wrong place.

EDIT: I shouldn't have posted this in a hurry. Sorry, this does not work.

At least for the given example this works:

#!/usr/bin/perl use strict; use warnings; #FROM DATABASE TEXT my $line = "Her house is on 34th Mt. Whitney St. near St. Mt. Helens S +t."; #FROM INCOMING FORM INPUTS my $query = '(St\.\s)(Mt\.\s)(?=Helens)'; my $substitution = 'Mount ${1}'; # USER MAY HAVE ENTERED "$1" #FOR RETURNED HTML HIGHLIGHT OF CHANGES my $start = q|<span class="highlight">|; my $end = "</span>"; return "Regex containing code disallowed." if $query =~ m[\(\?\??\{]; return "Regex containing code disallowed." if $substitution =~ m[\(\?\ +??\{]; my $replace = sub { my $evaluate = sub { return eval($1); }; my $val = $substitution; $val =~ s/(\$\{\d+\})/$evaluate->()/eg; $val = "$start$val$end"; return $val; }; eval "\$line =~ s/\$query/$replace->()/eg"; #EXPECTED TEXT AFTER SUBSTITUTION $line = "Her house is on 34th Mt. Whitney St. near Mount St. Helens St +.";

Greetings,
-jo

$gryYup$d0ylprbpriprrYpkJl2xyl~rzg??P~5lp2hyl0p$

Replies are listed 'Best First'.
Re^2: Evaluating user-entered captured groups during Perl substitution
by jo37 (Deacon) on Mar 16, 2020 at 18:11 UTC

    Replying to myself, here is a corrected and simplified version:

    #!/usr/bin/perl use Test2::V0; #FROM DATABASE TEXT my $line = "Her house is on 34th Mt. Whitney St. near St. Mt. Helens S +t."; #FROM INCOMING FORM INPUTS my $query = qr'(St\.\s)(Mt\.\s)(?=Helens)'; my $substitution = 'Mount ${1}'; # USER MAY HAVE ENTERED "$1" #FOR RETURNED HTML HIGHLIGHT OF CHANGES my $start = '<span class="highlight">'; my $end = '</span>'; my $replace = $start . $substitution . $end; eval "\$line =~ s{\$query}{$replace}g;"; die $@ if $@; is $line, 'Her house is on 34th Mt. Whitney St. near <span class="high +light">Mount St. </span>Helens St.', 'pattern substitution'; done_testing;

    Greetings,
    -jo

    $gryYup$d0ylprbpriprrYpkJl2xyl~rzg??P~5lp2hyl0p$

      Wow! This works!

      I actually tried "correcting" what you had there, thinking you'd made a mistake, as it was so simple, i.e., it appeared you'd forgotten the "->()" after "$replace" and the "e" at the end. (I guess I was making this all harder than it needed to be.) Of course, my corrections did not work. Then I took a closer look and realized you had eliminated those evaluated subroutines altogether. I felt like it couldn't possibly work that way, but, went ahead and tried it anyhow. I'm very surprised at how well it works, and I'm not sure why it does work so well. I guess I need to learn more about using eval as a wrapper around a substitution regex. It's highly likely this would have been useful for me in a number of my past projects.

      Thank you ever so much for taking time to offer your corrections.

      It may be worthy of mention that in my actual code, I am not using any of the quotes such as the qr'(St\.\s)(Mt\.\s)(?=Helens)'; because the variables are coming in straight from the form, with the exception of the untainting routine that the substitution side passes through. So escaped characters were never a part of my issue. The difficulty seems to have been with the complexity of the nested eval.

      Blessings,

      ~Polyglot~

        Hello Polyglot!

        My approach with eval'ing the complete substitution statement was kind of "brute force".

        I thought about this every now and then and felt dissatisfied with my solution. Now I may round this off with the following:

        #!/usr/bin/perl use Test2::V0; #FROM DATABASE TEXT my $line = "Her house is on 34th Mt. Whitney St. near St. Mt. Helens S +t."; #FROM INCOMING FORM INPUTS my $query = qr'(St\.\s)(Mt\.\s)(?=Helens)'; my $substitution = 'Mount ${1}'; # USER MAY HAVE ENTERED "$1" #FOR RETURNED HTML HIGHLIGHT OF CHANGES my $start = '<span class="highlight">'; my $end = '</span>'; my $replace = $start . $substitution . $end; # twofold quoting and double eval'ing does the trick: $line =~ s{$query}{"qq{$replace}"}gee; is $line, 'Her house is on 34th Mt. Whitney St. near <span class="high +light">Mount St. </span>Helens St.', 'pattern substitution'; done_testing;

        Greetings,
        -jo

        $gryYup$d0ylprbpriprrYpkJl2xyl~rzg??P~5lp2hyl0p$
Re^2: Evaluating user-entered captured groups during Perl substitution
by Polyglot (Chaplain) on Mar 16, 2020 at 09:03 UTC

    I appreciate seeing how you handled the eval for the entire regex expression, escaping two of the tokens to delay their evaluation (I presume). I don't remember having seen that kind of grammar before.

    As for the application, my usage involves UTF8 text, and I just provided the example here to simulate the functionality I wish to have. In my own code, what you suggested doesn't seem to work. I'll have to play with it some more later, when I have time again, to see if I can do something more with the grammar you introduced.

    The quotes seem to be fine at my end...at least, warnings doesn't indicate any special issue with them. Warnings just says there's an unrecognized escape in the line where I escaped the period and indicated a space with \s. As far as my eye can see, there should be no error there. Useless error messages is why I usually turn warnings off unless I specifically am watching the logs during trouble shooting. Otherwise, my logs just get fat without benefit. In the actual application, the text is coming in from a web form, and is not directly assigned in this manner.

    Blessings,

    ~Polyglot~

      The quotes seem to be fine at my end...at least, warnings doesn't indicate any special issue with them. Warnings just says there's an unrecognized escape in the line where I escaped the period and indicated a space with \s. As far as my eye can see, there should be no error there.
      Line under discussion:
      $query = "(St\.\s)(Mt\.\s)(?=Helens)";
      Unrecognized escape \s passed through at blah... line x

      Perl is saying that it figures you made a mistake with \s. It translated that into a single "s" character. It also translated \. into a literal single character of '.' but it knew about escaping a period and Perl didn't complain about that.
      Consider the following:

      #FROM INCOMING FORM INPUTS $query = '(St\.\s)(Mt\.\s)(?=Helens)'; #right way print "$query\n"; ##(St\.\s)(Mt\.\s)(?=Helens) $query = "(St\.\s)(Mt\.\s)(?=Helens)"; #your way print "",$query,"\n"; ##(St.s)(Mt.s)(?=Helens) print "$query\n"; ## same thing (St.s)(Mt.s)(?=Helens) $query = "(St\\.\\s)(Mt\\.\\s)(?=Helens)"; #ok, but confusing print "$query\n"; ## (St\.\s)(Mt\.\s)(?=Helens)
      Fixing the quoting has real consequences in terms of what $query winds up being!
      I always "use warnings;". I very rarely ignore a warning, with the possible exception of working with old code and the "deprecated syntax" warning. However, in all cases I do strive to understand what the heck is wrong that Perl is complaining about and then try to "make Perl happy". Sometimes with deprecated syntax, the error may be so pervasive that is not practical.

      I understand that in your production code, this string will come from elsewhere instead of an assignment statement like above. Be that as it may, I still strongly advise understanding what a Perl warning is telling you and fixing all test code so that it runs without any warnings. I have heard that Perl runs slightly slower with warnings enabled. I have never benchmarked that because this just hasn't been a significant factor in my work. I recommend leaving warnings enabled at all times.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11114327]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chilling in the Monastery: (3)
As of 2024-03-29 06:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found