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

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.

Quests
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 rt.cpan.org, specifically to help with keeping it free from spam. If you have the necessary time, skill and inclination please consider supporting this.


    🦛

Supplications
TCP Server using fork to accept multiple requests
3 direct replies — Read more / Contribute
by Lucas Rey
on Aug 17, 2022 at 03:39
    Dear community, I'm trying to create a little server who handles multiple clients connections (at least 10). Below the current code that works perfect using fork. At least it accepts several connections from clients.

    With the below code, I have the following behaviour:
    - Client ask for connection ==> Accepted ==> OK
    - Client sent packet ==> Received and printed ==> OK
    - Client sent another packet ==> Not received ==> NOK

    Most probably, the while cicle will be activated only for each connection request, so that's the reason because I cannot retrieve other packets.

    Could someone help me please to adjust the below code? What I need is establish one (or more) client connection, then client send data continuosly (without disconnection) and server should reply on each packet it receives.

    Thank you
    Lucas

    #!/usr/bin/perl -w use IO::Socket::INET; $SIG{CHLD} = sub {wait ()}; my $socket = new IO::Socket::INET ( LocalHost => '0.0.0.0', LocalPort => '5000', Proto => 'tcp', Listen => 5, Reuse => 1); die "cannot create socket $!n" unless $socket; while ($new_sock = $socket->accept()) { $pid = fork(); die "Cannot fork: $!" unless defined($pid); if ($pid == 0) { # This is the fork child $new_sock->recv(my $data, 500); print "$data\n"; } }
The perl source directory structure
2 direct replies — Read more / Contribute
by syphilis
on Aug 16, 2022 at 08:21
    Hi,

    In the perl source, we find various modules in the 'cpan', 'dist' and 'ext' directories.
    What are the rules that determine which of those 3 directories houses which modules ?

    For example, why is it that POSIX is in the 'ext' directory, but threads is in the 'dist' directory ? (Why not the other way round ? Or why aren't they both in the same directory ?)

    Cheers,
    Rob
Nonrepeating characters in an RE
9 direct replies — Read more / Contribute
by BernieC
on Aug 15, 2022 at 19:32
    I have an odd problem that's hurting my head: I'm trying to construct an RE that will only match if the letter in any position does *NOT* match any other character in the string. I'm constructing this RE with a perl program and building the RE from a template. It is the *template* that says "these letters should be distinct" and then I want to run through a few thousand words to pick out the words that "match".

    For example, my "template" might look like this: "abcdefa" and I already have the code that generates (.)?????\1. I can't figure how to make the "?"s say "these guys all have to be distinct".

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
by TIOOWTDI
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?

    EDIT

    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.

Cool Uses for Perl
'rgb_palette' - Term::ANSIColor Helper
2 direct replies — Read more / Contribute
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+)$/; }

    Enjoy!

    — Ken

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (5)
As of 2022-08-17 13:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?