Planet Perl

The Science Perl Journal, Issue #1 (Vol. 1, No. 1) is finally here!

blogs.perl.org

Published by Brett Estrade on Friday 18 October 2024 04:32

After hundreds of hours of work and support from lots of people, the long promised Journal is here. That link will take you to some more information, on there a link to purchase is available. All proceeds go to supporting future Issues and events of the SPC and Perl Community Organization. At this time, an electronic version is not available due to end-of-year time constraints.

It may seem silly, but we spent extra time making sure the book spine looks good on a bookshelf and will look even better as the Issues accrue. Get it while it's hot. ISBN-13: 9798218984748, 152 pages.

Some of us are currently preparing for a block of Science Perl Talks at the London Perl & Raku Workshop 2024. We appreciate the organizers of this event for the opportunity.

More will be posted after the LPW, but the SPC is hosting the Perl Community Conference, Winter 2024 on December 18th (Perl's 37th birthday! :-)). If you are interested in getting published in the next Issue of the SPJ (Winter 2024), we are still accepting extended abstracts, which is up to 1 full page in the Journal and a 5 minute lightning talk slot at the Winter Conference.

This week in PSC (164) | 2024-10-17

blogs.perl.org

Published by Perl Steering Council on Friday 18 October 2024 00:39

This week, we talked about some recent (and less recent) p5p threads:

We discussed the sort thread briefly. We are waiting to see where it goes.
We talked again about TLS in core, and reviewed a document from the CPAN Security Group. We want to talk about this more in depth next week.
Discussion of the evalordie thread led us to talk about some form of in-core autodie pragma. We didn’t reach any conclusion.
We noted that a maint release is overdue.

Perl Weekly Challenge 291: Poker Hand Rankings

blogs.perl.org

Published by laurent_r on Thursday 17 October 2024 12:46

These are some answers to the Week 291, Task 2, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on October 20, 2024, at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 2: Poker Hand Rankings

A draw poker hand consists of 5 cards, drawn from a pack of 52: no jokers, no wild cards. An ace can rank either high or low.

Write a script to determine the following three things:

1. How many different 5-card hands can be dealt?

2. How many different hands of each of the 10 ranks can be dealt? See here for descriptions of the 10 ranks of Poker hands: https://en.wikipedia.org/wiki/List_of_poker_hands#Hand-ranking_categories

3. Check then the numbers you get in step 2 by adding them together and showing that they're equal to the number you get in step 1.

We need a subroutine (com) for computing the binomial coefficient formula for: n choose k. The simplest formula is: n! / k! (n - k)! But this leads to compute very large numbers that we then divide by other very large numbers. For example, 52! has 68 digits: 52! = 80658175170943878571660636856403766975289505440883277824000000000000. So I prefer to use a formula that considerably simplifies the fraction: n * (n - 1) * ... * (n - k + 1) / k!.
This ought to be faster, but that's not the point, since it is quite fast anyway; the point is that we avoid the risk of integer overflow during intermediate computations. There is no such risk in Raku, and probably also not in Perl, but there are many languages or programming environments that can't handle integers with 68 digits.

Poker Hand Rankings in Raku

See the previous section above for explanations on the com auxiliary subroutine, which really does the bulk of the work.

The poker-hands does only one thing: it populates a hash with the various hand types and their frequencies. This Wikipedia page provides a table with the mathematical expression of the absolute frequency of each hand type. The code did not really need a separate subroutine and could have been inserted in the main code, but I find it clearer this way, in a separate subroutine.

The rest of the program basically displays the hash in a form hopefully readable to the human eye.

sub com ($n, $k) {
    # Binomial coefficient formula for: n choose k
    my $nr_of_com = ([*] ($n - $k + 1)..$n)/([*] 1..$k); 
    return $nr_of_com;
}

sub poker-hands (){
    my %hands =
        "0. RF" => com(4, 1),  # Royal flush 
        "1. SF" => com(10, 1) * com(4, 1) - com(4, 1),
                               # Straight flush
        "2. FK" => com(13, 1) * com(12, 1) * com(4, 1),
                               # Four of a kind
        "3. FH" => com(13, 1) * com(4, 3) * com(12, 1)
            * com(4, 2),       # Full house
        "4. Fl" => com(13, 5) * com(4, 1) - com(10, 1)
            * com(4, 1),       # Flush (excl. RF and SF)
        "5. St" => com(10, 1) * com(4, 1)**5 - com(10, 1)
            * com(4, 1),       # Straight (excl. RF and SF)
        "6. TK" => com(13, 1) * com(4, 3) * com(12, 2)
            * com(4, 1) ** 2,  # Three of a kind
        "7. TP" => com(13, 2) * com(4, 2)**2 *com(11, 1) 
            * com(4, 1),       # Two pairs
        "8. OP" => com(13, 1) * com(4, 2) * com(12, 3)
            * com(4, 1)**3,    # One pair
        "9. NP" => (com(13, 5) - com(10,1)) * (com(4, 1)**5
            - com(4, 1)),      # No pair (or High card)
    ;
    return %hands;
}

my %hand-count = poker-hands;
my $num-hands = com 52, 5;
say "Total number of hands (direct count) => $num-hands";

for %hand-count.keys.sort -> $key {
    say "  - $key => ", %hand-count{$key};
}
say "Sum of the hands by type => ", [+] %hand-count.values;

This program displays the following output:

    $ raku ./poker-hands.raku
    Total number of hands (direct count) => 2598960
      - 0. RF => 4
      - 1. SF => 36
      - 2. FK => 624
      - 3. FH => 3744
      - 4. Fl => 5108
      - 5. St => 10200
      - 6. TK => 54912
      - 7. TP => 123552
      - 8. OP => 1098240
      - 9. NP => 1302540
    Sum of the hands by type => 2598960

Poker Hand Rankings in Perl

This program is essentially a port to Perl of the above Raku program. Please refer to the previous sections if you need explanations.

There is one important change, though: rather than using hand abbreviations (RF, SF, FK, etc.) for the hash keys, it uses hand full name (Royal flush, Straight flush, Four of a kind, etc.), leading to more explicit output.

use strict;
use warnings;
use feature 'say';

sub com  {
    # Binomial coefficient formula for: n choose k
    my ($n, $k) = @_;
    my $fact_k = 1;
    $fact_k *= $_ for 1..$k;
    my $nr_of_com_numerator = 1;
    $nr_of_com_numerator *= $_ for ($n -$k + 1)..$n;
    return $nr_of_com_numerator/ $fact_k;
}

sub poker_hands {
    my %hands =
       ("0. Royal flush" => com(4, 1),
        "1. Straight flush" => com(10, 1) * com(4, 1) 
            - com(4, 1),
        "2. Four of a kind" => com(13, 1) * com(12, 1) 
            * com(4, 1),
        "3. Full house" => com(13, 1) * com(4, 3) 
            * com(12, 1) * com(4, 2), 
        "4. Flush" => com(13, 5) * com(4, 1) - com(10, 1)
            * com(4, 1),       # Flush (excl. RF and SF)
        "5. Straight" => com(10, 1) * com(4, 1)**5 - com(10, 1)
            * com(4, 1),       # Straight (excl. RF and SF)
        "6. Three of a kind" => com(13, 1) * com(4, 3) 
            * com(12, 2) * com(4, 1) ** 2,
        "7. Two pairs" => com(13, 2) * com(4, 2)**2 
            * com(11, 1) * com(4, 1), 
        "8. One pair" => com(13, 1) * com(4, 2) * com(12, 3)
            * com(4, 1)**3,    # 
        "9. No pair" => (com(13, 5) - com(10,1)) 
            * (com(4, 1)**5 - com(4, 1)),      
            # No pair or High card
    );
    return %hands;
}

my %hand_count = poker_hands;
my $num_hands = com 52, 5;
say "Total number of hands (direct count) => $num_hands";

for my $key (sort keys %hand_count) {
    printf "  - %-20s => %-10i \n", $key, $hand_count{$key};
}
my $sum = 0;
$sum += $_ for values %hand_count;
say "Sum of the hands by type => ", $sum

This program displays the following output:

    $ perl ./poker-hands.pl
    Total number of hands (direct count) => 2598960
      - 0. Royal flush       => 4
      - 1. Straight flush    => 36
      - 2. Four of a kind    => 624
      - 3. Full house        => 3744
      - 4. Flush             => 5108
      - 5. Straight          => 10200
      - 6. Three of a kind   => 54912
      - 7. Two pairs         => 123552
      - 8. One pair          => 1098240
      - 9. No pair           => 1302540
    Sum of the hands by type => 2598960

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on October 27, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

Look in to Julia

blogs.perl.org

Published by gg on Thursday 17 October 2024 12:18

To the old Perl programmers out there looking for a new language to learn, I suggest giving Julia a serious look. I haven't had a language bring me this much joy since when I first discovered Perl a long time ago. If Perl is the grandpa, Julia is the granddaughter, and she's a really smart girl. She hangs out with scientists all day helping them make sense of their data, and she does it with a unique style.

To be continued...

(There's so much I want to say, but I don't want to commit the time to write it all down right now.)

Update TiddlyWikis

blogs.perl.org

Published by Ron Savage on Thursday 17 October 2024 09:54

The Perl wiki has been renamed from Perl.html - which was too generic - to Perl.Wiki.html:
https://savage.net.au/misc/Perl.Wiki.html

The Mojolicious wiki is at:
https://savage.net.au/misc/Mojolicious.Wiki.html

The Debian wiki is at:
https://savage.net.au/misc/Debian.Wiki.html

The Personal Security wiki is at:
https://symboliciq.au/misc/Personal.Security.Wiki.html

(Not updated actually...) The Symbolic Language wiki is at:
https://symboliciq.au/misc/Symbolic.Language.Wiki.html

Understanding the Financials of The Perl and Raku Foundation (TPRF)

r/perl

Published by /u/oalders on Thursday 17 October 2024 02:31

submitted by /u/oalders
[link] [comments]

Getting internal server error in my perl cgi script on the line: use CGI qw(:standard); [closed]

Perl questions on StackOverflow

Published by mmartiss on Thursday 17 October 2024 00:51

I am trying to run an apache web server, which would take my html form, process it, and would give some kind of answer. I had problems installing cgi, configuring it, but I managed to do it. Now I am getting an error "internal server error" when I am trying to check the perl script using curl. When I check the apache error logs, it says that it aborted because of the 3 line, which is: use CGI qw(:standard);

Here is my simple code:

#!/usr/bin/perl
use strict;
use warnings;
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);

