in reply to Passing a regex from a CGI HTML form
You need eval
my $string = "A";
my $command = '$string =~ s/A/B/';
eval $command;
print $string; #B
Re^2: Passing a regex from a CGI HTML form (user supplied regex substitution without eval)
by Anonymous Monk on Aug 31, 2016 at 21:49 UTC
|
use String::Interpolate::RE qw( strinterp );
print Substitution(
"input string",
"pattern",
"replacement",
"flags" );
sub Substitution {
my( $in, $re, $rep, $flags ) = @_;
my $global = $flags =~ m{g}i;
my $qrFlags = join '', $flags =~ m{[msixpodualn]}i;
$qrFlags = "(?$qrFlags)";
$re = qr{$qrFlags$re};
if( $global ){
$in =~ s{$re}{
Replace($rep, \%+,{1=>$1,2=>$2,3=>$3});
}gex;
} else {
$in =~ s{$re}{
my $vars = {
%+, 1=>$1, 2=>$2, 3=>$3,
};
strinterp( $rep, $vars );
}ex;
}
}
sub Replace {
my( $rep, $named, $numed ) = @_;
my $vars = { %$named, %$numed, 'bananas','bananas' );
return strinterp( $rep, $vars );
}
| [reply] [d/l] |
|
Seems like these types of modules try to make an explicitly unsafe course of action less unsafe.
From String::Interpolate::RE Docs -
This module interpolates variables into strings using regular expression matching rather than Perl's built-in interpolation mechanism and thus hopefully does not suffer from the security problems inherent in using eval to interpolate into strings of suspect ancestry.
From String::Interpolate Docs -
Because the Perl string interpolation engine can call arbitrary Perl code you do not want to want to use it on strings from untrusted sources without some precautions. For this reason String::Interpolate objects can be made to use Safe compartments. This is, of course, only as safe as Safe and you are advised to read "WARNING" section of the Safe documentation.
Your code did not compile for me, but I guess the point is to try and override the substitution operator with some subset of safer features. I acknowledge that could be successful, but also the op could just use eval in any context where all user input is trusted and be fine. The OP is troubleshooting his gambling code on the clock here so every second counts.
| [reply] |
|
You gotta have a canned solution for ignorant newbees and impatient veterans
Its not like it takes long to DIY-up a little safety, I typed up the above in preview box, now tested, with own Turpolate
use String::Interpolate::RE qw( strinterp );
print Substitution("BellyAche\n", '([a-z])([A-Z])', '$1 $2', '');
print Substitution("BellyAche\n", '([a-z])([A-Z])', '$1 $2', 'g');
sub Substitution {
my( $in, $re, $rep, $flags ) = @_;
my $global = $flags =~ m{g}i;
my $qrFlags = join '', $flags =~ m{([msixpodualn])}i;
$qrFlags = "(?$qrFlags)";
$re = qr{$qrFlags$re};
if( $global ){
$in =~ s{$re}{
Replace($rep, \%+,{1=>$1,2=>$2,3=>$3});
}gex;
} else {
$in =~ s{$re}{
my $vars = {
%+, 1=>$1, 2=>$2, 3=>$3,
};
Turpolate( $rep, $vars );
}ex;
}
return $in;
}
sub Turpolate {
my( $str, $vars ) = @_;
$str =~ s{\$(\w+)}{
exists $vars->{$1}
? $vars->{$1}
: '$'.$1
}gex;
return $str;
}
sub Replace {
my( $rep, $named, $numed ) = @_;
my $vars = { %$named, %$numed, 'bananas','bananas' };
return strinterp( $rep, $vars );
}
__END__
Belly Ache
Belly Ache
| [reply] [d/l] |
|
|
|
|
Also good idea to add no re 'eval'; in that sub
| [reply] [d/l] |
Re^2: Passing a regex from a CGI HTML form
by Linicks (Scribe) on Aug 31, 2016 at 18:27 UTC
|
Thanks, but that doesn't quite work I need both what to replace and what with, i.e. I could have to input to a $var 's/ ... ,g/ g/g;' etc. Nick
| [reply] |
|
OK, seeing as I am 57 in a few months, looks like a lot of people are protecting me ;) Here follows 2 examples of the junk I need to format:
SWA vs CHE GK
WBA @ BOU GK
That is easy to parse and render clean, as all I need is to extract is "SWA,GK" or "WBA,GK" in that example: $line =~ s/ vs ... /,/;
$line =~ s/ \@ ... /,/;
Now, the 'vs' and '@' are (seem) randomly dispersed ~ whether that is a product of the newspapers website database or crappy programming, I don't know. But this week, this appeared in about 50 places over 4000 lines:
EVE GK
OK, my code failed on this. I could see what has happened, but couldn't fix it at work. If I did have a debug option to pass over a new regex, I could send a '$line =~ s/ GK/,GK/;' which would have fixed it up until I got home (as it was, I frigged around in a spreadsheet to correct it to keep the wolves at bay). Nick | [reply] [d/l] [select] |
|
Are those full lines? I mean, is this a situation where you can just grab the first and last non-whitespace chars, and just not bother with the stuff in between? ie. does the below code work in your cases, or are there other things that need consideration?
use warnings;
use strict;
while (<DATA>){
if (/^(\w+).*\s(\w+)/){
my $line = "$1,$2";
print "$line\n";
}
}
__DATA__
SWA vs CHE GK
WBA @ BOU GK
EVE GK
EVE 4 87 dwqer *** GK
Output:
SWA,GK
WBA,GK
EVE,GK
EVE,GK
| [reply] [d/l] [select] |
|
|
|