Why this code does not do what I mean? - regex

$w = 'self-powering';
%h = (self => 'self',
power => 'pauә',
);
if ($w =~ /(\w+)-(\w+)ing$/ && $1~~%h && $2~~%h && $h{$2}=~/ә$/) {
$p = $h{$1}.$h{$2}.'riŋ';
print "$w:"," [","$p","] ";
}
I expect the output to be
self-powering: selfpauәriŋ
But what I get is:
self-powering: [riŋ]
My guess is something's wrong with the code
$h{$2}=~/ә$/
It seems that when I use
$h{$2}!~/ә$/
Perl will do what I mean but why I can't get "self-powering: selfpauәriŋ"?
What am I doing wrong? Any ideas?
Thanks as always for any comments/suggestions/pointers :)

When you run
$h{$2}!~/ә$/
In your if statement the contents of $1 and $2 are changed to be empty, because no groupings were matched (there were none). If you do it like this:
if ($w =~ /(\w+)-(\w+)ing$/){
my $m1 = $1;
my $m2 = $2;
if($m2~~%h && $m2~~%h && $h{$m2}=~/ә$/) {
$p = $h{$m1}.$h{$m2}.'riŋ';
print "$w:"," [","$p","] ";
}
}
I expect you will get what you want.

Are you running with use warnings enabled? That would tell you that $1 and $2 are not what you expect. Your second regex, not the first, determines the values of those variables once you enter the if block. To illustrate with a simpler example:
print $1, "\n"
if 'foo' =~ /(\w+)/
and 'bar' =~ /(\w+)/;

Related

Search pattern for decoding logic

