Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

How to color the regex captured groups?

by ovedpo15 (Pilgrim)
on Aug 12, 2022 at 16:32 UTC ( [id://11146126]=perlquestion: print w/replies, xml ) Need Help??

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

Hi Monks!
I have a array of hashes. Each hash contains a rexes rule. Given a path, I'm trying to iterate over the rules and find the first matching rule.
I'm trying to add a small feature which will help users to debug (since the rexes are user custom) - I want to mark the groups in the given path. For example:
# Given path: /a/b/c/d # Given regex: ^/a/b/([^/]*)/([^\/]*) # Output: /a/b/\033[1;31mc\033[0m/\033[1;31md\033[0m
In this case I got: /a/b/[RED]c[/RED]/[RED]d[/RED].
The current code:
foreach $regex_href (@rexes) { %regex = %{$regex_href}; if (@captures = ($path =~ /$regex{'regex'}/)) { # Do logic } }
The @captures contains the group values that were captured (c and d in the example). I came a cross with the Term::ANSIColor module which can help me color the string without writing the color codes myself.
So, what would be the best way to create a variable $output that is basically $path but colored given the captured groups? You can assume that there are always at least two groups.

Replies are listed 'Best First'.
Re: How to color the regex captured groups?
by hv (Prior) on Aug 12, 2022 at 17:31 UTC

    You can use @- and @+ to find the offsets within the string of respectively the start and the end of each capture. If you collect those (annotated as start or end) and reverse sort them, you can then insert your formatting codes backwards from the end of the string without having to worry about offsets moving under your feet.

    How do you want it annotated if there are nested captures, such as with "foobar" =~ /f(o(ob)a)r/? The obvious choice would be to annotate them in different colours, but that then requires extra care - nested tags would need "f[GREEN]o[RED]ob[/RED]a[/GREEN]r", while non-nested would need "f[GREEN]o[RED]ob[GREEN]a[DEFAULT]r".

Re: How to color the regex captured groups?
by tybalt89 (Monsignor) on Aug 12, 2022 at 17:46 UTC
    #!/usr/bin/perl use strict; # https://perlmonks.org/?node_id=11146126 use warnings; # Given path: /a/b/c/d # Given regex: ^/a/b/([^/]*)/([^\/]*) # Output: /a/b/\033[1;31mc\033[0m/\033[1;31md\033[0m my ($boldred, $reset) = ( "\e[1;31m", "\e[0m" ); my $string = '/a/b/c/d/'; my $regex = qr{^/a/b/([^/]*)/([^\/]*)/}; $string =~ $regex or die "no match of $string by $regex"; my $coloredstring = $string; my $count = @- - 1; for ( reverse 1 .. $count ) { substr $coloredstring, $+[$_], 0, $reset; substr $coloredstring, $-[$_], 0, $boldred; } print "$coloredstring\n"; use Data::Dump 'dd'; dd 'coloredstring', $coloredstring;

    Outputs:

    /a/b/c/d/ ("coloredstring", "/a/b/\e[1;31mc\e[0m/\e[1;31md\e[0m/")
Re: How to color the regex captured groups?
by hippo (Bishop) on Aug 13, 2022 at 10:38 UTC
    So, what would be the best way

    Everyone will have different criteria for "best". Here, for example is the most generic approach to wrapping your capture groups inside an arbitrary string. This is best for teaching you how to achieve such a result in a perfectly general way without necessarily being the best way to achieve the stated objective. :-)

    use strict; use warnings; use Test::More tests => 1; my $str = '/a/b/c/d'; my $re = qr#^/a/b/([^/]*)/([^\/]*)#; my $want = "/a/b/\033[1;31mc\033[0m/\033[1;31md\033[0m"; my @caps = $str =~ $re; my $out = '/a/b/' . join '/', map {"\033[1;31m$_\033[0m"} @caps; is $out, $want, "Matched '$want'";

    🦛

Re: How to color the regex captured groups?
by kcott (Archbishop) on Aug 13, 2022 at 05:15 UTC

    G'day ovedpo15,

    I see others have shown you how to access the captured text.

    "I came a cross with the Term::ANSIColor module which can help me color the string without writing the color codes myself."

    I wasn't sure if you were asking for help using Term::ANSIColor. In case you were, here's a demo. I do recall that I found the documentation difficult to follow when I first used it. By the way, it's a core module: no need to install it.

    #!/usr/bin/env perl use strict; use warnings; use Term::ANSIColor; my $path = '/a/b/c/d'; my $re = qr{^/a/b/([^/]*)/([^\/]*)}; my $demo_fmt = '%-28s : '; printf $demo_fmt, 'Input - plain text from OP'; print "$path\n"; if (my @matches = $path =~ /$re/) { my $debug_path = $path; for (reverse 1 .. $#-) { substr $debug_path, $-[$_], $+[$_] - $-[$_], colored($matches[$_ - 1], 'red'); } printf $demo_fmt, 'Output - "c" & "d" are red'; print "$debug_path\n"; printf $demo_fmt, 'Output - internals of string'; use Data::Dump; dd $debug_path; }

    Prints:

    Input - plain text from OP : /a/b/c/d Output - "c" & "d" are red : /a/b/c/d Output - internals of string : "/a/b/\e[31mc\e[0m/\e[31md\e[0m"

    — Ken

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others browsing the Monastery: (None)
    As of 2024-04-25 00:35 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      No recent polls found