Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

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 });
        poj
Re: creating qr from existing regex
by vr (Friar) 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?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1208734]
Approved by Corion
Front-paged by haukex
help
Chatterbox?
and the radiator hisses contentedly...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (5)
As of 2018-02-22 05:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    When it is dark outside I am happiest to see ...














    Results (288 votes). Check out past polls.

    Notices?