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$
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$
| [reply] [Watch: Dir/Any] [d/l] |
|
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.
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
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$
| [reply] [Watch: Dir/Any] [d/l] [select] |
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.
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
#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.
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
|