I'm using this code to alter a string by a regex match.
$a->{'someone'} = "a _{person}";
$a->{'person'} = "gremlin";
$string = "_{someone} and a thing"
while($string =~ /(_\{(.*?)\}/g){
$search = metaquote($1);
$replace = $a->{$2};
$string =~ s/$search/$replace/;
}
The result is a _{person} and a thing but I'm expecting: a gremlin and a thing.
What to do to get this working?
The function is called quotemeta, not metaquote. Also, a right parenthesis is missing in your regex:
#!/usr/bin/perl
use warnings;
use strict;
my $a;
$a->{'someone'} = "a _{person}";
$a->{'person'} = "gremlin";
my $string = "_{someone} and a thing";
while($string =~ /(_\{(.*?)\})/g){
my $search = quotemeta($1);
my $replace = $a->{$2};
$string =~ s/$search/$replace/;
}
print "$string\n";
I also added strict and warnings to help myself avoid common pitfalls.
I think this should be more effecient variant:
use strict;
my $a;
$a->{'someone'} = "a _{person}";
$a->{'person'} = "gremlin";
my $string = "_{someone} and a thing";
while( $string =~ s/(_\{(.*?)\})/ $a->{$2} /ges ) {}
print $string."\n";
This variant repeatedly substitues all of the placeholders in the string for their corresponding hash value until there are none left.
In addition, a is a bad identifier for any variable, so I have named it tokens.
use strict;
use warnings;
my %tokens = (
someone => 'a _{person}',
person => 'gremlin',
);
my $string = '_{someone} and a thing';
1 while $string =~ s/_\{([^}]+)\}/$tokens{$1}/g;
print $string, "\n";
output
a gremlin and a thing
Related
I have a problem in the case of performing a global match. How can I substitute the matched string for a new string, which is made up from the original string plus a new string. The string is like:
$string = "t123:apple;t456:pear;t789:banana";
Then I have a hash like this:
my %hash = (
t123 => 'fruit1',
t456 => 'fruit2',
t789 => 'fruit3',
);
How can I then obtain a new string such as:
$newstring = "t123 fruit1:apple;t456 fruit2:pear;t789 fruit3:banana";
Now, my perl code is:
while($string =~ /t\d{3}/g){
if (exists $hash{"$&"}) {
my $match = $&;
$string =~ s/$&/$match.$hash{"$&"}/;
}
}
It doesn't work though, because the match always starts from the first character. I think I should use pos(string) or something to make it have an offset, but I don't know how to do this.
The easy way is rather easy:
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
my $string = "t123:apple;t456:pear;t789:banana";
my %hash = (
t123 => 'fruit1',
t456 => 'fruit2',
t789 => 'fruit3',
);
$string =~ s/(t\d+)/$1 $hash{$1}/g;
say $string;
But this doesn't ensure that everything that matches t\d{3} is a valid key in your hash. So let's explicitly search for those keys.
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
my $string = "t123:apple;t456:pear;t789:banana";
my %hash = (
t123 => 'fruit1',
t456 => 'fruit2',
t789 => 'fruit3',
);
my $match = join '|', map quotemeta, keys %hash;
$string =~ s/($match)/$1 $hash{$1}/g;
say $string;
I'm trying to dynamically catch regex matching in Perl. I've known that eval will help me do this but I may be doing something wrong.
Code:
use strict;
use warnings;
my %testHash = (
'(\d+)\/(\d+)\/(\d+)' => '$1$2$3'
);
my $str = '1/12/2016';
foreach my $pattern (keys (%testHash)) {
my $value = $testHash{$pattern};
my $result;
eval {
local $_ = $str;
/$pattern/;
print "\$1 - $1\n";
print "\$2 - $2\n";
print "\$3 - $3\n";
eval { print "$value\n"; }
}
}
Is it also possible to store captured regex patterns in an array?
I believe what you really want is a dynamic version of the following:
say $str =~ s/(\d+)\/(\d+)\/(\d+)/$1$2$3/gr;
String::Substitution provides what we need to achieve that.
use String::Substitution qw( gsub_copy );
for my $pattern (keys(%testHash)) {
my $replacement = $testHash{$pattern};
say gsub_copy($str, $pattern, $replacement);
}
Note that $replacement can also be a callback. This permits far more complicated substitutions. For example, if you wanted to convert 1/12/2016 into 2016-01-12, you could use the following:
'(\d+)/(\d+)/(\d+)' => sub { sprintf "%d-%02d-%02d", #_[3,1,2] },
To answer your actual question:
use String::Substitution qw( interpolate_match_vars last_match_vars );
for my $pattern (keys(%testHash)) {
my $template = $testHash{$pattern};
$str =~ $pattern # Or /$pattern/ if you prefer
or die("No match!\n");
say interpolate_match_vars($template, last_match_vars());
}
I am not completely sure what you want to do here, but I don't think your program does what you think it does.
You are useing eval with a BLOCK of code. That's like a try block. If it dies inside of that eval block, it will catch that error. It will not run your string like it was code. You need a string eval for that.
Instead of explaining that, here's an alternative.
This program uses sprintf and numbers the parameters. The %1$s syntax in the pattern says _take the first argument (1$) and format it as a string (%s). You don't need to localize or assign to $_ to do a match. The =~ operator does that on other variables for you. I also use qr{} to create a quoted regular expression (essentially a variable containing a precompiled pattern) that I can use directly. Because of the {} as delimiter, I don't need to escape the slashes.
use strict;
use warnings;
use feature 'say'; # like print ..., "\n"
my %testHash = (
qr{(\d+)/(\d+)/(\d+)} => '%1$s.%2$s.%3$s',
qr{(\d+)/(\d+)/(\d+) nomatch} => '%1$s.%2$s.%3$s',
qr{(\d+)/(\d+)/(\d\d\d\d)} => '%3$4d-%2$02d-%1$02d',
qr{\d} => '%s', # no capture group
);
my $str = '1/12/2016';
foreach my $pattern ( keys %testHash ) {
my #captures = ( $str =~ $pattern );
say "pattern: $pattern";
if ($#+ == 0) {
say " no capture groups";
next;
}
unless (#captures) {
say " no match";
next;
}
# debug-output
for my $i ( 1 .. $#- ) {
say sprintf " \$%d - %s", $i, $captures[ $i - 1 ];
}
say sprintf $testHash{$pattern}, #captures;
}
I included four examples:
The first pattern is the one you had. It uses %1$s and so on as explained above.
The second one does not match. We check the number of elements in #captured by looking at it in scalar context.
The third one shows that you can also reorder the result, or even use the sprintf formatting.
The last one has no capture group. We check by looking at the index of the last element ($# as the sigil for arrays that usually have an # sigil) in #+, which holds the offsets of the ends of the last successful submatches in the currently active dynamic scope. The first element is the end of the overall match, so if this only has one element, we don't have capture groups.
The output for me is this:
pattern: (?^:(\d+)/(\d+)/(\d\d\d\d))
$1 - 1
$2 - 12
$3 - 2016
2016-12-01
pattern: (?^:(\d+)/(\d+)/(\d+) nomatch)
no match
pattern: (?^:\d)
no capture groups
pattern: (?^:(\d+)/(\d+)/(\d+))
$1 - 1
$2 - 12
$3 - 2016
1.12.2016
Note that the order in the output is mixed up. That's because hashes are not ordered in Perl, and if you iterate over the keys in a hash without sort the order is random.
Apologies! I realized both my question and sample code were both vague. But after reading your suggestions I came of with the following code.
I haven't optimized this code yet and there is a limit to the replacement.
foreach my $key (keys %testHash) {
if ( $str =~ $key ) {
my #matchArr = ($str =~ $key); # Capture all matches
# Search and replace (limited from $1 to $9)
for ( my $i = 0; $i < #matchArr; $i++ ) {
my $num = $i+1;
$testHash{$key} =~ s/\$$num/$matchArr[$i]/;
}
$result = $testHash{$key};
last;
}
}
print "$result\n";
Evaluing the regexp in list context returns the matches. so in your example:
use Data::Dumper; # so we can see the result
foreach my $pattern (keys (%testHash)) {
my #a = ($str =~/$pattern/);
print Dumper(\#a);
}
would do the job.
HTH
Georg
Is it also possible to store captured regex patterns in an array?
Of course it is possible to store captured substrings in an array:
#!/usr/bin/env perl
use strict;
use warnings;
my #patterns = map qr{$_}, qw{
(\d+)/(\d+)/(\d+)
};
my $str = '1/12/2016';
foreach my $pattern ( #patterns ) {
my #captured = ($str =~ $pattern)
or next;
print "'$_'\n" for #captured;
}
Output:
'1'
'12'
'2016'
I do not quite understand what you are trying to do with combinations of local, eval EXPR and eval BLOCK in your code and the purpose of the following hash:
my %testHash = (
'(\d+)\/(\d+)\/(\d+)' => '$1$2$3'
);
If you are trying to codify that this pattern should result in three captures, you can do that like this:
my #tests = (
{
pattern => qr{(\d+)/(\d+)/(\d+)},
ncaptures => 3,
}
);
my $str = '1/12/2016';
foreach my $test ( #tests ) {
my #captured = ($str =~ $test->{pattern})
or next;
unless (#captured == $test->{ncaptures}) {
# handle failure
}
}
See this answer to find out how you can automate counting the number of capture groups in a pattern. Using the technique in that answer:
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
my #tests = map +{ pattern => qr{$_}, ncaptures => number_of_capturing_groups($_) }, qw(
(\d+)/(\d+)/(\d+)
);
my $str = '1/12/2016';
foreach my $test ( #tests ) {
my #captured = ($str =~ $test->{pattern});
ok #captured == $test->{ncaptures};
}
done_testing;
sub number_of_capturing_groups {
"" =~ /|$_[0]/;
return $#+;
}
Output:
ok 1
1..1
I have an array contain #arr = { "a=b", "a>b", "a<b", "a!=b", "a-b" }. What is the best way to get a and b with any operator between. I can extract by
for($i=0; $i<=$#arr; $i++){
$str = $arr[$i];
if($str =~ m/^(.*?)(\s*=\s*)(.*)(;)/g){
my $d = $1;
my $e = $3;
}
Follow by all if statement with the possible operator like "!=", "<" etc. But this will make my code look messy. Any better solution for this?
You could try something like this one liner
perl -e '#a = ("a=b","a>b","a<b","a!=b","a-b"); for $l (#a) { $l =~ s/(.).*(.)/$1/; print "$1$2\n"};'
The key thing is the greedy match ie "(.*)" between the two single character matches ie "(.)". To really make sure that you start at the start and end of the strings you could use this
perl -e '#a = ("a=b","a>b","a<b","a!=b","a-b"); for $l (#a) { $l =~ s/^(.).*(.)$/$1/; print "$1$2\n"};'
A complete working example that demonstrates the whole thing would be
#!/usr/bin/perl
use strict;
use warnings;
my #expressions = ("a=b","a>b","a<b","a!=b","a-b");
for my $exp (#expressions) {
$exp =~ s/^(.).*(.)$/$1$2/;
print "$1$2 is the same as $exp\n";
};
A very simple regex might be
/^(\w+)\s*(\W+)\s*(\w+)$/
Or you enumerate possible operators
/^(\w+)\s*(=|!=|<|>|<=|>=|\+|-|\*|\/|==)\s*(\w+)$/
It depends whether the input can be trusted or not. If not, you might have to be more meticulous w.r.t. the identifiers, too. Here's a simpler loop, and no need to use m//g(lobal). Not sure about the semicolon - omitted it.
my #arr = ( "a=b", "a>b", "a<b", "a!=b", "a-b" );
for my $str (#arr){
if($str =~ /^(\w+)\s*(=|!=|<|>|<=|>=|\+|-|\*|\/|==)\s*(\w+)$/ ){
my $d = $1;
my $e = $3;
print "d=$d e=$e\n";
}
}
Later If you enumerate the operators, you can also add word symbols:
if($str =~ /^(\w+)\s*(=|!=|<|>|<=|>=|\+|-|\*|\/|==|x?or|and)\s*(\w+)$/ ){
...
if there always 'a' and 'b' at the beginning and the end you could try:
my $str = 'a<b';
my( $op ) = $str =~ /^a(.*)b$/;
Not a well thought out answer. Will reconsider the problem.
I have a string in which i need to replace the starting set of characters with mod1.
Its like xyz_gf_111_yz to mod1_111_yz.
bcd_df_222_xx to mod2_222_xx and so on.
can anybody suggest sol, as the starting string is not fixed and im beginner in perl
thanks!
my #strings = qw(xyz_gf_111_yz bcd_df_222_xx asd_cv_333_dd);
my $i = 1;
for my $str (#strings)
{
my $after = $str;
$after =~ s/^\w{3}[_]\w{2}/mod$i/;
$i++;
print "$str -> $after\n";
}
Something like the following could get you started:
my #strings = qw(xyz_gf_111_yz bcd_df_222_xx);
my $i = 0;
for my $str (#strings) {
my $after = $str;
$i++;
$after =~ s/[^_]+/mod$i/;
print "$str -> $after\n";
}
#Miller,
I suggest a different solution, assuming that you want to replace the starting substring (all chars to the left the first digit) and the associated digit to the "mod" string is given by the first digit of the number substring the following could be a way.
my #strings = qw(xyz_gf_111_yz bcd_df_222_xx asd_cv_333_dd);
for my $str (#strings) {
print "bfr:".$str."\n";
$str =~ s/^([^\d]+?)_(\d)/mod$2_$2/;
print "aft:".$str."\n";
}
Here's another option:
use strict;
use warnings;
my $i;
my #strings = ( 'xyz_gf_111_yz', 'bcd_df_222_xx' );
for (#strings) {
print $_, "\n" if s/.+?_[^_]+/'mod'.++$i/e;
}
Output:
mod1_111_yz
mod2_222_xx
The loop fails. What is wrong with the array?
I would like the regex to return B when it parses the first string, and M when it parses the second string.
How is such an regex constructed?
#!/usr/bin/perl
use warnings;
use strict;
my $a = "0.0 B/s";
my $b = "12.0 MiB/s";
while (defined (my $s = shift ("$a", "$b"))) {
my $unit = $1 if ($a =~ m/.*([KMGT])i?B\/s$/);
print "$unit\n";
}
shift is meant to be used with arrays, not lists. If you want to use a while loop, you need to pre-declare an array containing $a and $b (which, by the way, are a bad choice for variable names).
Having said that, a for loop construct is the more natural choice here:
for my $s ( $var1, $var2 ) { ... }
And given that you're trying to extract the measurement unit, why not do things a slightly different way:
say for map { my ( $s ) = /$regex/; $s } $var1, $var2;
You need another substitution:
for ($a, $b) {
if (m!((?:[KMGT]i)?B)/s$!) {
my $unit = $1;
$unit =~ s/(.).*/$1/;
print "$unit\n" if $unit;
}
}
Your while has issues.
You are using variable $a inside loop, when you want to use $s.
I'd use it this way:
#!/usr/bin/perl
use warnings;
use strict;
my $a = "0.0 B/s";
my $b = "12.0 MiB/s";
foreach my $s($a, $b) {
print $1 if ($s =~ m/.*([KMGT])i?B\/s$/);
}