# Enable taint mode
use diagnostics;

print "Content-type: text/html\n\n";
# print header(-type => 'text/html', -charset => 'utf-8'). 
#     start_html('Form Submission Results');

my $sequence = param('sequence');
my $alignment_type = param('alignment-type');
my $organism = param('organism');
my $sequence_length = param('sequence-length');
my $confidence_level = param('confidence-level');

# Check for missing data
if (!$sequence || !$alignment_type || !$organism || !$sequence_length || !$confidence_level) {
    print h1("Error: Missing Data");
    print p("Please fill all the fields.");
    print end_html;
    exit;
}

# Basic validation (simulating complex processing)
if ($sequence !~ /^[ACGT]+$/i) {
    print h1("Error: Invalid Sequence");
    print p("Sequence must contain only A, C, G, or T for DNA.");
    print end_html;
    exit;
}

# Simulate processing
print h1('Sequence Alignment Results');
print p("Alignment Type: $alignment_type");
print p("Organism: $organism");
print p("Sequence Length: $sequence_length");
print p("Confidence Level: $confidence_level");

print end_html;

I have tried removing cgi use lines, then I get no error, but then server doesn't return anything.

Perlmonks site down - "we're performing some maintenance on our database"

r/perl

Published by /u/ContributionEastern7 on Wednesday 16 October 2024 20:35