I need to decode logic from a database I reference when determining if an attribute is able to be associated with an item I am defining. The database uses standard logic flow and order of importance. I need to be able to determine nested conditional statements in the strings I pull from the database. For example:
$val = "(red && (blue || yellow)) && black";
The string I'd pull from the database would resemble:
$pull = "red.yellow.black";
I would separate $pull on . and store the values in an array, then I'd verify each value is in the array(s) I generate from the $val string. I am having trouble with the best method for determining how to unpack the nested logic though. Initially, I considered just using a regex, then removing the portion of the logic that has been assessed like so:
($eval) = $val =~ /.*\((.*)?\)/; $val =~ s/(.*)\((.*)?\)(.*)/$1 $2/;
If I do this in a while ($val =~ /\(/) loop, I could probably stack the extracted logic into arrays and evaluate the logical expression in each element to determine if each condition is true for the item I am evaluating, but there's something wrong with my regexp causing the sequence to fail. The ? is not as lazy as I thought, apparently...
my $val = "(red && (blue || yellow)) && black";
my $pull = "red.yellow.black";
my #stack = ();
until ($val !~ /\(/) {
my ($eval) = $val =~ /.*\((.*)?\)/;
push(#stack, $eval);
print "$eval\n";
$val =~ s/(.+)\((.*)?\)(.*)/$1 $2/;
print "$val\n";
}
If I just run the sequence in a perl shell, with some debugging info, I get this:
[bin]$ perl -e 'my $val = "((red && (blue || yellow) && black)"; my $pull = "red.yellow.black"; my #stack = (); until ($val !~ /\(/) { my ($eval) = $val =~ /.*\((.+)?\).?/; push(#stack, $eval); print "EVAL: $eval\n";$pause = <STDIN>;$val =~ s/(.*)\((.*)?\)(.*)/$1 $2/;print "VAL: $val\n"; }'
EVAL: blue || yellow) && black
VAL: ((red && blue || yellow) && black
EVAL: red && blue || yellow
VAL: ( red && blue || yellow
EVAL:
Any input on what I'm doing wrong would be appreciated, and any improvements on efficiency would be greatly appreciated! TIA
Update: Ok, so I just dumbed the whole thing down like this. I lose some of the order of operations, but if I evaluate each statement individually, whenever one of the conditions is broken, I'll pick it up and be able to act on the info accordingly. The code I am going to expand on is below. This would just return the individual components of the expression. I don't like how everything ouside parenthesis is concatenated into the first element, but I guess it still works fundamentally.
my $val = "(red && (blue || yellow)) && black";
$val =~ s/\s+//g;
my #chars = ();
my #ops = ();
while ($val) {
my ($char) = $val =~ /(.)/;
$val =~ s/.//;
push #chars, $char;
}
my $index = 0;
foreach my $char (#chars) {
if ($char =~ /\(/) {
$index++;
} elsif ($char =~ /\)/) {
$index--
}
#assign the character to the index.
$ops[$index] .= $char;
}
s/[()]//g for #ops;
print " #ops\n";
Output:
[/bin]$ perl decode_logic.pl
&&black red&& blue||yellow

Unable to search one variable within another variable using Perl

Using perl, i'm unable to perform a simple search to see if one number is within another. The below example doesn't enter the if statement.
my $a = "12345";
my $b = "123456789";
if($a=~ m/$b/g) #doesn't work
{
print "success";
}
The below doesn't work either.
my $a = "12345";
my $b = "123456789";
if($a =~ /$b/) #doesn't work
{
print "success";
}
To check if $substr is in $string, you want:
if ($string =~ /\Q$substr\E/)
or
if (index($string, $substr) >= 0)
In your case, that means
if ($b =~ /\Q$a\E/)
or
if (index($b, $a) >= 0)
\Q..\E causes the contents of the variable in between to be matched literally rather than have it treated as a regex pattern.
if (//g) makes no sense, and using it can produce subtle and very odd problems.
I believe you might have mixed up your variables in the statement. The $a =~ m/$b/g indicates that $b can be found in $a (in order to be true), not the $a can be found in $b. Since $a is less in length than $b, the statements fail ( since 123456789 cannot be found in 12345).
I suspect what you want is:
if ( $b =~ m/$a/g ) # or ( $b =~ /$a/ )
{
print "success";
}
There are characters that may have different meanings in regular expressions. Instead, do this:
if (index($b, $a) != -1) #works

Perl conditional regex extraction

This conditional must match either telco_imac_city or telco_hier_city. When it succeeds I need to extract up to the second underscore of the value that was matched.
I can make it work with this code
if ( ($value =~ /(telco_imac_)city/) || ($value =~ /(telco_hier_)city/) ) {
print "value is: \"$1\"\n";
}
But if possible I would rather use a single regex like this
$value = $ARGV[0];
if ( $value =~ /(telco_imac_)city|(telco_hier_)city/ ) {
print "value is: \"$1\"\n";
}
But if I pass the value telco_hier_city I get this output on testing the second value
Use of uninitialized value $1 in concatenation (.) or string at ./test.pl line 19.
value is: ""
What am I doing wrong?
while (<$input>){
chomp;
print "$1\n" if /(telco_hier|telco_imac)_city/;
}
Perl capture groups are numbered based on the matches in a single statement. Your input, telco_hier_city, matches the second capture of that single regex (/(telco_imac_)city|(telco_hier_)city/), meaning you'd need to use $2:
my $value = $ARGV[0];
if ( $value =~ /(telco_imac_)city|(telco_hier_)city/ ) {
print "value is: \"$2\"\n";
}
Output:
$> ./conditionalIfRegex.pl telco_hier_city
value is: "telco_hier_"
Because there was no match in your first capture group ((telco_imac_)), $1 is uninitialized, as expected.
To fix your original code, use FlyingFrog's regex:
my $value = $ARGV[0];
if ( $value =~ /(telco_hier_|telco_imac_)city/ ) {
print "value is: \"$1\"\n";
}
Output:
$> ./conditionalIfRegex.pl telco_hier_city
value is: "telco_hier_"
$> ./conditionalIfRegex.pl telco_imac_city
value is: "telco_imac_"

How do I use perl regex to extract the digit value from '[1]'?

My code...
$option = "[1]";
if ($option =~ m/^\[\d\]$/) {print "Activated!"; $str=$1;}
I need a way to drop off the square brackets from $option. $str = $1 does not work for some reason. Please advise.
To get $1 to work you need to capture the value inside the brackets using parentheses, i.e:
if ($option =~ m/^\[(\d)\]$/) {print "Activated!"; $str=$1;}
if ($option =~ m/^\[(\d)\]$/) { print "Activated!"; $str=$1; }
Or
if (my ($str) = $option =~ m/^\[(\d)\]$/) { print "Activated!" }
Or
if (my ($str) = $option =~ /(\d)/) { print "Activated!" }
..and a bunch of others. You forgot to capture your match with ()'s.
EDIT:
if ($option =~ /(?<=^\[)\d(?=\]$)/p && (my $str = ${^MATCH})) { print "Activated!" }
Or
my $str;
if ($option =~ /^\[(\d)(?{$str = $^N})\]$/) { print "Activated!" }
Or
if ($option =~ /^\[(\d)\]$/ && ($str = $+)) { print "Activated!" }
For ${^MATCH}, $^N, and $+, perlvar.
I love these questions : )

How to do perl inline regex without setting to a variable?

Normally if you wish to change a variable with regex you do this:
$string =~ s/matchCase/changeCase/;
But is there a way to simply do the replace inline without setting it back to the variable?
I wish to use it in something like this:
my $name="jason";
print "Your name without spaces is: " $name => (/\s+/''/g);
Something like that, kind of like the preg_replace function in PHP.
Revised for Perl 5.14.
Since 5.14, with the /r flag to return the substitution, you can do this:
print "Your name without spaces is: [", do { $name =~ s/\s+//gr; }
, "]\n";
You can use map and a lexical variable.
my $name=" jason ";
print "Your name without spaces is: ["
, ( map { my $a = $_; $a =~ s/\s+//g; $a } ( $name ))
, "]\n";
Now, you have to use a lexical because $_ will alias and thus modify your variable.
The output is
Your name without spaces is: [jason]
# but: $name still ' jason '
Admittedly do will work just as well (and perhaps better)
print "Your name without spaces is: ["
, do { my ( $a = $name ) =~ s/\s+//g; $a }
, "]\n";
But the lexical copying is still there. The assignment within in the my is an abbreviation that some people prefer (not me).
For this idiom, I have developed an operator I call filter:
sub filter (&#) {
my $block = shift;
if ( wantarray ) {
return map { &$block; $_ } #_ ? #_ : $_;
}
else {
local $_ = shift || $_;
$block->( $_ );
return $_;
}
}
And you call it like so:
print "Your name without spaces is: [", ( filter { s/\s+//g } $name )
, "]\n";
print "Your name without spaces is: #{[map { s/\s+//g; $_ } $name]}\n";