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

Feature Idea: qr//e (updated with solutions)

by haukex (Archbishop)
on Jan 18, 2017 at 13:47 UTC ( [id://1179847]=perlquestion: print w/replies, xml ) Need Help??

haukex has asked for the wisdom of the Perl Monks concerning the following question:

Dear Monks,

As I was thinking about this node about dynamically building regexes, I had the idle thought that it might be nice if qr// supported qr//e, analogous to s///e it would eval the inside of the construct before parsing it as a regex. Now this is really just a very minor itch, and I don't yet have any idea of how much sense it makes or how difficult it might be to implement, but I still thought I'd bounce it off of you.

Thoughts? Maybe the "normal" and/or "hacked" solutions below are good enough, and the effort required to implement qr//e isn't worth it? Other potential problems I haven't noticed yet?

Update 2017-01-19: TIMTOWTDI has already provided plenty of possible solutions, and I just wasn't feeling creative enough at the moment to see them :-) Thank you very much, LanX, Haarg, and vr! I updated the code with your solutions, and added Test::More and sub testre.

Code:

use warnings; use strict; use Test::More; sub testre; # The "normal" solution my $re = join '|', map {quotemeta} qw/a . | %/; testre qr/$re/i ; # The "hacked" solution testre qr{@{[ join '|', map {quotemeta} qw/a . | %/ ]}}i ; # Wouldn't this be a bit nicer? #testre qr{ join '|', map {quotemeta} qw/a . | %/ }ei ; # ### Update ### # Thanks to LanX sub qre (&;$) { my $re = shift->(); eval 'qr/$re/'.(shift//'') || die $@ } testre qre{ join '|', map {quotemeta} qw/a . | %/ }'i' ; # Thanks to Haarg testre map qr/$_/i, join '|', map {quotemeta} qw/a . | %/ ; # Thanks to vr testre qr{(??{ join '|', map {quotemeta} qw/a . | %/ })}i ; done_testing; sub testre { my $re = shift; diag explain $re; is ref $re, 'Regexp'; like $_, $re for qw/A . | %/; unlike 'bcd', $re; }

Regards,
-- Hauke D

Update almost 6 months later: I just happened to stumble across this node: qr// with /e? :-)

Replies are listed 'Best First'.
Re: Feature Idea: qr//e
by LanX (Saint) on Jan 18, 2017 at 14:55 UTC
    Instinctively I think a module exporting something like qre() (and more) would be better.

    There are some edge cases to be monitored and warned, there are some additional feature requests possible.

    like what if

    • the user doesn't want it to be escaped with quotemeta
    • (doesn't) want a longest match first (like the sort in your other post)
    • what if a hard limit is exceeded (like for trie optimization) ?

    Producing a convincing module is much easier and the best prerequisite for a possible "feature request".

    Cheers Rolf
    (addicted to the Perl Programming Language and ☆☆☆☆ :)
    Je suis Charlie!

      Having your other post in mind I misread your question, sorry.

      you don't want to operate on an array but a code-block

      Would you accept something like the following as sufficiently equivalent?

      sub qre(&;@) { my $block = shift; my $str = $block->(@_); return qr/$str/; }

      (not tested)

      Cheers Rolf
      (addicted to the Perl Programming Language and ☆☆☆☆ :)
      Je suis Charlie!

      udpate

      some functional code:

      use Data::Dump; sub qre(&;@) { my $block = shift; my $str = $block->(@_); return qr/$str/; } sub ored { return join '|', map {quotemeta} @_ } sub oredraw { return join '|', @_ } my @strings = qw/. | %/ ; dd qre {join '|', map {quotemeta} @strings }; dd qre \&ored, @strings; dd qre \&oredraw, @strings;

        Hi LanX,

        sub qre(&;@) { my $block = shift; my $str = $block->(@_); return qr/$str/; }

        Thanks, that's an excellent piece of inspiration! Just to take that idea a little further and add support for /i and the like:

        sub qre (&;$) { my $re = shift->(); eval 'qr/$re/'.(shift//'') || die $@ } my $regex = qre{ join '|', qw/foo bar/ }'i'; print "$regex\n"; __END__ (?^i:foo|bar)

        Not that I'm going to start using this right away, for now this is just to satisfy my curiosity ;-)

        Thanks,
        -- Hauke D

Re: Feature Idea: qr//e
by Haarg (Priest) on Jan 19, 2017 at 06:36 UTC
    my ($regex) = map qr/$_/, join '|', map {quotemeta} qw/. | %/;
          my $regex = qr/$_/ for join '|', map quotemeta, qw/. | %/;

      (untested from mobile)

      Cheers Rolf
      (addicted to the Perl Programming Language and ☆☆☆☆ :)
      Je suis Charlie!

        Hi LanX,

        Good thought, unfortunately that suffers from scoping issues (Update: see my reply later in this thread):

        $ perl -wMstrict -e 'my $x = $_ for "a"; print $x' Use of uninitialized value $x in print at -e line 1.

        Regards,
        -- Hauke D

      Hi Haarg,

      my ($regex) = map qr/$_/, join '|', map {quotemeta} qw/. | %/;

      Excellent idea, thank you! I've updated the root node.

      Thanks,
      -- Hauke D

Re: Feature Idea: qr//e
by vr (Curate) on Jan 19, 2017 at 09:50 UTC
    my $regex = qr{(??{ join '|', map {quotemeta} qw/. | %/ })};

    No? Plus, it's eval'ed "before parsing a regex", while s///e is not about it at all.

      Hi vr,

      my $regex = qr{(??{ join '|', map {quotemeta} qw/. | %/ })};

      Another excellent idea, thank you! I've updated my root node.

      it's eval'ed "before parsing a regex", while s///e is not about it at all

      Yes, you're right, it was misleading of me to write that qr//e would be "analogous to s///e", since in s///e it's the replacement part that gets evaled, not the regex.

      Update: Your solution has the interesting feature that the code gets reevaluated every time:

      use Test::More; my @values = qw/abc def/; my $re = qr{^(??{ join '|', map {quotemeta} @values })$}i; like 'ABC', $re; like 'DEF', $re; unlike 'GHI', $re; push @values, 'ghi'; like 'ABC', $re; like 'DEF', $re; like 'GHI', $re; done_testing;

      Thanks,
      -- Hauke D

Re: Feature Idea: qr//e
by Anonymous Monk on Jan 18, 2017 at 15:17 UTC
    Plug in search of a hole -- it doesnt even qualify as a solution or problem -- adding more syntax ways to eval is just that horrible/useless

    i do applaud your courage in thinking out loud in public, not enough bad ideas get explored publically where they can be appreciated, more is needed

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1179847]
Front-paged by stevieb
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others sharing their wisdom with the Monastery: (11)
As of 2024-03-28 09:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found