Does anyone know how long perlmonks.org will be down?

submitted by /u/ContributionEastern7
[link] [comments]

Cygwin Perl won't load DLLs anymore, perhaps due to a failure to convert cygwin paths to Windows paths

Perl questions on StackOverflow

Published by Phil Goetz on Wednesday 16 October 2024 19:11

I'm suddenly unable to run any Perl scripts under Cygwin. Every script I try to run crashes like this:

phil@TAICHI /cygdrive/h/bakE/new/virChecked
$ findFiles -s . -t /cygdrive/D/data-comp/text -u /cygdrive/E/new/virChecked/text -d -a .3
Can't load '/home/phil/perl5/lib/perl5/x86_64-cygwin-threads-multi/auto/Win32/File/File.dll' for module Win32::File: No such file or directory at /usr/lib/perl5/5.36/x86_64-cygwin-threads/DynaLoader.pm line 206.
 at /usr/local/bin/findFiles line 24.
Compilation failed in require at /usr/local/bin/findFiles line 24.
BEGIN failed--compilation aborted at /usr/local/bin/findFiles line 24.

phil@TAICHI /cygdrive/h/bakE/new/virChecked
$ pushd /home/phil/perl5/lib/perl5/x86_64-cygwin-threads-multi/auto/Win32/File/
~/perl5/lib/perl5/x86_64-cygwin-threads-multi/auto/Win32/File /cygdrive/h/bakE/new/virChecked

phil@TAICHI ~/perl5/lib/perl5/x86_64-cygwin-threads-multi/auto/Win32/File
$ ls -l File.dll
-r-xr-xr-x 1 phil None 178K Jul 14  2021 File.dll*

Sometimes perl won't open File.dll; sometimes it won't open IO.dll. In either case, the DLL is always exactly where Perl is looking for it, with world read privs; but Perl won't load it.

Line 206 of Dynaloader.pm is

my $libref = dl_load_file($file, $flags) or croak("Can't load '$file' for module $module: ".dl_error());

A comment near the start of Dynaloader says:

The load function that dl_load_file() calls may require an absolute pathname.

I can't find where dl_load_file() is defined. It isn't in Dynaloader.pm; and the only module Dynaloader includes is Config, which also doesn't have it, and includes no other files.

I suspect that some Perl module has changed, with the result that dl_load_file doesn't convert Cygwin absolute pathnames to Windows absolute pathnames. I tried reinstalling Perl 5.36.3-1, but it didn't help. I also made a new Cygwin installation and installed Perl 5.40, but it behaved the same way.

Questions:

Is anyone else currently able to use Perl in Cygwin using the lastest Cygwin packages?
Any idea what might have changed recently to make Cygwin Perl unable to use full Cygwin paths?
Where can I find a Cygwin perl distribution prior to Perl 5.32?

POSTSCRIPT added October 13: I've gotten a lot of comments, but not one person has yet answered the simple question of whether THEY currently have a working version of Cygwin Perl. Please, someone, if you have a recent Cygwin Perl that still works, say so.

How to Run a Perl Script in Linux — A Simple Guide for Beginners

Perl on Medium

Published by Noman Mohammad on Wednesday 16 October 2024 11:26

Are you new to Linux and wondering how to run a Perl script on your system? If you’re just starting with Linux or Perl, don’t worry…

Continue reading on Medium »

How to use perltidy to reformat code in Visual Studio Code

Perl questions on StackOverflow

Published by horshack on Wednesday 16 October 2024 08:22

Windows, Visual Studio Code. I have installed the extension: "Perl Navigator" and perl is installed in my computer system, perltidy is installed. The code in a file is like this:

#!/usr/bin/perl
use strict;
use          warnings ;
use Params::Validate;

my $x     =4;
my    $y = "AB";

What can I do to reformat this code with perltidy with Visual Studio Code?

In vim I do this:

ESC :1,$!perltidy

I installed several extensions for Visual Studio Code but none of these tell me how to use them.

London Perl & Raku Workshop: 10 Days To Go

r/perl

Published by /u/leejo on Wednesday 16 October 2024 06:12

London Perl & Raku Workshop: 10 Days To Go

submitted by /u/leejo
[link] [comments]

Net::SMTP with a BCC

r/perl

Published by /u/csdude5 on Wednesday 16 October 2024 06:01

I use Net::SMTP to send emails when a user requests data, and I have the email BCC'ed to my personal Gmail. But while it appears that the user does get the email (even when using Gmail), it's not showing up in my Gmail.

Any suggestions on what the problem might be?

I'm using these modules:

use Net::SMTP; use MIME::Lite; use Digest::MD5 qw(md5_hex);

And this is the script:

$from = 'noreply@example.com'; $login_pass = 'blahblahblah'; $messageID = time(); $msg = MIME::Lite ->new ( From=> "Me <$from>", To=> "recipient@gmail.com", Bcc=> 'me@gmail.com', Subject=> "Subject", 'Message-ID'=> '<' . $messageID . '-' . md5_hex($from) . '-' . md5_hex($found_email) . '@example.com>', Type=> 'multipart/alternative' ); $msg->attach( Type => 'text/plain', Encoding=> 'quoted-printable', Data=> qq~ Plain text version of email ~ ); $msg->attach( Type => 'text/html', Data=> qq~ <b>HTML version of the email</b> ~ ); $msg->scrub(['x-mailer', 'Content-Disposition']); $smtp = Net::SMTP->new( 'mail.example.com', Port => 465, SSL => 1 ); $smtp->auth($from, $login_pass) or die('Could not authenticate'); $smtp->mail($from); if ($smtp->to($found_email)) { $smtp->data(); $smtp->datasend( $msg->as_string() ); $smtp->dataend(); }

