Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

The Monastery Gates

( #131=superdoc: print w/replies, xml ) Need Help??

If you're new here please read PerlMonks FAQ
and Create a new user.

poll ideas quest 2022
Starts at: Jan 01, 2022 at 00:00
Ends at: Dec 31, 2022 at 23:59
Current Status: Active
4 replies by pollsters
    First, read How do I create a Poll?. Then suggest your poll here. Complete ideas are more likely to be used.

    Note that links may be used in choices but not in the title.

Perl News
Stackoverflow blog: Why Perl is still relevant in 2022
on Jul 07, 2022 at 11:28
2 replies by NetWallah
    Girish Venkatachalam has blogged "Why Perl is still relevant in 2022" on July 6, 2022.

    No new info there - it is interesting only because it purports to be positive for perl, is published on SO, and showed up on my Google news feed.

    The author seems to have somewhat dated knowledge of perl and no knowledge of raku.

                    "These opinions are my own, though for a small fee they be yours too."

Admins for RT
on Jul 05, 2022 at 15:02
1 reply by hippo

    TPF is calling for volunteers to assist with the administration of, specifically to help with keeping it free from spam. If you have the necessary time, skill and inclination please consider supporting this.


How to color the regex captured groups?
4 direct replies — Read more / Contribute
by ovedpo15
on Aug 12, 2022 at 12:32
    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.
How do I reference repeated capture groups?
4 direct replies — Read more / Contribute
on Aug 12, 2022 at 10:24
    Esteemed monks

    I stumbled over this 2 year old reddit-question from a user "onion" and am not too convinced about the answers given.

    Is using Regexp::Grammars really the only way to do it? Seems like overkill...

    Suppose I have this regular expression:
    my $re = qr{(\w+)(\s*\d+\s*)*}; How do I get every match matched by the second group?
    Using the regular numeric variables only gets me the last value matched, not the whole list:
    my $re = qr{(\w+)(\s*\d+\s*)*}; my $str = 'a 1 2 3 b 4 5 6'; while ($str =~ /$re/g) { say "$&: $1 $2"; } # output: # a 1 2 3 : a 3 # b 4 5 6: b 6

    How do I get every number that follows a letter in this example, and not just the last one?


    Bonus question:

    How do I do it if I have named groups? I.e. my $re = qr{(?<letter>\w+)(?<digit>\s*\d+\s*)*};

Comparing time strings from a list of HH:MM:SS times
2 direct replies — Read more / Contribute
by slugger415
on Aug 10, 2022 at 14:38

    Hello esteemed PerlMonks,

    I have a list of time strings in the HH:MM:SS format. I want to add each to a variable set with localtime and compare it to a timestamp later in the script. I'm having trouble understanding how to add that HH:MM:SS string to the localtime variable.

    #! /usr/bin/perl use Time::Piece; use strict; my(@times) = ("00:05:21","00:08:05","00:10:33"); my $startTime = localtime(); print "Start: ", $startTime, $/; foreach my $t (@times) { sleep 2; my $newTime = localtime(); my $ss = $startTime + $t; ### this is where I need advice if($ss > $newTime){ print "\$ss is greater.\n"; ### execute some functions here } print "Newtime: ", $newTime, $/; my $diff = $newTime - $startTime; print $diff, $/;

    The $diff part works but not the addition of $t, how do I add that time to it? Obviously I need to convert it to something Time::Piece understands.

    Thank you.

WWW::Mechanize and SSL
3 direct replies — Read more / Contribute
by Jonathan
on Aug 10, 2022 at 09:09

    Firstly, apologies as this is more a SSL issue than just Perl. I have an HTTPS url that I want to pull some data from (the url is another server on our local network). The url works fine with Chrome, MS Edge etc but I'm getting a certificate error running my test script from a dev server (Ubuntu). Also wget also fails with certificate errors.

    #!/usr/bin/perl use strict; use warnings; use WWW::Mechanize; use Net::SSLeay; my $m = WWW::Mechanize->new( autocheck => 1 ); print "LWP: $LWP::UserAgent::VERSION\n"; print "Mech: $WWW::Mechanize::VERSION\n"; print "Net::SSLeay $Net::SSLeay::VERSION\n"; my $url = $ARGV[0]; $m->get($url); print $m->content();
    Which outputs;
    $ ./ LWP: 6.43 Mech: 1.96 Net::SSLeay 1.88 Error GETing https://xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx: Can't conn +ect to xxxxxxxxxxx:443 (certificate verify failed) at ./ lin +e 15. $
    I suspect there is something available on the companies servers that satisfies browsers but isn't available elsewhere. Anyone seen this before and have any idea what I need to do? Thanks
Cool Uses for Perl
'rgb_palette' - Term::ANSIColor Helper
No replies — Read more | Post response
by kcott
on Aug 15, 2022 at 03:37

    G'day All,

    I've been playing around with Term::ANSIColor recently. I found the named colours to be very limited. The rgbRGB format provides additional colours but the codes are not particularly intuitive. Then I found rNNNgNNNbNNN; at first, I thought I'd need a different terminal but it turns out that it works just fine on my xterm.

    I'm quite familiar with the hex notation #rrggbb, but less so with the decimal equivalents; so I wrote myself a helper program: rgb_palette. I thought I'd share; but there are a few things you'd probably want to know up-front.

    • Obviously, you'll need a true color (aka direct-color) terminal.
    • Change the shebang line if it doesn't fit your setup.
    • Install IO::Prompter.
    • The code, as is, has "use v5.36;". You can downgrade this but, if you do, deal with the subroutine signatures (either turn off experimental warnings or rewrite the two short subroutines, e.g. "sub fg ($r, $g, $b) { ..." --> "sub fg { my ($r, $g, $b) = @_; ..."). Also, add in whatever pragmata you're no longer getting for free.
    • I use a black background. You may need to fiddle with some of the text colours if you use something else.
    • I initially had the hex values on each of the coloured swatches in either black or white. I found this distracting; change the commented code in fg() if you want to put it back that way. As it stands, the foreground and background colours are the same making the text invisible but the swatch colour more prominent. I just double-click on a swatch; middle-click to paste; then "Enter" to get the rNNNgNNNbNNN conversion.
    • I've aimed to get a lot of colours without needing a giant screen. You'll need 100 columns and scrolling will almost certainly be necessary. You can also type in your own hex codes if you want: the output shows a swatch of the input value as well as the rNNNgNNNbNNN code.

    Alright, that's enough blathering, here's the code:

    #!/usr/bin/env perl use v5.36; use IO::Prompter [ -style => 'bold blue', -echostyle => 'bold magenta', ]; use Term::ANSIColor; my @nums_under_255 = qw{0 26 51 77 102 127 153 179 204 230 243}; say ''; for my $r (@nums_under_255, 255) { for my $g (@nums_under_255, 255) { print ' '; for my $b (@nums_under_255) { print colored(text("r${r}g${g}b${b}"), join(' on_', fg($r, + $g, $b), "r${r}g${g}b${b}")); } say colored(text("r${r}g${g}b255"), join(' on_', fg($r, $g, 25 +5), "r${r}g${g}b255")); } } say ''; my $rgb; while (1) { $rgb = prompt 'Convert hex to decimal rgb (or just hit "Enter" to +quit): ', -return => ''; unless (length $rgb) { say ''; last; } if ($rgb =~ /^([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})$/) +{ my $ansi_rgb = sprintf 'r%dg%db%d', map hex, $1, $2, $3; print colored(' --> [', 'bold white'); print colored(' ' x 8, "$ansi_rgb on_$ansi_rgb"); print colored('] --> ', 'bold white'); say colored($ansi_rgb, 'bold cyan'); } else { say colored("\nERROR: '", 'r255g0b0 on_r51g51b51'), colored($rgb, 'r255g255b0 on_r51g51b51'), colored( "' is invalid. Six hexadecimal characters are expected +; such as in the table above.", 'r255g0b0 on_r51g51b51' ); } } sub fg ($r, $g, $b) { #return $r + 2 * $g + $b > 204 ? 'black' : 'white'; return "r${r}g${g}b${b}"; } sub text ($str) { return sprintf ' %02x%02x%02x ', $str =~ /^r(\d+)g(\d+)b(\d+)$/; }


    — Ken

Log In?

What's my password?
Create A New User
Domain Nodelet?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (2)
As of 2022-08-15 18:34 GMT
Find Nodes?
    Voting Booth?

    No recent polls found