Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight

creating qr from existing regex

by Bobert1234 (Novice)
on Feb 08, 2018 at 18:06 UTC ( #1208734=perlquestion: print w/replies, xml ) Need Help??
Bobert1234 has asked for the wisdom of the Perl Monks concerning the following question:

Hi, for the mongodb driver, it seems i have to use the qr// format of regular expressions. from the documentation, :
Use qr/.../ to use a regular expression in a query ..... my $cursor = $collection->query({"name" => qr/[Jj]oh?n/});
The problem is that i have to create the query by reading existing mongo regex strings, e.g.
{"name" => '/.*uba$/i'}
i tried changing this through basic string manipulation to prepend the qr :
{"name" => 'qr/.*uba$/i'}
but i think it's just treating that as a string for full matching instead of applying it is a regex. it's certainly not working.

i also tried (after prepending the qr) passing it to a function and creating a qr object:
if(index($_[0],"qr/") >= 0){ $_[0] =~s/qr(.*?)(i?)$/$1/s; print $fh Dumper($_[0]); if($2=='i'){ my $re = qr/$_[0]/i; }else{ my $re = qr/$_[0]/; } $_[0] =$re; print $fh Dumper($_[0]); }
but that outputs:
$VAR1 = '/.*uba$/'; $VAR1 = undef;
I'm very new to perl, so it's very possible that i'm missing something obvious. any ideas?

Replies are listed 'Best First'.
Re: creating qr from existing regex
by Perlbotics (Chancellor) on Feb 08, 2018 at 18:13 UTC

    This is indeed a string that contains a qr expression:

    {"name" => 'qr/.*uba$/i'}

    Does removing the quotes solve your problem?

    {"name" => qr/.*uba$/i}

    When you perform string manipulations to form your qr-expression, you might find quotemeta useful.

      i figured it out. The issue was that when i created the $re variable, it was adding the slashes. by using just what was inside the slashes of the original string, i managed to get it to work
      if(index($_[0],"qr/") >= 0){ $_[0] =~s/qr[\/](.*?)([^\\])[\/](i?)$/$1$2/s; print $fh Dumper($_[0]); if($3=='i'){ $_[0] = qr/$_[0]/i; }else{ $_[0] = qr/$_[0]/; } print $fh Dumper($_[0]); }

        Maybe use split

        my $string = '/.*uba$/i'; my @f = split '/',$string; my $qr = ($f[-1] eq 'i') ? qr/$f[1]/i : qr/$f[1]/; my $cursor = $collection->query( { name=> $qr });
Re: creating qr from existing regex
by vr (Hermit) on Feb 09, 2018 at 11:15 UTC

    Not an answer, just a comment. Do I get it right:

    • "setter" (in quotes, because I understand it's not really a setter) accepts a compiled regex, one you build with the qr operator;
    • "getter" returns not this compiled regex, but, somehow, Perl source code fragment, literal string 'qr/.*uba$/i'. Which you then are trying to parse. Or, where does this 'qr/.*uba$/i' come from, and why is it necessary to manually parse Perl expression?

    It doesn't make much sense to me, but I haven't worked with MongoDB, hence not an answer, but a promised comment. The reason you get an undef in OP, is because $re are 2 separate lexical variables, 1 per each own small block. They are declared with my and destroyed at closing curly bracket. What's assigned to $_[0], in next line, is presumably global, completely different $re, and undefined at that time. You don't use strict;, do you? I think this change

    my $re; if($2 eq 'i'){ $re = qr/$_[0]/i; }else{ $re = qr/$_[0]/; } $_[0] =$re;

    would give you the result you were hoping for.

    Edit: Fixed numeric comparison operator to string comparison eq (thanks, poj).

Re: creating qr from existing regex
by bart (Canon) on Feb 09, 2018 at 18:18 UTC
    Remove the slashes, extract the modifier ("i") (say, in a variable $flags). Keep the core of the regex as a string, in your example that would be .*uba$.

    Then put "(?$flags:" in front of it, and ")" behind it. You can use that string ($re) directly as a regex:

    $re = "(?:$flags:$core)"; if($input =~ $re) { ... }
    edit Oops, one too many colons:
    $re = "(?$flags:$core)"; if($input =~ $re) { ... }
    You can also turn it into a regex object:
    $qr = qr/$re/;
      $re = "(?:$flags:$core)";

      That doesn't work: too many  ':' (colons):

      c:\@Work\Perl\monks>perl -wMstrict -le "my $string = '/.*uba$/i'; ;; my $flag = qr{ [msixpodual] }xms; ;; my $convertable = my ($core, $flags) = $string =~ m{ \A \s* / (.*?) / ($flag*) \z }xms; die qq{bad rx: '$string'} unless $convertable; ;; my $re = qq{(?:$flags:$core)}; print $re; print 'A: match' if 'uba' =~ $re; " (?:i:.*uba$)
      Something like this works:
      c:\@Work\Perl\monks>perl -wMstrict -le "my $string = '/.*u\/ba$/i'; ;; my $flag = qr{ [msixpodual] }xms; ;; my $convertable = my ($pattern, $modifiers) = $string =~ m{ \A \s* / (.*?) / ($flag*) \z }xms; die qq{bad rx: '$string'} unless $convertable; ;; my $rx = qr{(?$modifiers)$pattern}; print $rx; print 'A: match' if 'u/Ba' =~ $rx; ;; my $ry = qr{ \A foo $rx }xms; print $ry ;; print 'B: match' if 'foolubatU/bA' =~ $ry; print 'C: match' if 'FoolubatU/bA' =~ $ry; " (?^:(?i).*u\/ba$) A: match (?^msx: \A foo (?^:(?i).*u\/ba$) ) B: match
      Note that:
      • I go directly to  qr// form.
      • The modifiers ($flag pattern) implemented vary by Perl version; see perlop.

      Give a man a fish:  <%-{-{-{-<

        Yes, "(?:$flags:$pattern)" is wrong, it should have been "(?$flags:$pattern)". That is: the flags between the leading "(?" and ":" of the standard non-capturing grouping parens, i.e. "(?:$pattern)".

        You can always try to print out a qr/foo/i, to see what perl does natively.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1208734]
Approved by Corion
Front-paged by haukex
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (1)
As of 2018-05-26 00:56 GMT
Find Nodes?
    Voting Booth?