submitted by /u/csdude5
[link] [comments]

PSC – “Perl (re)branding ideas”?

r/perl

Published by /u/Drogoslaw_ on Tuesday 15 October 2024 22:42

The notes from the latest meeting of the Perl Steering Council mention:

We exchanged Perl (re)branding ideas with Olaf [Alders]. We will be keeping in touch on that front.

Does anyone here know whether this is only about the camel logo owned by O'Reilly or if there are some bigger changes coming (Perl 7?)?

submitted by /u/Drogoslaw_
[link] [comments]

regexec.c: Remove no-value-added function

Perl commits on GitHub

Published by khwilliamson on Tuesday 15 October 2024 16:28

regexec.c: Remove no-value-added function

This function merely calls an inline one.  Might as well not have any
indirection.

How to pass JSON using WWW::Mechanize in perl

Perl questions on StackOverflow

Published by Nilesh on Tuesday 15 October 2024 15:21

We are using WWW::Mechanize to send json data to our api.

My code is below.

#!/usr/local/bin/perl

use WWW::Mechanize;

sub get_csrf_token {
    my $sso = shift;
    my $referer = shift;
    my @cookie_items;
    my $rsp = $sso->get($referer);
    my $set_cookie = $rsp->header('set-cookie');
    if ($set_cookie =~ /csrftoken=(\S+);/) {
        push(@cookie_items, $1);
    }
    if ($set_cookie =~ /sessionid=(\S+);/) {
        push(@cookie_items, $1);
    }
    else {
        die 'Failed to get CSRF Token';
    }
    return @cookie_items;
}

my $sso = WWW::Mechanize->new(
        keep_alive  => 0,
        timeout     => 3000,
        stack_depth => 1,
        debug       => 1,
        verbose     => 1,
        key         => "/home/user/.athenz/key",
        cert        => "/home/user/.athenz/cert",
    );

my $referer = "https://myapi.domain.com/athenz/api/healthcheck/";
my @cookies = get_csrf_token($sso, $referer);
$sso->add_header('Referer' => $referer);
$sso->add_header('X-CSRFToken' => $cookies[0]);
$sso->add_header('Cookie' => "sessionid=$cookies[1]; csrftoken=$cookies[0]");

my %content = (
          'value' => '127.0.0.1',
          'key_name' => 'NTP_SERVERS'
);

my $response = $sso->put("https://myapi.domain.com/athenz/api/NTP_SERVERS/", \%content);

print "^^^^^^^^^^^^^^^^^^^^^^^^^\n";
print $response->code();
print "\n^^^^^^^^^^^^^^^^^^^^^^^^^\n";

its give me error Error PUTing https://myapi.domain.com/athenz/api/NTP_SERVERS/: Bad Request at /tmp/test.pm line 53

When I check server logs, its seems, the payload which I am sending, is deliver to server as HASH instead of json.

Below is apache logs.

[Mon Oct 07 18:32:27.987189 2024] [ssl:info] [pid 19745:tid 19745] [client 127.0.0.1:58372] AH01964: Connection to child 29 established (server myapi.domain.com:443)
[Mon Oct 07 18:32:27.987600 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(140): [client 127.0.0.1:58372] mod_dumpio: dumpio_in [init-blocking] 0 readbytes
[Mon Oct 07 18:32:27.987964 2024] [ssl:debug] [pid 19745:tid 19745] ssl_engine_kernel.c(2393): [client 127.0.0.1:58372] AH02043: SSL virtual host for servername myapi.domain.com found
[Mon Oct 07 18:32:27.992817 2024] [ssl:debug] [pid 19745:tid 19745] ssl_engine_kernel.c(2256): [client 127.0.0.1:58372] AH02041: Protocol: TLSv1.2, Cipher: ECDHE-RSA-AES128-GCM-SHA256 (128/128 bits)
[Mon Oct 07 18:32:27.992936 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(140): [client 127.0.0.1:58372] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:32:27.993929 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(63): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): 53 bytes
[Mon Oct 07 18:32:27.993964 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(103): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): PUT /athenz/api/NTP_SERVERS/ HTTP/1.1

[Mon Oct 07 18:32:27.994033 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(140): [client 127.0.0.1:58372] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:32:27.994047 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(63): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): 24 bytes
[Mon Oct 07 18:32:27.994056 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(103): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): TE: deflate,gzip;q=0.3

[Mon Oct 07 18:32:27.994065 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(140): [client 127.0.0.1:58372] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:32:27.994089 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(63): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): 23 bytes
[Mon Oct 07 18:32:27.994093 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(103): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): Connection: TE, close

[Mon Oct 07 18:32:27.994100 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(140): [client 127.0.0.1:58372] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:32:27.994104 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(63): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): 23 bytes
[Mon Oct 07 18:32:27.994123 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(103): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): Accept-Encoding: gzip

[Mon Oct 07 18:32:27.994127 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(140): [client 127.0.0.1:58372] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:32:27.994132 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(63): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): 45 bytes
[Mon Oct 07 18:32:27.994135 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(103): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): Host: myapi.domain.com

[Mon Oct 07 18:32:27.994139 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(140): [client 127.0.0.1:58372] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:32:27.994143 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(63): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): 84 bytes
[Mon Oct 07 18:32:27.994147 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(103): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): Referer: https://myapi.domain.com/athenz/api/healthcheck/

[Mon Oct 07 18:32:27.994151 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(140): [client 127.0.0.1:58372] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:32:27.994155 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(63): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): 32 bytes
[Mon Oct 07 18:32:27.994158 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(103): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): User-Agent: WWW-Mechanize/1.72

[Mon Oct 07 18:32:27.994185 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(140): [client 127.0.0.1:58372] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:32:27.994190 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(63): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): 128 bytes
[Mon Oct 07 18:32:27.994193 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(103): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): Cookie: sessionid=XXXXXXX; csrftoken=YYYYYYY

[Mon Oct 07 18:32:27.994198 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(140): [client 127.0.0.1:58372] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:32:27.994201 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(63): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): 19 bytes
[Mon Oct 07 18:32:27.994205 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(103): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): HASH(0x1d5b760):

[Mon Oct 07 18:32:27.994209 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(140): [client 127.0.0.1:58372] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:32:27.994213 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(63): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): 79 bytes
[Mon Oct 07 18:32:27.994217 2024] [dumpio:trace7] [pid 19745:tid 19745] mod_dumpio.c(103): [client 127.0.0.1:58372] mod_dumpio:  dumpio_in (data-TRANSIENT): X-CSRFToken: YYYYYYY

[Mon Oct 07 18:32:27.994223 2024] [core:debug] [pid 19745:tid 19745] protocol.c(1290): [client 127.0.0.1:58372 {YRA:127.0.0.1:58372, YPA:127.0.0.1:58372}] AH02426: Request header field name is malformed: HASH(0x1d5b760):, referer: https://myapi.domain.com/athenz/api/healthcheck/
[Mon Oct 07 18:32:27.994328 2024] [core:debug] [pid 19745:tid 19745] protocol.c(1482): [client 127.0.0.1:58372 {YRA:127.0.0.1:58372, YPA:127.0.0.1:58372}] AH00567: request failed: error reading the headers, referer: https://myapi.domain.com/athenz/api/healthcheck/

If I use same API with curl, it works fine and apache logs gives no error.

curl --cert ~/.athenz/cert --key ~/.athenz/key -H "Content-type: application/json" -H "X-CSRFToken: $TOKEN" --referer "https://myapi.domain.com/athenz/api/healthcheck/" --cookie "csrftoken=$TOKEN;sessionid=$SESSIONID;" "https://myapi.domain.com/athenz/api/NTP_SERVERS/" -X PUT -d '{"key_name": "NTP_SERVERS", "value": "98.139.133.27"}' -i
HTTP/1.1 200 OK
Date: Mon, 07 Oct 2024 18:26:50 GMT
P3P: policyref="https://policies.domain.com/w3c/p3p.xml", CP="CAO DSP COR CUR ADM DEV TAI PSA PSD IVAi IVDi CONi TELo OTPi OUR DELi SAMi OTRi UNRi PUBi IND PHY ONL UNI PUR FIN COM NAV INT DEM CNT STA POL HEA PRE LOC GOV"
Allow: GET, PUT, DELETE, HEAD, OPTIONS
X-Frame-Options: DENY
Vary: Cookie
Content-Length: 0
Access-Control-Allow-Methods: GET, PUT, POST, DELETE, OPTIONS
Access-Control-Allow-Credentials: true
X-Content-Type-Options: nosniff
Referrer-Policy: same-origin
Set-Cookie: csrftoken=YYYYYYYYYYY; Domain=.domain.com; expires=Mon, 06 Oct 2025 18:26:53 GMT; Max-Age=31449600; Path=/; SameSite=Lax
Set-Cookie: sessionid=XXXXXXXXXXXX; expires=Mon, 21 Oct 2024 18:26:53 GMT; HttpOnly; Max-Age=1209600; Path=/; SameSite=Lax
Cache-Control: private
Connection: close

The apache logs, which print the json I passed in the curl.

[Mon Oct 07 18:26:50.576736 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(140): [client 127.0.0.1:57073] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:26:50.935742 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(63): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): 53 bytes
[Mon Oct 07 18:26:50.935767 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(103): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): PUT /athenz/api/NTP_SERVERS/ HTTP/1.1

[Mon Oct 07 18:26:50.935821 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(140): [client 127.0.0.1:57073] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:26:50.935840 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(63): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): 31 bytes
[Mon Oct 07 18:26:50.935844 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(103): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): Host: myapi.domain.com

[Mon Oct 07 18:26:50.935848 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(140): [client 127.0.0.1:57073] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:26:50.935852 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(63): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): 24 bytes
[Mon Oct 07 18:26:50.935857 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(103): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): User-Agent: curl/8.7.1

[Mon Oct 07 18:26:50.935863 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(140): [client 127.0.0.1:57073] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:26:50.935867 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(63): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): 13 bytes
[Mon Oct 07 18:26:50.935871 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(103): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): Accept: */*

[Mon Oct 07 18:26:50.935875 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(140): [client 127.0.0.1:57073] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:26:50.935880 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(63): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): 43 bytes
[Mon Oct 07 18:26:50.935883 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(103): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): Referer: https://myapi.domain.com/api/healthcheck/

[Mon Oct 07 18:26:50.935887 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(140): [client 127.0.0.1:57073] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:26:50.935890 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(63): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): 128 bytes
[Mon Oct 07 18:26:50.935894 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(103): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): Cookie: csrftoken=YYYYYYYY;sessionid=XXXXXXX;

[Mon Oct 07 18:26:50.935908 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(140): [client 127.0.0.1:57073] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:26:50.935913 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(63): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): 32 bytes
[Mon Oct 07 18:26:50.935917 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(103): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): Content-type: application/json

[Mon Oct 07 18:26:50.935922 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(140): [client 127.0.0.1:57073] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:26:50.935926 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(63): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): 79 bytes
[Mon Oct 07 18:26:50.935930 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(103): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): X-CSRFToken: YYYYYYYYY

[Mon Oct 07 18:26:50.935934 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(140): [client 127.0.0.1:57073] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:26:50.935937 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(63): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): 20 bytes
[Mon Oct 07 18:26:50.935942 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(103): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): Content-Length: 91

[Mon Oct 07 18:26:50.935946 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(140): [client 127.0.0.1:57073] mod_dumpio: dumpio_in [getline-blocking] 0 readbytes
[Mon Oct 07 18:26:50.935949 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(63): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): 2 bytes
[Mon Oct 07 18:26:50.935953 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(103): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT):

[Mon Oct 07 18:26:50.937521 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(140): [client 127.0.0.1:57073] mod_dumpio: dumpio_in [readbytes-blocking] 91 readbytes
[Mon Oct 07 18:26:50.937532 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(63): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): 91 bytes
[Mon Oct 07 18:26:50.937537 2024] [dumpio:trace7] [pid 19725:tid 19725] mod_dumpio.c(103): [client 127.0.0.1:57073] mod_dumpio:  dumpio_in (data-TRANSIENT): {"key_name": "NTP_SERVERS", "value": "98.139.133.27"}
[Mon Oct 07 18:26:50.937558 2024] [ssl:info] [pid 19725:tid 19725] [client 127.0.0.1:57073 {YRA:127.0.0.1:57073, YPA:127.0.0.1:57073}] AH02221: Requesting connection re-negotiation, referer: https://myapi.domain.com/api/healthcheck/

How can I make sure, perl script pass json data to the apache server? I tried setting Content-Type: application/json, that didnt work.

perlapi: Rmv extraneous minus sign

Perl commits on GitHub

Published by khwilliamson on Tuesday 15 October 2024 14:54

perlapi: Rmv extraneous minus sign

Mojolicious::Plugin::OpenAPI 404 error when posting

Perl questions on StackOverflow

Published by smith on Tuesday 15 October 2024 14:01

I am running this snippet of code from the module synopsis using strawberry Perl :

use Mojolicious::Lite;
 
# Because the route name "echo" matches the "x-mojo-name", this route
# will be moved under "basePath", resulting in "POST /api/echo"
post "/echo" => sub {
 
  # Validate input request or return an error document
  my $c = shift->openapi->valid_input or return;
 
  # Generate some data
  my $data = {body => $c->req->json};
 
  # Validate the output response and render it to the user agent
  # using a custom "openapi" handler.
  $c->render(openapi => $data);
}, "echo";
 
# Load specification and start web server
plugin OpenAPI => {url => "data:///swagger.yaml"};
app->start;
 
__DATA__
@@ swagger.yaml
swagger: "2.0"
info: { version: "0.8", title: "Echo Service" }
schemes: ["https"]
basePath: "/api"
paths:
  /echo:
   post:
     x-mojo-name: "echo"
     parameters:
     - { in: "body", name: "body", schema: { type: "object" } }
     responses:
       200:
         description: "Echo response"
         schema: { type: "object" }

Then run the script as a daemon which listen on port 3000 after that i am running Curl as the below from the same machine

curl -X POST http://127.0.0.1:3000/api/echo -H "Content-Type : application/json" -d "{ \"key\" : \"value\" }"

my expection to render the __DATA__ section but i am getting this error

{"errors":[{"message":"Expected  - got *\/*.","path":"\/header\/Accept"}],"status":400}

any idea what could be the problem ?

fix authors after previous commit

Perl commits on GitHub

Published by iabyn on Tuesday 15 October 2024 09:49

fix authors after previous commit

Table subset searching with a list and DBIx::Class

dev.to #perl

Published by Paul Cochrane 🇪🇺 on Monday 14 October 2024 22:00

When searching for a subset of rows in a database table by using a list of entries in one of its columns, one can use the WHERE column_name IN list syntax in an SQL query. How to do this using DBIx::Class wasn’t obvious to me; at least, not by reading the docs. I worked it out eventually. Here’s what I learned.

This won’t be new to many people, but it was new to me and I couldn’t find the part of the docs where this is discussed, so I thought I’d write it up here for my future self to find.

Subset selecting in SQL

Imagine this situation: you have a database table from which you want to select a subset of its rows depending upon known values of one of its columns. Take this data for example, which represents possible failure states in an application:

id	name	severity
0	Ok	0
1	Warning	1
2	Critical	2
3	Error	3
4	Degradation	1
5	Mismatch	1
6	Contamination	2
7	Unknown	-1

Now imagine that not all parts of the application use all failure states. Some only need to use Ok, Warning, Critical, and Error, while others use Ok, Degradation, Mismatch and Unknown. How does one pull out the rows only of interest to that specific part of the application? One way to do this would be like so (note: I’m still a bit of an SQL noob, so be nice to me):

SELECT * FROM failure_states WHERE name IN ('Ok', 'Degradation', 'Mismatch', 'Unknown');

That’s cool. Now, I’ve been working more with DBIx::Class recently, having spent the last several years working almost only with Django and its ORM, hence I’m also a DBIx::Class noob. Anyway, I wanted to do this lookup from DBIx::Class and only stumbled across the example mentioned in the search docs for DBIx::Class::ResultSet, i.e. this bit:

my @cds = $cd_rs->search({ year => 2001 }); # "... WHERE year = 2001"
my $new_rs = $cd_rs->search({ year => 2005 });

my $new_rs = $cd_rs->search([{ year => 2005 }, { year => 2004 }]);
               # year = 2005 OR year = 2004

Using this pattern to solve the problem above yields code like this:

my @states = FailureState->search(
    [
        { name => 'Ok' },
        { name => 'Degradation' },
        { name => 'Mismatch' },
        { name => 'Unknown' },
    ]
);

That, as one might say in the New Zealand vernacular, is fugling uckly. Putting things another way, there’s a lot of duplication here, which doesn’t make this solution DRY and it’s not a pattern that would scale well. It works, but surely there’s a better way, right?

Simpler subsets in DBIx::Class

It turns out that yes, there is a better way, and as is often the case, I found an appropriate answer on StackOverflow. Also, because this is Perl, there is more than one way to do it. For instance with the = operator within a search() method call:

my @state_names = qw(Ok Degradation Mismatch Unknown);
my @states = FailureState->search(
    {
        name => { '=' => [@state_names] }
    }
);

This probably does something like WHERE name = $state_name in the background … I guess? I’m not sure about the details here, so I’m going to be content with waving my arms as an explanation.

Alternatively, one can use a syntax reminiscent of the WHERE column_name IN list syntax:

my @state_names = qw(Ok Degradation Mismatch Unknown);
my @states = FailureState->search(
    {
        name => { -in => [@state_names] }
    }
);

But why use several lines when only two are sufficient? One can be more direct and pass an arrayref:

my @state_names = qw(Ok Degradation Mismatch Unknown);
my @states = FailureState->search( { name => \@state_names } );

Nice!

Good enough for now

I’m sure there are other and better ways of doing this. Even so, this change has simplified my code nicely. Also, I learned something new today, which was cool :-)

clarify the comparison between 'our' and 'use vars'

Perl commits on GitHub

Published by book on Monday 14 October 2024 17:53

clarify the comparison between 'our' and 'use vars'

Fixes GH #22424

Perl Weekly #690 - London Perl & Raku Workshop 2024

dev.to #perl

Published by Gabor Szabo on Monday 14 October 2024 06:43

Originally published at Perl Weekly 690

Hi there,

Happy Hacking everyone !!!

I hope you are busy contributing during this year Hacktoberfest. We are half way through already but still plenty of time left to kickstart if not done already.

How about LPW 2024?

Well it is less than 2 weeks before the much awaited London Perl & Raku Workshop 2024 begins the fun. I am very happy to see the support of Perl community in general. It is great to see regular names in the list of sponsors, specially my current employer Oleeo as Gold sponsor. Thank you, Lee Johnson, for all the hardwork, managing the event so smoothly so far. I am confident it would be a memorable event for everyone.

Those who are planning to attend the event, there would be Pre Workshop Social and Post Workshop Social. Please register your details asap. I have once attended pre workshop social in the past as the usual venue is not my favourite spot. Having said, I am planning to break the tradition this year and planning to attend post social workshop. How can I miss the opportunity to meet my techie friends.

Have you seen the favourite talks list?

I am personally looking forward to attend the talks e.g. Perl in 2030, Cloudy Perl, how it looks now, A modern introduction to XS. Also my own talk, What's new in Perl v5.40?. I happy to see the some familiar names shown interest in my talk. I can't wait to present my talk.

I am also looking forward to meet some of my techie friends after a long time. Recently I found out one coming all the way from Canada. I am wondering if anyone coming from Japan. In the past, we always had speaker from Japan. I hope to see the familiar face this time too. Anyone from Germany? We will all find out first thing at the registration desk on the day.

As the October arrived, it also brought the dull weather with it. I don't have good memory about it. I hope it passes without creating any havoc. You take extra care of your health, specially mental and enjoy rest of the newsletter.

--
Your editor: Mohammad Sajid Anwar.

Announcements

Weather::OWM released on CPAN

A new module, Weather::ORM just arrived. The OpenWeather API has a Free tier with both current weather and forecast, which makes the module useful to anyone interested in fetching weather for any location.

Articles

This week in PSC (163) | 2024-10-10

Olaf Alders joined this week PSC meeting exchanged ideas.

Why The Perl and Raku Foundation Supports The Open Source Pledge

The Open Source Pledge consists of companies with a shared commitment to paying the maintainers of the open source software they consume, therefore aims to help address sustainability challenges facing the Open Source community.

How to create a parallel echo server using goroutines in SPVM?

Create a parallel echo server using SPVM::IO::Socket::IP and goroutines, channels, select in SPVM::Go.

How to generate an executable file for an AI program using SPVM ?

Wouldn't you like to output a single executable file from your AI program? Then, you can run the AI program just by copying the executable file to the Raspberry Pi.

wxPerl Revival

This is the beginning of wxPerl revival. Please do support the initiative.

Web

London Perl & Raku Workshop 2024 Gold Sponsor: Oleeo

Oleeo is an award-winning provider of innovative talent acquisition technology. Built using intelligent automation and machine learning, Oleeo’s platform helps companies discover unlimited sourcing potential to attract, engage and hire amazing, diverse teams that change the world for the better.

London Perl & Raku Workshop 2024 Silver Sponsors

Geekuni can give software developers with no previous Perl experience the training they need, as they need it. Geizhals Preisvergleich is one of the largest product and price comparison platforms in the German-speaking area.

Grants

Maintaining Perl 5 Core (Dave Mitchell): September 2024

The Weekly Challenge

The Weekly Challenge by Mohammad Sajid Anwar will help you step out of your comfort-zone. You can even win prize money of $50 by participating in the weekly challenge. We pick one champion at the end of the month from among all of the contributors during the month, thanks to the sponsor Lance Wicks.

The Weekly Challenge - 291

Welcome to a new week with a couple of fun tasks "Middle Index" and "Poker Hand Rankings". If you are new to the weekly challenge then why not join us and have fun every week. For more information, please read the FAQ.

RECAP - The Weekly Challenge - 290

Enjoy a quick recap of last week's contributions by Team PWC dealing with the "Double Exist" and "Luhn's Algorithm" tasks in Perl and Raku. You will find plenty of solutions to keep you busy.

TWC290

Compact solutions in Perl as always and self explanatory. You really don't want to miss it.

Finding Double Existence and Applying Luhn's Algorithm

Simple yet elegant approach in Perl and Go. Great work, keep sharing.

Luhn's Existence

Interesting way to deal with edge case using the power of Raku. And on top, get the complete official word on each feature used.

Two Times Zero is Zero

You get nice story to start with and then comes the technical discussion. It is engaging yet, thanks for sharing.

Perl Weekly Challenge: Week 290

Line-by-line discussion is a cool way to get the end result. Keep it up great work.

Perl Weekly Challenge 290: Double Exist

As per the tradition, we got side by side implementation in Perl and Raku. Plenty for both fans, keep the tradition alive.

Perl Weekly Challenge 290: Luhn's Algorithm

Real life story behind Luhn's algorithm. Thanks for sharing the story with us. Great work.

arrays and numbers

Simple loop in Raku is enough to get this week task done and self explanatory too. We also have bonus solutions in Java, Python and PostgreSQL.

Perl Weekly Challenge 290

In-house Perl one-liner expert sharing the quality implementation. Keep it up great work.

Take Me to the Luhn and Back

Smart use of CPAN to get a compact solution in Perl. Simple love the detailed discussion. Keep sharing the knowledge with us.

Double Your Pleasure, Double Your Luhn

Musical background to the weekly challenge is always fun. Following which we get the thorough discussion of implementation in Perl, Raku, Python and Elixir. Highly recommended.

Double existence and checking the payload

A verbose approach to make it easy to read and follow. DIY tool is the icing on the cake. Well done.

The Weekly Challenge - 290

Old school double loops with detailed comments. Keep it up great work.

The Weekly Challenge #290

We got another musical solution. I just love the musical theme. Keep sharing knowledge.

Double Luhn

Postscript is one language that I find very fascinating and when we get the detailed narration then it becomes so easy to follow. Highly recommended.

Seeing Double, Twice!

Two in a row, what a pleasant surprise. Thanks for the quality blog post. Please keep sharing.

Double Luhn

Like always, the post is dedicated to Python fans. Plenty for Perl fans to learn. Keep it up great work.

Rakudo

2024.41 KnowLite

Weekly collections

NICEPERL's lists

Great CPAN modules released last week.

Events

Toronto Perl Mongers monthly meeting

October 24, 2024, Virtual event

London Perl and Raku Workshop

October 26, 2024, in London, UK

Boston.pm monthly meeting

November 12, 2024, Virtual event

Purdue Perl Mongers

November 13, 2024, Virtual event

You joined the Perl Weekly to get weekly e-mails about the Perl programming language and related topics.

Want to see more? See the archives of all the issues.

Not yet subscribed to the newsletter? Join us free of charge!

(C) Copyright Gabor Szabo
The articles are copyright the respective authors.

<h3 class='likesectionHead' id='double-luhn'><a id='x1-1000'></a>Double Luhn</h3>

RabbitFarm Perl

Published on Monday 14 October 2024 01:19

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1: Double Exist

You are given an array of integers, @ints. Write a script to find if there exist two indices $i and $j such that:

$i≠$j
0 ≥ $i < size @ints and 0 ≥ $j < size @ints
$ints[$i] = 2 ∗ $ints[$j]

The majority of the work can be done in a few lines. If there is a more elegant way to do this, it escaped me when I was writing this code!

⟨nested loop to determine if the conditions hold 1 ⟩≡

: sub double_exist{
my(@a) = @_;
do{
my $i = $_;
do{
my $j = $_;
if($i != $j){
return 1 if $a[$i] == 2 * $a[$j];
}
} for 0 .. @a - 1;
} for 0 .. @a - 1;
return 0;
}
◇

: Fragment referenced in 2.

The rest of the code just tests this function.

"ch-1.pl" 2≡

: ⟨preamble 3 ⟩
⟨nested loop to determine if the conditions hold 1 ⟩
⟨main 4 ⟩
◇

⟨preamble 3 ⟩≡

: use v5.40;
◇

: Fragment referenced in 2 , 7.

⟨main 4 ⟩≡

: MAIN:{
say double_exist 6, 2, 3, 3;
say double_exist 3, 1, 4, 13;
say double_exist 2, 1, 4, 2;
}
◇

: Fragment referenced in 2.

Sample Run

$ perl perl/ch-1.pl 
1 
0 
1

Part 2: Luhn’s Algorithm

You are given a string $str containing digits (and possibly other characters which can be ignored). The last digit is the payload; consider it separately. Counting from the right, double the value of the first, third, etc. of the remaining digits. For each value now greater than 9, sum its digits. The correct check digit is that which, added to the sum of all values, would bring the total mod 10 to zero. Return true if and only if the payload is equal to the correct check digit.

This can also be done in relatively few lines. There are no real special cases here.

⟨loop and evaluate the check sum 5 ⟩≡

: sub luhn{ my($digits) = @_; my @digits = $digits =~ m/([0-9])/g; my $sum = 0; my $check = pop @digits; { my $x = pop @digits; my $y = pop @digits; if(defined $x && defined $y){ $sum += $y + sum_digits 2 * $x; } else{ $sum += sum_digits 2 * $x; } redo if @digits; } return 1 if 0 == ($sum + $check) % 10; return 0; }
◇

: Fragment referenced in 7.

For convenience we’ll put the summing of digits for numbers > 10 in a separate function.

⟨sum digits for numbers > 10 6 ⟩≡

: sub sum_digits{
my($x) = @_;
if($x >= 10){
my @a = split //, $x;
return $a[0] + $a[1];
}
return $x;
}
◇

: Fragment referenced in 7.

The rest of the code drives some tests.

"ch-2.pl" 7≡

: ⟨preamble 3 ⟩
⟨sum digits for numbers > 10 6 ⟩
⟨loop and evaluate the check sum 5 ⟩
⟨main 8 ⟩
◇

⟨main 8 ⟩≡

: MAIN:{
say luhn q/17893729974/;
say luhn q/4137 8947 1175 5904/;
say luhn q/4137 8974 1175 5904/;
}
◇

: Fragment referenced in 7.

Sample Run

$ perl perl/ch-2.pl 
1 
1 
0