1. App::cpm - a fast CPAN module installer
   • Version: 0.995 on 2020-11-28
   • Votes: 49
   • Previous version: 0.994 was 21 days before
2. App::TimeTracker - time tracking for impatient and lazy command line lovers
   • Version: 3.005 on 2020-11-22
   • Votes: 14
   • Previous version: 3.004 was 3 months, 12 days before
3. Convert::Binary::C - Binary Data Conversion using C Types
   • Version: 0.84 on 2020-11-23
   • Votes: 13
   • Previous version: 0.83 was 4 days before
4. Graph - graph data structures and algorithms
   • Version: 0.9711 on 2020-11-27
   • Votes: 20
   • Previous version: 0.9708 was 21 days before
5. Mojo::JWT - JSON Web Token the Mojo way
   • Version: 0.09 on 2020-11-22
   • Votes: 14
   • Previous version: 0.08 was 1 year, 11 months, 18 days before
6. Moo - Minimalist Object Orientation (with Moose compatibility)
   • Version: 2.004004 on 2020-11-25
   • Votes: 277
   • Previous version: 2.004003 was 4 days before
7. Package::Stash - Routines for manipulating stashes
   • Version: 0.39 on 2020-11-22
   • Votes: 27
   • Previous version: 0.38 was 1 year, 10 months, 22 days before
8. Syntax::Keyword::Try - a try/catch/finally syntax for perl
   • Version: 0.20 on 2020-11-24
   • Votes: 31
   • Previous version: 0.18 was 3 months, 23 days before
9. WWW::Mechanize::Chrome - automate the Chrome browser
   • Version: 0.63 on 2020-11-28
   • Votes: 14
   • Previous version: 0.61 was 25 days before

This is the weekly favourites list of CPAN distributions. Votes count: 36

Week's winners (+3): Plack

Build date: 2020/11/28 15:51:00 GMT

Clicked for first time:

• Acme::Working::Out::Dependencies::From::META::files::Will::Be::Wrong::At::Some::Point::Like::This::Module::For::Instance - Because there is nothing like being right
• App::XML::DocBook::Builder - Build DocBook/XML files.
• XML::Sig - A toolkit to help sign and verify XML Digital Signatures.

Increasing its reputation:

• Amon2 (+1=27)
• CallBackery (+1=3)
• CLDR::Number (+1=9)
• Config::Tiny (+1=29)
• Coro (+1=70)
• Dancer2::Plugin::Auth::Tiny (+1=6)
• Dancer2::Plugin::Database (+1=4)
• Dancer2::Plugin::Locale::Wolowitz (+1=3)
• DBIx::Class (+1=274)
• EV (+1=43)
• Getopt::Long (+1=105)
• Locale::Maketext (+1=5)
• Locale::Wolowitz (+1=6)
• Log::Any::Adapter::TAP (+1=3)
• Log::Log4perl (+2=87)
• Mojolicious::Command::Author::generate::cpanfile (+1=2)
• Mojolicious::Plugin::AssetPack (+1=47)
• Net::API::REST (+1=2)
• Net::MQTT::Simple (+1=2)
• OptArgs2 (+1=3)
• PDL::NDBin (+1=3)
• perl (+1=364)
• Plack (+3=218)
• POE (+1=50)
• Prima (+1=32)
• TheSchwartz (+1=12)
• Tickit::Widgets (+1=5)
• Tie::Hash::Indexed (+1=4)
• Try::Tiny (+1=168)
• XML::Hash::XS (+1=12)

These are the ten most rated questions at Stack Overflow last week.
Between brackets: [question score / answers count]
Build date: 2020-11-28 15:35:26 GMT

1. Perl: Best way to open a file exclusively? - [4/1]
2. Store and read string with newline from Config::Simple config file - [3/2]
3. (Windows 10) Trying to Install Perl Modules both PPM and CPAN fail? - [3/0]
4. atom feed: script to combine multiple <author> items into one? - [2/2]
5. Why does File::Slurp get UTF8 characters wrong when I use open ':std', ':encoding(UTF-8)';? - [2/2]
6. create a hash of occurrences in an array with map - [2/2]
7. What difference does curly brace make in accessing an object - [2/1]
8. How do I change a Perl Readonly scalar in a module for a unit test? - [2/1]
9. Perl load module BEGIN - [2/1]
10. Monitoring stdout of a forked process in perl by character - [2/0]

The book is available online for free

Thank you a lot O Reilly and Sean W. Burke for that !

Disclaimer

A lot of weaknesses of this book are due to the age but I won't refrain to report them with honesty :)

I'm very grateful to the person that took time to write this book: Sean W. Burke !

Tell me about history

At the beginning, Sean reminds us a lot of LWP and webservers history and I personnally loved it.

For my point of view, IT sciences are very sensitive to "technologies hypes" and things seems to go faster and faster these days (probably just an impression, I'm too young to judge) but I personnally love to read about history and oldies which created the present world.

Some people can think about this part as a weakness, but I definitely loved it.

Gandpa

Quickly we face some outdated websites 😧

Among other old stuff, you will have fun with HTML code from 2002 like table with captiatlized tags : <TD ALIGN=... or <BODY BGCOLOR="#aabbcc" BACKGROUND="img/bg.jpeg" ... or again <B CLASS="h3">

Be prepared !! 😁

Some paragraphs from chapter 3 are dedicated to explanations about HTML forms elements like textarea, submit or hidden fields (not really outdated but I felt like a jump in the past 😃)

And what about Netscapes 4.76 😖 used as browser (released in 2000).

Sometimes Sean is coding like my grandma (regularize_hostname to canonicalize hostname should be taken from a module, not coded by hand with regex).

...This remark does not mean that I'm not coding like my grandma too ! 😁

There is only one edition of this book and that's why it is so outdated :/

Cool bits

Stop critics, let's look at cool things from this book.

I was very happy to learn that :

• LWP manages a chained list of responses objects that we can use to check all the redirection flow.
• We can't do HEAD request on some resources like a CGI (OK it's CGI... but interesting bit anyway)
• The spec for HTML comments is very weird
• An attribute like alt=bad dog! (without quote) could be interpreted as a boolean...
• Comments are pseudo elements
• The difference between UserAgent and Robot (read robots.txt + handle sleep time)

And I enjoyed the detailed sections about :

• The parts of an URL
• The methods allowed

Later the multiples sections about "reading the HTML" are interesting :

• Dig into HTML with regex 😨 (pandas were harmed during the write of this paragraph, even if I know about this famous post responding to this other famous post)
• Parsing sequentially with HTML::TokeParser
• Parsing HTML with HTML::TreeBuilder and tree access (2020 recommended approach, eventually with another module)

As well as the details about dumped tokeparser get_token or unget_token and token sequences.

Or the parts about :

• Ordering of traversing
• Traversing recursively or by using a stack
• Modifying the HTML tree

Later, we finally have some chapters about web basics like cookies and credentials (basic).

The spider chapter is cool and appendix are interesting also even if it's only flat documentation.

I really like the mindset of Sean, UTF8 and unicode are well mentionned and pushed, Microsoft and their non standart politics are well adressed and I found very funny the reference to All your pies are belong to us. 😃

Surprising

Something surprising was to see Sean using suck.com (not related to anything NSFW) as a basis of an example. Bad choice in my humble opinion 😃

There is A LOT of retrieval of string in HTML using regex... 😨

The disclaimer is present but very light and does not mention that it’s brittle and limited (for correctness : not completely true).

I have no problem to do some dirty code when we I do not need more that a quick-and-dirty implementation (no over-engineering for nothing)...

...but these days everybody is very touchy with HTML and regex 😆

Seems also that CSS selectors were not in use in 2002 :/

And finally the TPJ#17 article about OOP seemed for me totally off topic.

Conclusion

I'm always a bit shy about using scraping because I feel like it's very brittle. I was hoping to see some advanced and robust webscraping methods in this book but it does not provides this at all.

I basically read the whole book without skipping any section (sometimes just went faster on the code samples) so it's still worth to read book !

You can get this and read it you will still learn interesting stuff but there are also probably some better alternatives today (I think about Mojolicious Web Clients but I haven't read it right now).

Perl::Tidy is usually used as a stand-alone program to beautify your Perl code. Sometimes, for example when you'd like to build a GUI for it, you need to be able to use it as part of your application.

This is a simple example showing how to do it.

CPAN Digger monitors the most recently uploaded distributions, CPAN Dashboard provides an overview to the authors, CPAN Rocks provides stats from Meta::CPAN.

These are some answers to the Week 88 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days (November 29, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Array of Products

You are given an array of positive integers @N.

Write a script to return an array @M where $M[i] is the product of all elements of @N except the index $N[i].

Example 1:

Input:
    @N = (5, 2, 1, 4, 3)
Output:
    @M = (24, 60, 120, 30, 40)

    $M[0] = 2 x 1 x 4 x 3 = 24
    $M[1] = 5 x 1 x 4 x 3 = 60
    $M[2] = 5 x 2 x 4 x 3 = 120
    $M[3] = 5 x 2 x 1 x 3 = 30
    $M[4] = 5 x 2 x 1 x 4 = 40

Example 2:

Input:
    @N = (2, 1, 4, 3)
Output:
    @M = (12, 24, 6, 8)

    $M[0] = 1 x 4 x 3 = 12
    $M[1] = 2 x 4 x 3 = 24
    $M[2] = 2 x 1 x 3 = 6
    $M[3] = 2 x 1 x 4 = 8

Array of Products in Raku

I immediately thought about two methods to solve this problem. Although I thought the second method was probably better, let me show first the first one.

The first way to do it is to traverse the input array and, for each item, multiply all items before with all items after and store the product in the equivalent position of the result array. Here we use the reduction metaoperator with multiplication, [*], to compute the chained multiplication. And we use array slices to pick the relevant items to be multiplied. For some reason, array slice did not work properly for the first element of the array, so I computed it separately before entering the for loop.

use v6;

my @tests = [5, 2, 1, 4, 3], [2, 1, 4, 3];
for @tests -> @array {
    my @result; 
    @result[0] = [*] @array[1..@array.end];
    for 1..@array.end -> $i {
        @result[$i] = ([*] @array[0..$i-1]) * [*] (@array[$i+1..@array.end]);
    }
    say "Input array: ", @array;
    say "Result: ", @result;
}

This script produces the following output:

$ raku array-of_products.raku
Input array: [5 2 1 4 3]
Result: [24 60 120 30 40]
Input array: [2 1 4 3]
Result: [12 24 6 8]

There may be a better way to handle the special case of the first item of the list, but, rather than trying to improve it, I preferred to implement the second method. Here, the idea is to compute only once the product of all elements of the input array. Then, for each position in the array, we divide the overall product by the item in the current position. The code becomes slightly simpler, and the performance is also likely to be better, since we’re performing much less arithmetical operations overall (especially if the input array is somewhat large).

my @tests = [5, 2, 1, 4, 3], [2, 1, 4, 3];
for @tests -> @array {
    my $product = [*] @array;
    my @result = map { $product / $_ }, @array;
    say "Input array: ", @array;
    say "Result: ", @result;
}

This script produces the same result as before:

Input array: [5 2 1 4 3]
Result: [24 60 120 30 40]
Input array: [2 1 4 3]
Result: [12 24 6 8]

Array of Products in Perl

This is a port to Perl of the method used in the second Rakudo script above: we compute the product of all elements of the input array. Then, for each position in the array, we divide the overall product by the item in the current position.

use strict;
use warnings;
use feature "say";

my @tests = ([5, 2, 1, 4, 3], [2, 1, 4, 3]);
for my $array_ref (@tests) {
    my $product = 1;
    $product *= $_ for @$array_ref;
    my @result = map $product / $_, @$array_ref;
    say "Input: @$array_ref";
    say "Result: @result";
}

This displays the following output:

$ perl array-of-products.pl
Input: 5 2 1 4 3
Result: 24 60 120 30 40
Input: 2 1 4 3
Result: 12 24 6 8

Task 2: Spiral Matrix

You are given m x n matrix of positive integers.

Write a script to print spiral matrix as list.

Example 1:

Input:
    [ 1, 2, 3 ]
    [ 4, 5, 6 ]
    [ 7, 8, 9 ]
Ouput:
    [ 1, 2, 3, 6, 9, 8, 7, 4, 5 ]

Example 2:

Input:
    [  1,  2,  3,  4 ]
    [  5,  6,  7,  8 ]
    [  9, 10, 11, 12 ]
    [ 13, 14, 15, 16 ]
Output:
    [ 1, 2, 3, 4, 8, 12, 16, 15, 14, 13, 9, 5, 6, 7, 11, 10 ]

Spiral Matrix in Raku

For this task, we’ll use a @tests array of five rectangular matrices. The print-matrix subroutine is a helper function to pretty print the input matrix. Note that, when applied to a list, the fmt method applies the formatting string to each element of the list (contrary to sprintf), so that there is no need to add a map to process each item of a matrix line. For example:

say <1 2 3 4>.fmt("%04i");

will print:

0001 0002 0003 0004

The main loop reads the values of the matrix (in accordance to the rules explained just after) and stores them into the @result array. It processes first the first matrix line (left to right); it then processes the last column, i.e. the last item of each line, from top to bottom, and deletes it at the same time; it then processes (right to left) the last line of the matrix and also deletes this line; and it processes the first column (bottom to top) of the matrix. It then assign to @matrix a version of the original matrix with all values on the four edges removed. And the loop is restarted with the new smaller matrix if it is not empty.

Note that the :delete adverb removes entirely the last item of an array, but it leaves a “hole” when applied to any other element of the array.

use v6;

my @tests =
    [ [ |(0..3) ], [ |(4..7)  ],  [ |(8..11)  ], [ |(12..15) ] ],
    [ [ |(0..4) ], [ |(5..9)  ],  [ |(10..14) ], [ |(15..19) ] ],
    [ [ |(0..5) ], [ |(6..11) ], [ |(12..17)  ], [ |(18..23) ] ],
    [ [ |(0..5) ], [ |(6..11) ], [ |(12..17)  ] ],
    [ [ |(0..2) ], [ |(4..6)  ],  [ |(8..10)  ], [ |(12..14) ] ];

sub print-matrix (@matrix) {
        say "[ {$_.fmt("% 3i")} ]" for @matrix;
        say "";
}

for @tests -> @matrix {
    my @result;
    print-matrix @matrix;
    loop {
        push @result, |@matrix[0];
        push @result, @matrix[$_][*-1]:delete for 1..@matrix.end;
        push @result, |(reverse @matrix[@matrix.end]:delete);
        last if @matrix.elems == 1;
        push @result, @matrix[$_][0]:delete for reverse 1..@matrix.end;
        @matrix = map { [$_[|(1..$_.end)]] }, @matrix[|(1..@matrix.end)];
        # print-matrix @matrix;
        last unless @matrix;
    }
    say @result, "\n";
}

This program displays the following output:

[   0   1   2   3 ]
[   4   5   6   7 ]
[   8   9  10  11 ]
[  12  13  14  15 ]

[0 1 2 3 7 11 15 14 13 12 8 4 5 6 10 9]

[   0   1   2   3   4 ]
[   5   6   7   8   9 ]
[  10  11  12  13  14 ]
[  15  16  17  18  19 ]

[0 1 2 3 4 9 14 19 18 17 16 15 10 5 6 7 8 13 12 11]

[   0   1   2   3   4   5 ]
[   6   7   8   9  10  11 ]
[  12  13  14  15  16  17 ]
[  18  19  20  21  22  23 ]

[0 1 2 3 4 5 11 17 23 22 21 20 19 18 12 6 7 8 9 10 16 15 14 13]

[   0   1   2   3   4   5 ]
[   6   7   8   9  10  11 ]
[  12  13  14  15  16  17 ]

[0 1 2 3 4 5 11 17 16 15 14 13 12 6 7 8 9 10]

[   0   1   2 ]
[   4   5   6 ]
[   8   9  10 ]
[  12  13  14 ]

[0 1 2 6 10 14 13 12 8 4 5 9]

We can make it slightly simpler by stripping out the used matrix edges as we go, using the pop and shift methods each time we use some values, so that we don’t have to reassign the @matrix at each iteration. This also simplifies the handling of array subscripts. In the code below, the only changes are in the loop block:

use v6;

my @tests =
    [ [ |(0..3) ], [ |(4..7)  ],  [ |(8..11)  ], [ |(12..15) ] ],
    [ [ |(0..4) ], [ |(5..9)  ],  [ |(10..14) ], [ |(15..19) ] ],
    [ [ |(0..5) ], [ |(6..11) ], [ |(12..17)  ], [ |(18..23) ] ],
    [ [ |(0..5) ], [ |(6..11) ], [ |(12..17)  ] ],
    [ [ |(0..2) ], [ |(4..6)  ],  [ |(8..10)  ], [ |(12..14) ] ];

sub print-matrix (@matrix) {
        say "[ {$_.fmt("% 3i")} ]" for @matrix;
        say "";
}
for @tests -> @matrix {
    my @result;
    print-matrix @matrix;
    loop {
        push @result, |@matrix.shift;
        push @result, @matrix[$_].pop for 0..@matrix.end;
        last unless @matrix.elems;
        push @result, |(reverse @matrix.pop);
        push @result, @matrix[$_].shift for reverse 0..@matrix.end;
        last unless @matrix;
    }
    say @result, "\n";
}

This produces the same output as before:

[   0   1   2   3 ]
[   4   5   6   7 ]
[   8   9  10  11 ]
[  12  13  14  15 ]

[0 1 2 3 7 11 15 14 13 12 8 4 5 6 10 9]

[   0   1   2   3   4 ]
[   5   6   7   8   9 ]
[  10  11  12  13  14 ]
[  15  16  17  18  19 ]

[0 1 2 3 4 9 14 19 18 17 16 15 10 5 6 7 8 13 12 11]

[   0   1   2   3   4   5 ]
[   6   7   8   9  10  11 ]
[  12  13  14  15  16  17 ]
[  18  19  20  21  22  23 ]

[0 1 2 3 4 5 11 17 23 22 21 20 19 18 12 6 7 8 9 10 16 15 14 13]

[   0   1   2   3   4   5 ]
[   6   7   8   9  10  11 ]
[  12  13  14  15  16  17 ]

[0 1 2 3 4 5 11 17 16 15 14 13 12 6 7 8 9 10]

[   0   1   2 ]
[   4   5   6 ]
[   8   9  10 ]
[  12  13  14 ]

[0 1 2 6 10 14 13 12 8 4 5 9]

Spiral Matrix in Perl

For this task, we’ll use a @tests array of five rectangular matrices. The print_matrix subroutine is a helper function to pretty print the input matrix.

The main while loop reads the values of the matrix (in accordance to the rules explained just after) and stores them into the @result array. It processes first the first matrix line (left to right) and removes it from the matrix; it then processes the last column, i.e. the last item of each line, from top to bottom, and deletes it at the same time; it then processes (right to left) the last line of the matrix and also deletes this line; and finally it processes the first column (bottom to top) of the matrix and removes it. After one iteration, the original matrix is stripped of all its edge items. And the loop is restarted with the new smaller matrix if it is not empty.

use strict;
use warnings;
use feature "say";
use Data::Dumper;


my @tests = ( [ [ 0..3 ], [ (4..7) ],  [ (8..11) ],  [ (12..15) ] ],
              [ [ 0..4 ], [ (5..9) ],  [ (10..14) ], [ (15..19) ] ],
              [ [ 0..5 ], [ (6..11) ], [ (12..17) ], [ (18..23) ] ],
              [ [ 0..5 ], [ (6..11) ], [ (12..17) ] ],
              [ [ 0..2 ], [ (4..6) ],  [ (8..10) ],  [ (12..14) ] ]
            );

# @tests = ( [ [ 0..3 ], [ (4..7) ],  [ (8..11) ],  [ (12..15) ] ] );

sub print_matrix {
    my @matrix = @{$_[0]};
    say "";
    say "[ ", (map { sprintf "% 3i", $_ } @$_), " ]" for @matrix;
    say "";
}

for my $m_ref (@tests) {
    print_matrix($m_ref);
    my @result;
    my @matrix = @$m_ref;
    while (1) {
        push @result, @{shift @matrix};
        last if scalar @matrix == 0;
        push @result, pop @{$matrix[$_]} for 0..$#matrix;
        push @result, reverse @{pop @matrix};
        push @result, shift @{$matrix[$_]} for reverse 0..$#matrix;
        last if @matrix == 0;
    }
    say join " ", @result;    
}

This displays the following output:

[   0  1  2  3 ]
[   4  5  6  7 ]
[   8  9 10 11 ]
[  12 13 14 15 ]

0 1 2 3 7 11 15 14 13 12 8 4 5 6 10 9

[   0  1  2  3  4 ]
[   5  6  7  8  9 ]
[  10 11 12 13 14 ]
[  15 16 17 18 19 ]

0 1 2 3 4 9 14 19 18 17 16 15 10 5 6 7 8 13 12 11

[   0  1  2  3  4  5 ]
[   6  7  8  9 10 11 ]
[  12 13 14 15 16 17 ]
[  18 19 20 21 22 23 ]

0 1 2 3 4 5 11 17 23 22 21 20 19 18 12 6 7 8 9 10 16 15 14 13

[   0  1  2  3  4  5 ]
[   6  7  8  9 10 11 ]
[  12 13 14 15 16 17 ]

0 1 2 3 4 5 11 17 16 15 14 13 12 6 7 8 9 10

[   0  1  2 ]
[   4  5  6 ]
[   8  9 10 ]
[  12 13 14 ]

0 1 2 6 10 14 13 12 8 4 5 9

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 Sunday, December 6, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.

According to CPAN Rocks there are 29 CPAN modules that use GitLab as their bug-tracking system. That probably means those are the projects that use GitLab as a VCS.

(initially posted on my personal blog, that I'm closing in favor of dev.to :D)

Intro

Sometimes bad things bring us good opportunities.

This was the case this year with Covid and “The Perl Conference”. This major yearly Perl conference became available to remote people and therefore renamed “The Perl and Raku Conference In The Cloud”.

The event was well announced and we were able to pay to support the organizational costs (what I have done), but it was even not mandatory (free broadcast on youtube).

I was very excited by the planning, I remember having difficulties to choose between talks !

(/me trying to choose between an amazing and a wonderful talk topic)

Here we are

Then finally the day has come and I was able to join Perl folks with the password shared one or two days before.

I was waiting with decent expectation (to not say excitement) for the first talk.

It consisted in a word from organizers followed by a keynote from Perl pumpking “Sawyer X”.

What could be best as an luxury “aperitif” 😄

I was ready, well preapared, first TPC, first talk, let’s go.

It was during this talk that was announced Perl 7 !!

OMG, I was immediatly like this :

Everybody was very excited and happy all around, like me.

This was my first TPC and the first talk I attended, later on I wondered myself if it was a bit “my fault” 😄

If I decide to attend another TPC, what will be announced ? That we discovered aliens ?

Later on reddit I noticed this fun comment from perlancar :

Other talks, in bulk

As I said I followed all the slots during all the TPC days. Was a bit rushy because often talks ended just when next one started (but it could not overlap because of the same room).

I really loved some very technical talks like the ones from Graham Ollis on FFI and Wasm (but I’m interested in Perl “native” stuff like aliens and xs so that’s not a surprise 😄)

I’m also very interested in the way Perl folks put such lot of efforts into quality (CPAN testers and perl5 smokers etc…) and I enjoyed the talk about quality from Jim Keenan.

Please note the golden mic !

There was a lightening talk on Pull Request Club, do you know this ? If not you should join !

Multiple talks discussed about “Continuous Integration” topic that I follow for my day to day job, and it was very interesting. One of them was from Olaf Alders.

I was also very impressed by the lightning talk about OpenQA project.

One guy made a psychedelic talk about command line tools, I don’t understood what it does exactly but that was crazy.

I also joined several “BOF” to talk or ask questions about topics like Perl 7 or TPF missions.

The Damian Conway Show

Later, there was the keynote from Damian Conway.

People said you should prepare for it and come with a beer and peanuts. That’s totally true.

Was not that simple to explain to my wife that I open a beer in front of my computer… at midnight (was that time France), but was definitely worth to do it 😄

This talk completely turned my brain (like the psychedelic one that I discussed earlier) 😃

All people in the associated chat become totally crazy also and I laught a lot with fun and smart comments.

Conclusion

This TPC was my first Perl conference and it was a wonderful experience for me.

I wanted to thank all organizers like Todd Rinaldo and all others.

I also wanted to highlight Geoffrey Avery that was handling the BOF and/or lightning talks (don’t remember well).

He said something poignant around the end of the TPC like : “dear newcomers, please don’t disappear”.

I had so much fun that I personally promised myself to join again as much Perl conferences as possible.

This is a monthly report by Dave Mitchell on his grant under Perl 5 Core Maintenance Fund. We thank the TPF sponsors to make this grant possible.

This mainly consisted in tracking down a (harmless as it turned out)
off-by-one error in Cwd.xs, which I thought was being flagged up by
valgrind. As it turned out, the valgrind report was a false positive caused
by a bug in valgrind when perl is built with -D_FORTIFY_SOURCE, and I
found the Cwd bug by manual code inspection of the area complained about
by valgrind!

SUMMARY:
      4:35 add some magic free vtable methods for faster freeing
     15:59 investigate ASan failure in t/op/coreamp.t
      2:30 process p5p mailbox
    ------
     23:04 TOTAL (HH::MM)

The web site of CPAN Digger shows the most recently uploaded CPAN distributions. Currently about 110 of them and some meta information about them. Let me go through quickly what you see there, why is that interesting and what to do about it.

Challenge

TASK #1 › Array of Product

Task

You are given an array of positive integers @N.

Write a script to return an array @M where $M[i] is the product of all elements of @N except the index $N[i].

My solution

This is relatively straight forward. I calculate the product of all the numbers using List::Util's product function. For those that follow my posts, I tend to use only CPAN modules that are in core, like List::Util.

I then use the map function to loop over the numbers, diving the product by the number to give the solution.

Examples

» ./ch-1.pl 5 2 1 4 3
24, 60, 120, 30, 40

» ./ch-1.pl 2 1 4 3
12, 24, 6, 8

TASK #2 › Spiral Matrix

Task

You are given m x n matrix of positive integers.

Write a script to print spiral matrix as list.

My solution

Initially I was quite stumped about the way to solve it. I was thinking I'd need some sort of counter to know how many values I would need to take and in which direction. After an hour of thinking about it (while watching the television), I figured out a reasonably clean solution. It will be interesting to see what other Team PWC members come up with.

It can be broken down to the following steps.

1. Parse the input into an array of arrays, check that all rows are even.
2. Create an array @used that is the same size as the input array.
3. Have an array @directions that map the x & y movements. For example [1, 0] means to move down.
4. Starting at the top left moving right add the value at that position to the @solutions array, and mark that position as used.
5. If the next position is out of bounds of the array or is a value that has been used, switch directions. Continue this pattern until the @solutions array is completed.
6. Output the values to the screen.

Examples

» ./ch-2.pl "1 2 3" "4 5 6" "7 8 9"
1, 2, 3, 6, 9, 8, 7, 4, 5

» ./ch-2.pl "1 2 3 4" "5 6 7 8" "9 10 11 12" "13 14 15 16"
1, 2, 3, 4, 8, 12, 16, 15, 14, 13, 9, 5, 6, 7, 11, 10

Hi there!

Have you noticed how the English spelling and grammar of both Mohammad and myself improved in the last couple of weeks? It's all thanks to Dave Cross who had enough of our broken English and started to comb through the newsletter fixing some of the biggest offenders. Thanks Dave!

I put together a web page for CPAN Digger where you can see the 100 most recently uploaded CPAN modules. The goal is to locate the ones that don't link to their VCS in their META.json file. Try to locate the public VCS and add the link. I also would like to encourage the CPAN authors to set up their CPAN Dashboard that was created by Dave Cross.

After several months of waiting, Patreon has enabled annual payments on my account. That means from now on you can support my work with an annual payment and even get 10% discount.

Enjoy your week!

The other day I wanted to send my friend some silly emojis on LINE and so I updated my flaky old Unicode browser to the new-fangled Unicode with values above 0x10000, so that I could fetch the Emojis, which start around here. The thing also features a perl script which fetches values from Unicode::UCD using the charinfo function. I also updated to Perl 5.32 around the same time. Now the funny thing was that I started getting all kinds of errors about invalid JSON in the browser console. My Perl script was sending something of the form {... "script":Common ...} from my module JSON::Create, which is not valid JSON due to not having quotes around Common, and obviously my module was faulty.

Investigating the fault led me into the XS (C) code of my module where the value part of the JSON thought that the value associated with the script key in the hash reference returned by charinfo was of the form SVt_PVIV. PV means "pointer value" which is basically a string, and IV means "integer value", you can probably guess what that is supposed to contain.

My stupid module assumed that the string in an SVt_PVIV was just a representation of the IV part, so it just printed the PV as a string without quotes, leading to the above Common appearing. But it doesn't seem to be so. Is it some kind of "dual variable"? It turned out that the IV part wasn't even valid, so forcing it to treat the SVt_PVIV as an IV didn't work. The solution at the moment is to test with something called SvIOK whether the IV part is OK then treat it as a string if not.

The mysterious part for me is why is the script value an SVt_PVIV in the first place? Answers on a postcard, or comment below if you prefer.

I tried to replicate this bug for testing purposes using Scalar::Util's dualvar, but that creates an SVt_PVNV (floating point/string combo), which my daft module treated differently again.

In version 0.27 of JSON::Create I added a new indentation feature. This was added basically out of necessity. Originally the purpose of the module was sending short bits of JSON over the internet, but I've been using JSON more and more for processing data too. I've spent quite a long time working on a web site for recognition of Chinese, and I've been using JSON more and more extensively. The basic data file for the web site is a 168 megabyte JSON file. Not indenting this kind of file makes for "interesting" problems if one accidentally opens it in an editor or on a terminal screen, a million characters all on one line tends to confuse the best-written text reading utilities. So after years of suffering the relief is tremendous, and now I have tab-based indentation in JSON::Create.

Originally I thought that I should make all kinds of customisable indentation possible, but then it occurred to me that basically any fool armed with a regular expression could easily alter the indentation however they want to. I put a simple example in the documentation.

Part 1

You are given an unsorted array of integers @N. Write a script to find the longest consecutive sequence. Print 0 if no sequence found.

Solution

use strict;
use warnings;
##
# You are given an unsorted array of integers @N.
# Write a script to find the longest consecutive sequence. 
# Print 0 if no sequence found.
##
sub min_max{
    my @a = @_;
    my($min, $max) = ($a[0], $a[0]);
    for my $x (@a){
        $min = $x if($x < $min);
        $max = $x if($x > $max);
    }
    return ($min, $max);
}

sub longest_sequence{
    my @sequences = @_;
    my @max = (0);
    for my $sequence (@sequences){
        @max = @{$sequence} if((@{$sequence} > @max) && (@{$sequence} > 1));
    }
    return @max;
}

sub continuous_sub_sequences{
    my @a = @_;
    my($min, $max) = min_max(@a);
    my @sub_sequences;
    my $sub_sequence = [];
    while($min <= $max){
        my $test = grep {$_ == $min} @a;
        if($test){
            push @{$sub_sequence}, $min;
        }
        else{
            push @sub_sequences, $sub_sequence if(@{$sub_sequence} > 0);
            $sub_sequence = [];
        }
        $min++;
    }
    return @sub_sequences;
}

MAIN:{
    my @N = (100, 4, 50, 3, 2);
    my @sequences = continuous_sub_sequences(@N);
    my @max = longest_sequence(@sequences);
    print join(",", @max) . "\n";
    @N = (20, 30, 10, 40, 50);
    @sequences = continuous_sub_sequences(@N);
    @max = longest_sequence(@sequences);
    print join(",", @max) . "\n";
    @N = (20, 19, 9, 11, 10);
    @sequences = continuous_sub_sequences(@N);
    @max = longest_sequence(@sequences);
    print join(",", @max) . "\n";
}

Sample Run

$ perl perl/ch-1.pl
2,3,4
0
9,10,11

Notes

I decided to force myself to work with an artificial constraint as a way fo forcing a little bit more creativity in my solution. When I first looked at this problem I immediately thought “ok, first thing should be to sort the list”. Based on that first impression my self-imposed constraint was to “solve this without using a sort”!

What I did can be summarized as follows: 1. Find the minimum and maximum numbers in the given list. 2. Starting with the minimum number generate test sequences by incrementing upwards towards the maximum list value. 3. As each new element of the test sequence is added test to see if it is in the original list. 4. If it is in the list, good, keep going. 5. If it is not in the list then save the test sequence generated up to that point and continue with a new test sequence. 6. Return all successful test sequences and determine the longest one.

The most blatant inefficiency to this approach is when lists are sparse. For example, suppose we are given (2, 100000000, 3, 4, 5) then we would be iterating from 2 to 100000000. An approach using a sorted list would basically need only loop over the elements of the list, checking to see if the next element was 1 larger than the previous.

Part 2

You are given matrix m x n with 0 and 1. Write a script to find the largest rectangle containing only 1. Print 0 if none found.

Solution

use strict;
use warnings;
##
# You are given matrix m x n with 0 and 1.
# Write a script to find the largest rectangle 
# containing only 1. Print 0 if none found.
##
use boolean;

sub print_solution{
    my($m, $n) = @_;
    if(!$m || !$n){
        print "0\n";
    }
    else{
        for (1 .. $n){
            print "[". join(" ", (1)x $m) . "]\n";
        }       
    }
}

sub evaluate{
    my($m, $n, $matrix) = @_;
    my $row_string = join(",", (1) x $m);
    my $columns = 0;
    for my $row (@{$matrix}){
        my $test = join(",", @{$row});
        if(index($test, $row_string) > -1){
            $columns++;
            return true if($columns == $n);
        }
        else{
            $columns = 0;
        }
    }
    return false;
}

sub largest_rectangle{
    my @matrix = @_;
    my $rows = @{$matrix[0]};
    my $columns = @matrix;
    my $max_area = 0;
    my @rectangle;
    for my $m (2 .. $columns){
        for my $n (1 .. $rows){
            if(evaluate($m, $n, \@matrix)){
                if(($m * $n) > $max_area){
                    $max_area = ($m * $n);
                    @rectangle = ($m, $n);
                }
            }
        }
    }
    return @rectangle;
}

MAIN:{
    my @MATRIX = (
        [0, 0, 0, 1, 0, 0],
        [1, 1, 1, 0, 0, 0],
        [0, 0, 1, 0, 0, 1],
        [1, 1, 1, 1, 1, 0],
        [1, 1, 1, 1, 1, 0]
    );
    print_solution(largest_rectangle(@MATRIX));
    @MATRIX = (
        [1, 0, 1, 0, 1, 0],
        [0, 1, 0, 1, 0, 1],
        [1, 0, 1, 0, 1, 0],
        [0, 1, 0, 1, 0, 1]
    );
    print_solution(largest_rectangle(@MATRIX));
    @MATRIX = (
        [0, 0, 0, 1, 1, 1],
        [1, 1, 1, 1, 1, 1],
        [0, 0, 1, 0, 0, 1],
        [0, 0, 1, 1, 1, 1],
        [0, 0, 1, 1, 1, 1]
    );
    print_solution(largest_rectangle(@MATRIX));  
}

Sample Run

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

Notes

Unlike Part 1 I did not necessarily have a self-imposed constraint other than to try and be as creative as possible. I’ll only know when I look at other submitted solutions if I was really all that relatively clever or not!

Here I do the following: 1. Check the size of the given matrix 2. Test the matrix for all possible sub-matrix sizes. 3. For all found sub-matrices determine the largest one.

For checking the presence of sub-matrices I join the rows into strings and then use index to see if they appear in a given row or not. To determine if a sub-matrix is the largest I compare the areas of the “rectangles”.

I've been using GitHub pages to host static web sites for a few years. I wrote a brief introduction on how to do that a couple of years ago.

However, very few pages are completely static. So I still had to host many of my web sites in places where I could execute the code that was used to run the site. But in the last couple of weeks, I've realised that there is another type of site that can be successfully hosted on GitHub pages using GitHub Actions. I call these "semi-static" sites. It would probably help if I explained what I mean by this term. I'll start by giving an example.

I've written before about my CPAN Dashboard site. It's a site that allows CPAN authors to monitor the various continuous integration services that they use to develop their code. (For those of you who haven't heard of it - CPAN is the "Comprehensive Perl Archive Network - the site where Perl programmers can find thousands of libraries that extend the Perl language).

This site is mostly static. There's a page for each author who uses the site. Those pages are mostly taken up by a big table. Each row in the table contains data about one of the author's modules. There are links to the code repo and the module's page on CPAN, the version number and release date of the most recent version of the module and a series of badges indicating the status of the module on various CI services. The list of an author's modules is generated by making a call to the MetaCPAN API.

The site currently has two other pages: the home page (which basically lists the authors using the site) and a page telling authors how they can add themselves to the site (which is by sending a pull request to the repo that hosts the site).

As I say, the site is mostly static. There are only a few ways that the site can change.

• I change the information in one of the static pages
• I change the formatting of site
• A new author sends a pull request to add themself to the site
• An author who uses the site releases a new module (or gives up ownership of an existing one)
• An author who uses the site releases a new version of module (meaning that the last-released date needs to change)

There is a single program in the repo that can be used to rebuild the site in all of these circumstances.

If I change the site in some way (the first two items in the list), obviously I know that this change has been made and can run the regeneration program and commit the regenerated version.

If an author sends a pull request to add themself to the site, I can merge the site, then pull down the latest version and regenerate it to add the page for the new user. But it would be nicer if I just had to merge the pull request and the rebuild was handled automatically.

But I can't know when an author adds a new module or releases a new version of a module - well not without monitoring CPAN rather more closely than I have time for. It would be better if the site is automatically rebuilt periodically (say once an hour) and checked in if something has changed. And that's what I can now do - thanks to GitHub Actions.

GitHub actions are configured by adding a YAML file to the .github/workflows directory in a code repo. The YAML configures what the action does and how it is triggered. Here's the current version of the workflow file for my dashboard repo:

name: Generate web page

on:
  push:
    branches: '*'
  schedule:
    - cron: '7 */6 * * *'
  workflow_dispatch:

jobs:
  build:
    runs-on: ubuntu-latest

    container:
      image: perldocker/perl-tester:5.30   # https://hub.docker.com/r/perldocker/perl-tester

    steps:
    - name: Checkout
      uses: actions/checkout@v2

    - name: Install modules
      run: |
          cpanm --installdeps --notest .
    - name: Create pages
      run: |
        mkdir -p docs
        perl dashboard
    - name: Commit new page
      if: github.repository == 'davorg/dashboard'
      run: |
        GIT_STATUS=$(git status --porcelain)
        echo $GIT_STATUS
        git config --global user.name 'Dave Cross'
        git config --global user.email 'dave@dave.org.uk'
        git add docs/
        if [ "$GIT_STATUS" != "" ]; then git commit -m "Automated Web page generation"; fi
        if [ "$GIT_STATUS" != "" ]; then git push; fi

I think it's pretty easy to understand, but let's go through it a section at a time.

We start with the on: key. That defines when the workflow will be triggered. In this case, we have three triggers.

• If there's a push to any branch (most usefully, this is triggered when I merge a pull request)
• On a cron schedule. Here I run it hourly - at seven minutes past the hour
• And workflow_dispatch: adds a button to the action's page in the repo. Pressing this button will run the action at any time.

The next section (jobs:) defines what we do. We're using the build-in ability to run in a Docker image (here, we use one of the official Perl images - which adds a number of useful Perl tools to a standard Ubuntu image). We checkout the repo, install the dependencies using cpanm and then run the program (called dashboard) that regenerates the site. We then use a low-level (porcelain) git command to determine whether any of the files actually changed; and, if they did, we commit the changes and they will appear on the web site.

This solves all of my problems. If I change the site in some way and forget to regenerate it before committing, then the site will be regenerated automatically. When I merge a pull request from a new author, the site will be regenerated automatically. And the site will be regenerated automatically each hour, which will take care of the case when any of the authors' lists of modules have changed in any way.

So that's what I mean by a "semi-static" site. It's one where the pages stay the same most of the time, but there are a few, well-defined, events can change the contents of the site. As long as those events can be mapped onto the various triggers for GitHub actions, then the regeneration of the site can be handled automatically.

Here's another example. I run another site called Planet Perl. This is an old-school web feed aggregator. It knows about a number of web feeds about Perl programming and it combines their content into a single page (and another web feed). Once again, there is a small list of events that can change the site:

• I change the look and feel of the site
• I add a new web feed (or someone submits a pull request that adds a web feed)
• Every hour we poll all of the feeds and rebuild the site

I won't go through the workflow definition again, but here it is if you'd like to take a look (it's actually very similar to the previous one).

Please let me know in the comments if you can think of any other kinds of site that this approach would work for. Or if you can suggest any improvements to my system.

The original version of the CPAN Dashboard workflow was sent to me by Gabor Szabo. Many thanks to him for showing me how to do it.

TASK #1 › Longest Consecutive Sequence

Submitted by: Mohammad S Anwar

You are given an unsorted array of integers @N.

Write a script to find the longest consecutive sequence. Print 0 if none sequence found.

Example 1:

Input: @N = (100, 4, 50, 3, 2)
Output: (2, 3, 4)

Example 2:

Input: @N = (20, 30, 10, 40, 50)
Output: 0

Example 3:

Input: @N = (20, 19, 9, 11, 10)
Output: (9, 10, 11)

Perl Solution

Imperative Approach

I've done the same task with common lisp and golang, then I guess that I naturally follow the same logic I used in both language.

1. sort the number
2. compare between consecutive member in the list
3. concatenate the list if they are right next to each other
4. if not, start a new sequence

and I need to add handy dummy member at the tail of the list

here is the code.

use strict; use warnings;
use v5.26;

# note: no sanity check !!
my @sorted = sort { $a <=> $b } @ARGV;
push @sorted, $sorted[-1]+2; # dummy

my @longest_seq_list = ();
my $longest_size = 0;

my $prev = shift @sorted;
my @curr_seq = ($prev);

for my $curr (@sorted) {
    if ( $curr - $prev == 1 ) {
        push @curr_seq, ($curr);        # concat. current seq
    } elsif ( $curr == $prev ) {        # skip
    } else {                            # update longest
        my $curr_size = scalar @curr_seq;
        if ( $curr_size > $longest_size ) {
            $longest_size = $curr_size;
            @longest_seq_list = ( [ @curr_seq ] );
        } elsif ( $curr_size == $longest_size ) {
            push @longest_seq_list, [ @curr_seq ];
        }
        @curr_seq = ($curr);
    }
    $prev = $curr;
}

if ( $longest_size > 0 ) {
    say "longest size: ".$longest_size;
    say "total ".(scalar @longest_seq_list)." sequencies found.";
    for my $seq (@longest_seq_list) {
        say "[", join(", ", @$seq), "]";
    }
}

It is simple challenge, so I tried learn more about raku today.

Raku Solution

Sorting

Easy!, and we don't need to add 'sort( $^a <=> $^b )' because @n are all already IntStr instance.

unit sub MAIN (*@n where { @n ~~ Int, @n.elems > 0 } );
@n.sort.say

Produce

as we go through the list, we can produce the trace of our data.
the simple example of produce is that maximum value at each step.

> my @n = 3, 2, 4, 5, 9;
[3 2 4 5 9]
> @n.produce( -> \a, \b { max( a, b) } )
(3 3 4 5 9)

but I need some more information to keep at every step and decided to keep a list of numbers as we go.

> @n = -3, 1, 3, 2, -2, 4, 6, 7, -1, 4
> @n.sort.map({[$_]})
([-3] [-2] [-1] [1] [2] [3] [4] [4] [6] [7])

and if a and b is consecutive write down the linked numbers or start over new one.

...
(@n.sort.map({[$_]})).
produce( ->  \a, \b {
                 b.first - a.tail == 1
                 ?? a.append(b.first).clone
                 !! b.clone
           } ).say
...

and result looks like:

([-4] [-4 -3] [-4 -3 -2] [-4 -3 -2 -1] [1] [1 2] [1 2 3] [1 2 3 4] [6] [6 7])

Now classify the number by length and grep the element has maximum size and say!

...
classify( {.elems} ).
max.
value.
map( *.say );
...

Final Code

unit sub MAIN (*@n where { @n ~~ Int, @n.elems > 0 } );
(@n.sort.map({[$_]})).
produce( ->  \a, \b {
                 b.first - a.tail == 1
                 ?? a.append(b.first).clone
                 !! b.clone
           } ).
classify( {.elems} ).
max.
value.
map( *.say );

Happy Coding!!
I spent too much time on common-lisp and golang.
I'm so sorry to say that I'll skip blog about task #2.

May Perl and Raku be with you!!
🐪PWC🦋

If you want to challenge yourself on programming, especially on Perl and/or Raku, go to https://perlweeklychallenge.org, code the latest challenges, submit codes on-time (by GitHub or email).

Task 1 Longest Consecutive Sequence

Task 2 Largest Rectangle

The COVID-19 is more active in winter. Beware.

Do tell or correct me, if you have oppositions, want to discuss or give me advice!

Dear friends, stay alert and healthy! □

link for codes: ch-1.pl, ch-2.pl, ch-1.lsp

These are some answers to the Week 87 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days (November 22, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Longest Consecutive Sequences

You are given an unsorted array of integers @N.

Write a script to find the longest consecutive sequence. Print 0 if none sequence found.

Example 1:

Input: @N = (100, 4, 50, 3, 2)
Output: (2, 3, 4)

Example 2:

Input: @N = (20, 30, 10, 40, 50)
Output: 0

Example 3:

Input: @N = (20, 19, 9, 11, 10)
Output: (9, 10, 11)

We’re given an unsorted array, but there is nothing preventing us from starting by sorting the array. Once the input is sorted, the solution is quite easy. Note that, if Raku or Perl did not have a built-in sort function, the first thing I would do is probably to implement a sort subroutine. I have shown elsewhere that a quick sort or merge sort subroutine can be written in about half a dozen code lines, both in Raku and in Perl, with a functional programming approach. For example, this is a quick sort implementation in Raku:

sub quicksort (@input) {
    return @input if @input.elems <= 1;
    my $pivot = @input[@input.elems div 2];
    return flat quicksort(grep {$_ < $pivot}, @input), 
        (grep {$_ == $pivot}, @input), 
        quicksort(grep {$_ > $pivot}, @input);
}

Longest Consecutive Sequences in Raku

We use three input arrays for our tests. For each test case, we simply sort the input array and scan the sorted results for consecutive sequences. Consecutive sequences are stored in the @sequences array of arrays and we finally display the longest sequence:

use v6;

my @tests = [ 100, 4, 50, 3, 2 ],
            [ 20, 30, 10, 40, 50 ],
            [ 20, 19, 9, 11, 10 ];

for @tests -> @t {
    my @in = sort @t;
    my $last = @in[0];
    my @sequences;
    my $index = 0;
    push @sequences[$index], $last;
    for 1..@in.end -> $i {
        my $current = @in[$i];
        $index++ if $current != $last + 1;
        push @sequences[$index], $current;
        $last = $current;
    }
    my @sorted_seq = sort { $^b.elems <=> $^a.elems }, @sequence;
    if @sorted_seq[0] > 1 {
        say @sorted_seq[0];
    } else {
        say 0;
    }
}

This displays the following output:

[2 3 4]
0
[9 10 11]

Longest Consecutive Sequences in Perl

In this Perl version, we also use three input arrays for our tests. For each test case, we simply sort the input array and scan the sorted results for consecutive sequences. Consecutive sequences are stored in the @sequences array of arrays and we simply output the longest sequence:

use strict;
use warnings;
use feature "say";
use Data::Dumper;

my @tests = ( [ 100, 4, 50, 3, 2 ],
              [ 20, 30, 10, 40, 50 ],
              [ 20, 19, 9, 11, 10 ]
            );

for my $t_ref (@tests) {
    my @in = sort { $a <=> $b } @$t_ref;
    my $last = $in[0];
    my @sequences;
    my $index = 0;
    push @{$sequences[$index]}, $last;
    for my $i (1..$#in) {
        my $current = $in[$i];
        $index++ if $current != $last + 1;
        push @{$sequences[$index]}, $current;
        $last = $current;
    }
    my @sorted_seq = sort { scalar @$b <=> scalar @$a } @sequences;
    if (scalar @{$sorted_seq[0]} > 1) {
        say "@{$sorted_seq[0]}";
    } else {
        say 0;
    }
}

This is the output displayed by this script:

$ perl longest-seq.pl
2 3 4
0
9 10 11

Task 2: Largest Rectangle

You are given matrix m x n with 0 and 1.

Write a script to find the largest rectangle containing only 1. Print 0 if none found.

Example 1:

Input:
    [ 0 0 0 1 0 0 ]
    [ 1 1 1 0 0 0 ]
    [ 0 0 1 0 0 1 ]
    [ 1 1 1 1 1 0 ]
    [ 1 1 1 1 1 0 ]

Output:
    [ 1 1 1 1 1 ]
    [ 1 1 1 1 1 ]

Example 2:

Input:
    [ 1 0 1 0 1 0 ]
    [ 0 1 0 1 0 1 ]
    [ 1 0 1 0 1 0 ]
    [ 0 1 0 1 0 1 ]

Output: 0

Example 3:

Input:
    [ 0 0 0 1 1 1 ]
    [ 1 1 1 1 1 1 ]
    [ 0 0 1 0 0 1 ]
    [ 0 0 1 1 1 1 ]
    [ 0 0 1 1 1 1 ]

Output:
    [ 1 1 1 1 ]
    [ 1 1 1 1 ]

At first glance, this seemed to be a fairly easy task. It turned out to be much more complicated than I expected.

My initial idea was to scan the matrix from top left to bottom right, and, for any 1 found, to try to expand this position into a region toward the right and toward the bottom. When starting to think about the implementation, I found that this approach was going to be complicated, painful, and probably quite clumsy.

So, I decided to proceed in a different way: generate all rectangles toward the right and the bottom of any position with a 1, then eliminate those containing at least one zero, and find the largest remaining rectangle. In both the Raku and the Perl programs below, a rectangle consists of at least two contiguous 1s, and is uniquely defined by its top left and bottom right corners.

As both the Raku and the Perl programs described below are a bit complicated, I will avoid abusing the expressive power of the programming language ans will describe separately the main steps of the algorithm before providing the full program.

Largest Rectangle in Raku

For this program, we’ll use six matrices as test cases:

my @matrices = 
    [ [ <0 1 0 1> ], [ <0 0 1 0> ], [ <1 1 0 1> ], [ <1 1 0 1> ] ], 
    [ [ <1 1 0 1> ], [ <1 1 0 0> ], [ <0 1 1 1> ], [ <1 0 1 1> ] ],
    [ [ <0 1 0 1> ], [ <1 0 1 0> ], [ <0 1 0 0> ], [ <1 0 0 1> ] ],

    [ [ <1 1 0 1 1 1> ], [ <1 1 1 0 1 0> ], 
        [ <1 1 0 1 0 1> ], [ <1 1 1 0 0 1> ] 
    ],

    [ [ <0 0 0 1 0 0> ], [ <1 1 1 0 0 0> ], 
      [ <0 0 1 0 0 1> ], [ <1 1 1 1 1 0> ], [ <1 1 1 1 1 0>],
    ],

    [ [ <0 0 0 1 1 1> ], [ <1 1 1 1 1 1> ], 
      [ <0 0 1 0 0 1> ], [ <0 0 1 1 1 1> ], 
      [ <0 0 1 1 1 1> ],
    ];

The first step will be to iterate over the six test cases and for each test matrix, to call the print-matrix subroutine (which pretty-prints the input matrix) and the find-rect subroutine, which does most of the work and will be described in greater detail below.

for @matrices -> @m {
    print-matrix @m;
    find-rect @m;
}

The print-matrix reads the input matrix line by line and prints a formated version of all such lines:

sub print-matrix (@matrix) {
    say "[ $_ ]" for @matrix;
    say "";
}

For our first test matrix:

[ [ <0 1 0 1> ], [ <0 0 1 0> ], [ <1 1 0 1> ], [ <1 1 0 1> ] ]

this subroutine prints this:

[ 0 1 0 1 ]
[ 0 0 1 0 ]
[ 1 1 0 1 ]
[ 1 1 0 1 ]

As said before, the find-rect does the bulk of the work.

First, we make a @positions array of all positions (defined by their coordinates) in the matrix that contain a value equal to 1. For this, we use the X infix cross operator to generate a Cartesian product of all positions and filter out positions whose value in the matrix is not equal to 1:

my $max-h = @m.end;
my $max-w = @m[0].end;
my @positions =  ((0..$max-h) X  (0..$max-w))
    .grep({@m[$_[0]][$_[1]] == 1});

For the first test matrix, the list of valid positions is this:

[(0 1) (0 3) (1 2) (2 0) (2 1) (2 3) (3 0) (3 1) (3 3)]

The next step is to create a @pairs list of pairs of positions (which will represent the top left and bottom right corners of each rectangle). For this, we use the combinations built-in routine of Raku:

    my @pairs = @positions.combinations: 2;

For our first test matrix, this generates a data structure like so (slightly reformatted for clarity):

[((0 1) (0 3))  ((0 1) (1 2))  ((0 1) (2 0))  ((0 1) (2 1)) 
 ((0 1) (2 3))  ((0 1) (3 0))  ((0 1) (3 1))  ((0 1) (3 3)) 
 [content omitted for brevity]
 ((2 1) (3 1))  ((2 1) (3 3))  ((2 3) (3 0))  ((2 3) (3 1)) 
 ((2 3) (3 3))  ((3 0) (3 1))  ((3 0) (3 3))  ((3 1) (3 3))]

Note that, at this point, the rectangles represented by those point pairs may contain some 0s (we only know that the point pairs themselves are 1s). For example, the first point pair above:

((0 1) (0 3))

corresponds to the following rectangle in the input matrix:

1 0 1

As it can be seen, the bounds are 1s, but the middle item if 0. This is not a valid rectangle candidate.

In addition, the ((0 1) (3 0)) pair in the second line doesn’t define a valid rectangle because the second coordinate of the first pair (1) is larger than its counterpart in second pair, and we said that the first pair must represent the top left and the second pair the bottom right points of the rectangle. Here, the second point is to the left of the first. We need to eliminate these malformed rectangles.

The next step is therefore to keep only valid rectangles rectangles and store them into the @eligible array:

my @eligible = gather {
    for @pairs -> $p {
        # Remove malformed rectangles
        next if $p[0][0] > $p[1][0] or $p[0][1] > $p[1][1];
        # remove rectangles containing 0s.
        next if @m[$p[0][0]..$p[1][0];$p[0][1]..$p[1][1]].any == 0; 
        take $p;
    }
}

Note that the following expression (using a semi-colon to separate the coordinate ranges) : @m[$p[0][0]..$p[1][0];$p[0][1]..$p[1][1]]

flattens the input rectangle into a flat list, so that we can use a simple any junction to detect any 0 item.

If the @eligible array is empty, then we did not find any suitable rectangle. In such a case, we print 0 and exit the subroutine.

say "0\n" and return unless @eligible;

In the case of our first test matrix, there are six eligible rectangles:

[((2 0) (2 1))  ((2 0) (3 0))  ((2 0) (3 1))  
 ((2 1) (3 1))  ((2 3) (3 3))  ((3 0) (3 1))
]

We now need to pick the largest rectangle. For this, we simply sort in descending order according to their area size. In Raku, when the code object passed as the first parameter to the sort subroutine takes only one parameter, then it is not a comparison code block, but a code object implementing the transformation to be applied to all items before applying the default cmpcomparison subroutine. Here, we use this code block:

{($_[1][0] - $_[0][0] + 1) * ($_[1][1] - $_[0][1] + 1)}

in order to compute the area of the rectangle and use it for the comparison. So the sort block looks like this:

my $rect = (reverse sort { 
        ($_[1][0] - $_[0][0] + 1) * ($_[1][1] - $_[0][1] + 1) 
        }, @eligible)[0];

Now, we’re done, we have the largest rectangle, we only need to display the result.

This is the full code of the program:

use v6;

my @matrices = 
    [ [ <0 1 0 1> ], [ <0 0 1 0> ], [ <1 1 0 1> ], [ <1 1 0 1> ] ], 
    [ [ <1 1 0 1> ], [ <1 1 0 0> ], [ <0 1 1 1> ], [ <1 0 1 1> ] ],
    [ [ <0 1 0 1> ], [ <1 0 1 0> ], [ <0 1 0 0> ], [ <1 0 0 1> ] ],

    [ [ <1 1 0 1 1 1> ], [ <1 1 1 0 1 0> ], 
        [ <1 1 0 1 0 1> ], [ <1 1 1 0 0 1> ] 
    ],

    [ [ <0 0 0 1 0 0> ], [ <1 1 1 0 0 0> ], 
      [ <0 0 1 0 0 1> ], [ <1 1 1 1 1 0> ], [ <1 1 1 1 1 0>],
    ],

    [ [ <0 0 0 1 1 1> ], [ <1 1 1 1 1 1> ], 
      [ <0 0 1 0 0 1> ], [ <0 0 1 1 1 1> ], 
      [ <0 0 1 1 1 1> ],
    ];

for @matrices -> @m {
    print-matrix @m;
    find-rect @m;
}
sub print-matrix (@matrix) {
    say "[ $_ ]" for @matrix;
    say "";
}

sub find-rect (@m) {
    my $max-h = @m.end;
    my $max-w = @m[0].end;
    my @positions =  ((0..$max-h) X  (0..$max-w))
        .grep({@m[$_[0]][$_[1]] == 1});
    # say @positions;
    my @pairs = @positions.combinations: 2;
    # say @pairs;
    my @eligible = gather {
        for @pairs -> $p {
            next if $p[0][0] > $p[1][0] or $p[0][1] > $p[1][1];
            next if @m[$p[0][0]..$p[1][0];$p[0][1]..$p[1][1]].any == 0; 
            take $p;
        }
    }
    say "0\n" and return unless @eligible;
    my $rect = (reverse sort { 
            ($_[1][0] - $_[0][0] + 1) * ($_[1][1] - $_[0][1] + 1) 
            }, @eligible)[0];
    say  "Rectangle corners: ", $rect;
    for $rect[0][0]..$rect[1][0] -> $row {
        say @m[$row][$rect[0][1]..$rect[1][1]];
    }
    say "";
}

This program displays the following output:

$ raku rectangular-matrix.raku
[ 0 1 0 1 ]
[ 0 0 1 0 ]
[ 1 1 0 1 ]
[ 1 1 0 1 ]

Rectangle corners: ((2 0) (3 1))
(1 1)
(1 1)

[ 1 1 0 1 ]
[ 1 1 0 0 ]
[ 0 1 1 1 ]
[ 1 0 1 1 ]

Rectangle corners: ((2 2) (3 3))
(1 1)
(1 1)

[ 0 1 0 1 ]
[ 1 0 1 0 ]
[ 0 1 0 0 ]
[ 1 0 0 1 ]

0

[ 1 1 0 1 1 1 ]
[ 1 1 1 0 1 0 ]
[ 1 1 0 1 0 1 ]
[ 1 1 1 0 0 1 ]

Rectangle corners: ((0 0) (3 1))
(1 1)
(1 1)
(1 1)
(1 1)

[ 0 0 0 1 0 0 ]
[ 1 1 1 0 0 0 ]
[ 0 0 1 0 0 1 ]
[ 1 1 1 1 1 0 ]
[ 1 1 1 1 1 0 ]

Rectangle corners: ((3 0) (4 4))
(1 1 1 1 1)
(1 1 1 1 1)

[ 0 0 0 1 1 1 ]
[ 1 1 1 1 1 1 ]
[ 0 0 1 0 0 1 ]
[ 0 0 1 1 1 1 ]
[ 0 0 1 1 1 1 ]

Rectangle corners: ((3 2) (4 5))
(1 1 1 1)
(1 1 1 1)

Largest Rectangle in Perl

For this program, we’ll use seven matrices for our test cases:

my @matrices = 
    ( [ [ qw <0 1 0 1> ], [ qw <0 0 1 0> ], 
        [ qw <1 1 0 1> ], [ qw <1 1 0 1> ] 
      ], 

      [ [ qw <1 1 0 1> ], [ qw <1 1 0 0> ], 
        [ qw <0 1 1 1> ], [ qw <1 0 1 1> ] 
      ],

      [ [ qw <0 1 0 1> ], [ qw <1 0 1 0> ], 
        [ qw <0 1 0 0> ], [ qw <1 0 0 1> ] 
      ],

      [ [ qw <1 1 0 1 1 1> ], [ qw <1 1 1 0 1 0> ], 
          [ qw <1 1 0 1 0 1> ], [ qw <1 1 1 0 0 1> ] 
      ],

      [ [ qw <0 0 0 1 0 0> ], [ qw <1 1 1 0 0 0> ], 
          [ qw <0 0 1 0 0 1> ], [ qw <1 1 1 1 1 0> ], 
          [ qw <1 1 1 1 1 0>],
      ],
      [ [ qw <1 0 1 0 1 0> ], [ qw <0 1 0 1 0 1> ], 
          [ qw <1 0 1 0 1 0> ], [ qw <0 1 0 1 0 1> ],
      ],
      [ [ qw <0 0 0 1 1 1> ], [ qw <1 1 1 1 1 1> ], 
          [ qw <0 0 1 0 0 1> ], [ qw <0 0 1 1 1 1> ], 
          [ qw <0 0 1 1 1 1> ],
      ],
    );

The first step will be to iterate over the seven test cases and for each test matrix, to call the print_matrix subroutine (which pretty-prints the input matrix) and the find_rect subroutine, which does most of the work and will be described in detail below.

for my $m_ref (@matrices) {
    print_matrix($m_ref);
    find_rect($m_ref);
}

sub print_matrix {
    my @matrix = @{$_[0]};
    say "";
    say "[ @$_ ]" for @matrix;
    say "";
}

For our first sample matrix:

             [ [ qw <0 1 0 1> ], [ qw <0 0 1 0> ], 
               [ qw <1 1 0 1> ], [ qw <1 1 0 1> ] 
             ],

the print_matrix subroutine displays this:

[ 0 1 0 1 ]
[ 0 0 1 0 ]
[ 1 1 0 1 ]
[ 1 1 0 1 ]

As said before, the find-rect does the bulk of the work.

First, we make a @positions array of all positions (defined by their coordinates) in the matrix that contain a value equal to 1. For this, we use a nested for loop:

my @positions;
for my $i (0..$#m) {
    for my $j (0..$#{$m[0]}) {
        push @positions, [$i, $j] unless $m[$i][$j] == 0;
    }
}

For the first test matrix, we obtain the following non-zero positions:

(0 1) (0 3) (1 2) (2 0) (2 1) (2 3) (3 0) (3 1) (3 3)

Then we use another nested for loop to find all the point pairs:

my @pairs;
for my $k (0..$#positions) {
    for my $n ($k+1..$#positions) {
        push @pairs, [ [@{$positions[$k]}], [@{$positions[$n]}] ];
    }
}

Note that, at this point, the rectangles represented by those point pairs may contain some 0s (we only know that the point pairs themselves are 1s). For example, the first point pair generated:

((0 1) (0 3))

corresponds to the following rectangle in the matrix:

1 0 1

As it can be seen, the bounds are 1s, but the middle item is 0. This is not a valid rectangle candidate.

In addition, we obtain pairs such as ((0 1) (3 0)) , which doesn’t define a valid rectangle because the second coordinate of the first pair (1) is larger than its counterpart in second pair, and we said earlier that the first pair must represent the top left point and the second pair the bottom right point of the rectangle. Here, the second point is to the left of the first. We need to eliminate these malformed rectangles.

The code below eliminates invalid rectangles and stores the others in the @eligible array:

my @eligible;
for my $p_ref (@pairs) {
    my @p = @$p_ref;
    # Remove malformed rectangles
    next if $p[0][0] > $p[1][0] or $p[0][1] > $p[1][1];
    # Remove rectangles containing 0s
    my $only_ones = 1;
    for my $i ($p[0][0].. $p[1][0]) {
        for my $j ($p[0][1]..$p[1][1]) {
            if ($m[$i][$j] == 0) {
                $only_ones = 0;
                next;
            }
        }
    }
     push @eligible, $p_ref if $only_ones;
}

If the @eligible array is empty, then we did not find any suitable rectangle. So, we print out 0 and exit the subroutine.

say "0\n" and return unless @eligible;

In the case of our first test matrix, there are six eligible rectangles left:

((2 0) (2 1))  ((2 0) (3 0))  ((2 0) (3 1))  ((2 1) (3 1))  ((2 3) (3 3))  ((3 0) (3 1))

We now need to find the largest rectangle. For this, we sort the eligible rectangles in descending order according to their area size and pick the first one in the sorted list. Since the comparison routine computing the rectangle area is somewhat complicated, we use a Schwartzian Transform for the sort:

my @sorted = map { $_->[0] } 
             sort { $b->[1] <=> $a->[1] }
             map { [$_, ($_->[1][0] - $_->[0][0] + 1) 
                   * ($_->[1][1] - $_->[0][1] + 1)] } 
                   @eligible;
my $rect = $sorted[0];

Now that we have found the largest rectangle, we only need to display the result.

This is the full code of the program:

use strict;
use warnings;
use feature "say";
use Data::Dumper;

my @matrices = 
    ( [ [ qw <0 1 0 1> ], [ qw <0 0 1 0> ], 
        [ qw <1 1 0 1> ], [ qw <1 1 0 1> ] 
      ], 

      [ [ qw <1 1 0 1> ], [ qw <1 1 0 0> ], 
        [ qw <0 1 1 1> ], [ qw <1 0 1 1> ] 
      ],

      [ [ qw <0 1 0 1> ], [ qw <1 0 1 0> ], 
        [ qw <0 1 0 0> ], [ qw <1 0 0 1> ] 
      ],

      [ [ qw <1 1 0 1 1 1> ], [ qw <1 1 1 0 1 0> ], 
          [ qw <1 1 0 1 0 1> ], [ qw <1 1 1 0 0 1> ] 
      ],

      [ [ qw <0 0 0 1 0 0> ], [ qw <1 1 1 0 0 0> ], 
          [ qw <0 0 1 0 0 1> ], [ qw <1 1 1 1 1 0> ], 
          [ qw <1 1 1 1 1 0>],
      ],
      [ [ qw <1 0 1 0 1 0> ], [ qw <0 1 0 1 0 1> ], 
          [ qw <1 0 1 0 1 0> ], [ qw <0 1 0 1 0 1> ],
      ],
      [ [ qw <0 0 0 1 1 1> ], [ qw <1 1 1 1 1 1> ], 
          [ qw <0 0 1 0 0 1> ], [ qw <0 0 1 1 1 1> ], 
          [ qw <0 0 1 1 1 1> ],
      ],
    );

for my $m_ref (@matrices) {
    print_matrix($m_ref);
    find_rect($m_ref);
}

sub print_matrix {
    my @matrix = @{$_[0]};
    say "";
    say "[ @$_ ]" for @matrix;
    say "";
}

sub find_rect {
    my @m = @{$_[0]};
    my $max_h = scalar @m;
    my $max_w = scalar @{$m[0]};
    my @positions;
    for my $i (0..$#m) {
        for my $j (0..$#{$m[0]}) {
            push @positions, [$i, $j] unless $m[$i][$j] == 0;
        }
    }
    my @pairs;
    for my $k (0..$#positions) {
        for my $n ($k+1..$#positions) {
            push @pairs, [ [@{$positions[$k]}], [@{$positions[$n]}] ];
        }
    }

    my @eligible;
    for my $p_ref (@pairs) {
        my @p = @$p_ref;
        next if $p[0][0] > $p[1][0] or $p[0][1] > $p[1][1];
        my $only_ones = 1;
        for my $i ($p[0][0].. $p[1][0]) {
            for my $j ($p[0][1]..$p[1][1]) {
                if ($m[$i][$j] == 0) {
                    $only_ones = 0;
                    next;
                }
            }
        }
         push @eligible, $p_ref if $only_ones;
    } 

    say 0 and return unless @eligible;

my @sorted = map { $_->[0] } 
             sort { $b->[1] <=> $a->[1] }
             map { [$_, ($_->[1][0] - $_->[0][0] + 1) 
                   * ($_->[1][1] - $_->[0][1] + 1)] } 
                   @eligible;
    my $rect = $sorted[0];
    say "Rectangle corners: ";
    say "@$_" for @$rect; 
    say "\nRectangle:";

    for my $row ($rect->[0][0]..$rect->[1][0]) {
        say "@{$m[$row]}[$rect->[0][1]..$rect->[1][1]]";
    }
    say "";
}

This script displays the following output:

$ perl  rectangular-matrix.pl

[ 0 1 0 1 ]
[ 0 0 1 0 ]
[ 1 1 0 1 ]
[ 1 1 0 1 ]

Rectangle corners:
2 0
3 1

Rectangle:
1 1
1 1


[ 1 1 0 1 ]
[ 1 1 0 0 ]
[ 0 1 1 1 ]
[ 1 0 1 1 ]

Rectangle corners:
0 0
1 1

Rectangle:
1 1
1 1


[ 0 1 0 1 ]
[ 1 0 1 0 ]
[ 0 1 0 0 ]
[ 1 0 0 1 ]

0

[ 1 1 0 1 1 1 ]
[ 1 1 1 0 1 0 ]
[ 1 1 0 1 0 1 ]
[ 1 1 1 0 0 1 ]

Rectangle corners:
0 0
3 1

Rectangle:
1 1
1 1
1 1
1 1


[ 0 0 0 1 0 0 ]
[ 1 1 1 0 0 0 ]
[ 0 0 1 0 0 1 ]
[ 1 1 1 1 1 0 ]
[ 1 1 1 1 1 0 ]

Rectangle corners:
3 0
4 4

Rectangle:
1 1 1 1 1
1 1 1 1 1


[ 1 0 1 0 1 0 ]
[ 0 1 0 1 0 1 ]
[ 1 0 1 0 1 0 ]
[ 0 1 0 1 0 1 ]

0

[ 0 0 0 1 1 1 ]
[ 1 1 1 1 1 1 ]
[ 0 0 1 0 0 1 ]
[ 0 0 1 1 1 1 ]
[ 0 0 1 1 1 1 ]

Rectangle corners:
3 2
4 5

Rectangle:
1 1 1 1
1 1 1 1

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 Sunday, November, 29, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.

1. Convert::Binary::C - Binary Data Conversion using C Types
   • Version: 0.83 on 2020-11-19
   • Votes: 13
   • Previous version: 0.79 was 6 months before
2. ExtUtils::MakeMaker - Create a module Makefile
   • Version: 7.56 on 2020-11-19
   • Votes: 47
   • Previous version: 7.54 was 7 days before
3. GraphViz2 - A wrapper for AT&T's Graphviz
   • Version: 2.62 on 2020-11-16
   • Votes: 12
   • Previous version: 2.61 was 8 days before
4. Module::CoreList - what modules shipped with versions of perl
   • Version: 5.20201120 on 2020-11-20
   • Votes: 34
   • Previous version: 5.20201020 was 1 month before
5. Moo - Minimalist Object Orientation (with Moose compatibility)
   • Version: 2.004003 on 2020-11-21
   • Votes: 277
   • Previous version: 2.004000 was 7 months, 12 days before
6. Net::DNS - Perl Interface to the Domain Name System
   • Version: 1.29 on 2020-11-18
   • Votes: 21
   • Previous version: 1.28 was 26 days before
7. PDL - Perl Data Language
   • Version: 2.025 on 2020-11-19
   • Votes: 37
   • Previous version: 2.024 was 2 months, 2 days before
8. Pod::Simple - framework for parsing Pod
   • Version: 3.42 on 2020-11-14
   • Votes: 15
   • Previous version: 3.41 was 1 month, 2 days before
9. SPVM - Static Perl Virtual Machine. Fast Calculation, Fast Array Operation, and Easy C/C++ Binding.
   • Version: 0.0927 on 2020-11-20
   • Votes: 21
   • Previous version: 0.0926 was 14 days before
10. WWW::YouTube::Download - WWW::YouTube::Download - Very simple YouTube video download interface
    • Version: 0.65 on 2020-11-19
    • Votes: 19
    • Previous version: 0.64 was 1 month, 29 days before
11. Yancy - The Best Web Framework Deserves the Best CMS
    • Version: 1.067 on 2020-11-16
    • Votes: 36
    • Previous version: 1.066 was 3 months, 8 days before

This is the weekly favourites list of CPAN distributions. Votes count: 60

Week's winner (+3): Tickit::Widgets

Build date: 2020/11/21 14:22:09 GMT

Clicked for first time:

• File::ShouldUpdate - should files be rebuilt?
• Mojo::SAML - A SAML2 toolkit using the Mojo toolkit
• Net::SockAddr - Socket address OO-wrapper with Perl and C++ interface.
• Zydeco::Lite::App - use Zydeco::Lite to quickly develop command-line apps

Increasing its reputation:

• AI::Genetic::Pro (+1=4)
• App::HTTPThis (+1=20)
• Argon (+1=9)
• Array::Diff (+1=5)
• Child (+1=6)
• CLDR::Number (+1=9)
• common::sense (+1=21)
• CPAN::Changes (+1=28)
• CPAN::Digger (+1=2)
• Daemon::Control (+1=42)
• DateTime::Moonpig (+1=12)
• DateTime::Tiny (+1=7)
• DateTimeX::Immutable (+1=2)
• DBIx::RunSQL (+1=5)
• Devel::Confess (+1=32)
• Dist::Zilla (+1=175)
• Excel::Writer::XLSX (+1=55)
• Fsdb (+1=6)
• Getopt::Kingpin (+1=7)
• Getopt::Lucid (+1=12)
• Gtk3::ImageView (+1=2)
• Gtk3::WebKit2 (+2=2)
• Guard (+1=19)
• HTTP::Daemon (+1=11)
• HTTP::Tiny::Multipart (+1=3)
• Import::Base (+1=14)
• Lexical::Var (+1=2)
• Log::Any (+1=57)
• Mail::Toaster (+1=2)
• Mojolicious::Plugin::Log::Any (+1=3)
• Mojolicious::Plugin::SecurityHeader (+1=4)
• Net::NATS::Client (+1=4)
• OptArgs (+1=11)
• PAR::Dist (+1=3)
• Paws (+1=45)
• PDL::CCS (+1=4)
• Perl::Tidy (+1=120)
• PkgConfig (+1=4)
• Pod::Usage (+1=37)
• Regexp::Common (+1=50)
• Rex (+2=73)
• Smart::Comments (+1=36)
• String::ShellQuote (+1=15)
• Term::Animation (+1=4)
• Text::Levenshtein::Damerau (+1=3)
• Text::Table (+1=13)
• Tickit (+1=24)
• Tickit::Widget::Statusbar (+1=2)
• Tickit::Widgets (+3=5)
• Types::Serialiser (+1=2)
• use (+1=2)
• WWW::Mechanize (+1=84)

GitLab provides an integrated CI system that is driven by a single YAML based configuration. This example is based on the configuration file of the DBD::Mock module.

I have copied it here and removed some of the repetitions. Visit the repo of that project to see the file they have.

TPF Board members and the community leaders meet every month and here are the minutes from the October 2020 meeting.

Part 1 - Community

• Attendees

  • Board: Stuart Mackintosh, Peter Krawczyk, Dan Wright, Dave Rolsky, Ricardo Signes, Makoto Nozaki (late)
  • Leaders: Jason Crome, Samantha McVey, Alex Beamish, Sawyer X, Todd Rinaldo, Matthias Bloch
  • Admin: Nic Evans
  • Confirmed absence: Mark Keating, Curtis Poe

• Grants

  • One grant approved - needs funding as there's no budget
  • Another grant was approved earlier but no work started
    • Should have been canceled / resubmitted already according to the charter
  • Working with Nic on website updates - close to completion
  • Main issue - no working budget
    • Possibly review previous budgets and consider how this can be increased per year
    • Funds are sectioned to languages (GC, Perl and Raku)
    • Pete looking to rearrange fund 'pots' to enable easier tracking next year
  • Discussion around grants funding for funds - Can/should there be different pots? Can sponsors request specific support for each language - this needs further discussion - Jason Crome to follow up
  • Grant suggestions from the committee are available on the web

• Marketing

  • Brief survey carried out regarding brand of The Perl Foundation
  • Highlighted need for wider survey, putting together budget proposal
  • Filled in creative brief for TPF
  • Promotion of TPF via Google Ads - discussion going on
  • z/OS article was mentioned as a good addition to marketing
  • Website improvements, bugs/issues list created

• The Perl/Raku Conference (USA)

  • The contract of 2020/2021 is active

• EU Conference

  • Discussion points: Organizers and sponsorship
  • Organizers
    • Andrew mentioned possibility of Perl/Raku conference
    • Should we talking about making EU conference a TPF event?
    • There is currently no immediate visible interest in having funding of an EU conference in Europe taken over by TPF
    • Historically YEF was formed because TPF didn't have the people to do this. Also EPO was formed
    • We need to talk to the key people to organize an event in Europe
    • The nature of conferences may be different going forward, we don't know when they will return to how they used to be. We need to look at our future - do we want more virtual conferences? Are there other opportunities for physical?

  • Sponsorship

    • Costs might be lower for virtual - how easy to get sponsors for virtual versus physical conferences?

    • We need to be clear with sponsors if we have both a US and an EU conference

    • Opinions:

      • We have obligations to control how money is spent. There must be set guidelines. Whenever we create a special bucket for sponsorship we have an obligation to spend money on that bucket. We cannot then spend it on something else. What if we collect funds for a conference and it doesn't happen? We would have to give the money back. Currently we ask sponsors to give money to TPF (general funds) for this reason.
      • I want to make sure when I talk to sponsors to steer away from where money is going to 'this is TPF and we have various things we want to spend money on'. We need to avoid earmarked funds . Do not encourage sponsorship for specific items such as a conference.
      • I see this as more of an opportunity to get more money especially when the conference is held in a city where a major sponsor is located - need to find a way around legal issues - otherwise a missed opportunity
    • Could have a soft earmarking with disclaimer such as 'should event not happen, it will be moved to general funds.'
  • To continue discussion at next meeting

• Raku

  • The Raku steering council formed recently, elected by core developers.
  • Question: How does CAT relate to Raku community?
  • Stuart: joint decision taken to keep Raku with TPF for now - longer term vision keen to progress recognised resources. These must adhere to set of recognised quality standards. CAT was established to do this, so should also provide support to Raku communities. Although sounds like marketing, it is a governance function. So we should support Raku Steering Council in any conduct issues. We need a recognised Raku presence within the organisation.
  • Action: invite member of Raku community to attend the Community leaders meeting - let them know TPF will support Raku community

• Perl

  • Governance work to try and over time figure out a proper governance structure that is understood, accepted and supported by the community.
  • Stuart: this is about creating a process that will help the technical ecosystem for a long time. If it takes a long time, it needs to be done right/as best it can be - follow up again next month

• Infrastructure

  • Trying to get a coherent list of what needs to be done
  • Discussion on getting perl web infrastructure managed under same system
  • All the essential password are documented
  • We need to look at Github tracker and see that issues are closed
  • Feedback at moment is positive - need to promote the committee exists when it is in a good position.

Part 2 - Board

Attendees

• Stuart Mackintosh, Dave Rolsky, Dan Wright, Ricardo Signes, Pete Krawczyk, Makoto Nozaki, Nic Evans (admin)

Meeting topics

Note: the second part of the meeting (the board only) was short as the first part overran.

• TPRC 2020 Transparency Report was drafted. It will be reviewed and posted.
• Advisory Board - action items below.
  • Define the charter and procedure to "retire" people from the board
  • Think whether we could invite somebody to the Advisory Board even if they are not a board member
  • Announce the Advisory Board with inaugural members

Part 1

You are given an array of integers @N and an integer $A. Write a script to find find if there exists a pair of elements in the array whose difference is $A. Print 1 if exists otherwise 0.

Solution

use strict;
use warnings;
##
# You are given an array of integers @N and an integer $A.
# Write a script to find find if there exists a pair of elements 
# in the array whose difference is $A.
# Print 1 if exists otherwise 0.
##
use boolean;
use Math::Combinatorics;

sub build_constraints{
    my @constraints;
    my $a_not_equal_b = sub { $_[0] != $_[1] };
    my $difference_equal_n = sub { $_[0] - $_[1] == $_[2] };
    return (
       $a_not_equal_b,
       $difference_equal_n
    );
}

MAIN:{
    my $combinations = Math::Combinatorics->new(
                           count => 2,
                           data => [@ARGV[1 .. @ARGV - 1]],
                       );
    my $found = false;  
    my ($check_equal, $check_difference) = build_constraints();           
    while(my @combination = $combinations->next_combination()){  
        if($check_equal->(@combination) && $check_difference->(@combination, $ARGV[0])){
            $found = true;
            print "1\n"; last;
        }
    }
    print "0\n" if(!$found);
}

Sample Run

$ perl perl/ch-1.pl 15 10 30 20 50 40
0
$ perl perl/ch-1.pl 7 10 8 12 15 5
1

Notes

This is a fairly silly use of the constraint programming approach I used last week. Like last time I generate all combinations and test them using a filtering approach. The filter is an array of constraint functions. Here we just have two simple constraints though!

Part 2

You are given Sudoku puzzle (9x9). Write a script to complete the puzzle

Notes

I didn’t have a chance to implement a solution in Perl. I would have used a similar constraint approach if I did. This is a natural use for Prolog and if you’re interested in reading in my Prolog implementation you can go here.

We received no grant proposals for Perl or Raku in time for the November voting round. The next round of voting will be held starting in early January.

But... there's no need to wait until then. We accept grant proposals all year round. To apply, please read How to Write a Proposal, GC Charter, Rules of Operation and Running Grants List will also help you understand how the grant process works. We also got some grant ideas from the community.

Interpreters read and execute scripts (whereas shells are more like a kitchen pass-through and can either execute or hand over to another interpreter). When we specify interpreter on the command line, it is the one that will be used. For instance Rscript script.R will execute script.R using the Rscript interpreter.

When we execute a file without explicitly giving an interpreter (for instance, like ./myscript.pl), it is the job of the “shebang” to tell to the shell/OS which interpreter to use. The shebang is that first line of a text file that starts with #! and is followed by the interpreter path:

#!/usr/bin/perl

Sometimes we see the env program, which finds the the first perl in our path:

#!/usr/bin/env perl

env does not split args therefore we can’t add options:

#!/usr/bin/env perl -w

And, env is not always located in /usr/bin/env so it can guarantee some portability at machine/distribution level but not always between distributions.

Perl is nice

The perl is not like other interpreters—its nice, even with challenges. perl inspects the shebang to check if it’s really for it (and if not it hands our program over to another interpreter).

For instance the file i-am-python.pl contains a Python program, which is definitely not Perl:

#!/usr/bin/python
import os
import time

print("I'm a snake : " + os.environ["SHELL"] + " " + os.environ["_"])

# Keep it alive to have time to inspect with ps
while True:
    time.sleep(5)

Obviously we don’t care about the extension as it does not mean any kind of file association (although some systems let you associate it). So we have a .pl file and we execute it with perl but inside we have a python shebang and some python code. It’s clearly not a valid Perl file.

If you don’t believe me, check this with a quick syntax check perl -c i-am-python.pl that tells us it isn’t valid Perl:

$ perl -c i-am-python.pl
syntax error at i-am-python.pl line 3, near "import time"
i-am-python.pl had compilation errors.

When we execute this file with perl, surprisingly, everything goes fine. How did that happen? perl is smart enough to give the script to python!

$ perl i-am-python.pl
I'm a snake : /bin/bash /usr/bin/perl

And if we want to check which interpreter really runs this script, we can look in the process table:

$ ps aux | grep "i-am-pytho[n].pl"
tduponc+  5647  0.0  0.0  33208  7024 pts/0    S    13:04   0:00 /usr/bin/python i-am-python.pl

Note that i-am-pytho[n].pl with the brackets, which puts the n in a character class. That’s a nifty trick so grep finds the line with python but not the grep process itself because that pattern won’t match a literal [.

Don’t forget to kill the program since it’s sleeping forever!

Now, what if we want to test the converse and run Perl code with a python interpreter?

#!/usr/bin/perl

my $str = "I'm a jewel";
print "$str : $ENV{SHELL} $ENV{_}\n";

while (1) { sleep 5; }

This is a valid Perl file but the python interpreter does not hand over to perl and just returns a Python error:

$ python i-am-perl.py
  File "iamperl.py", line 3
    my $str = "I'm a jewel";
       ^
SyntaxError: invalid syntax

This is special to Python. Try it yourself with bash, Ruby, or something else.

I have something for you

Having the correct interpreter on the command line does not mean that the shebang is totally ignored. perl is once again super smart and behaves exactly as we can imagine (DWIM). For instance, what if we put a warning switch (-w) in the shebang, like in this file override-bang.pl:

#!/usr/bin/perl -w

$str = "will produce a warning";

Even though we don’t put the -w on the command line, we still get warnings:

$ perl override-bang.pl
Name "main::str" used only once: possible typo at override-bang.pl line 3.

Plenty is no plague

Now, what if we specify some switches on the command line and some others in the shebang? SPOILER: they are simply merged together.

When we run perl -c overridebang.pl to check a syntactically-valid file, we get the switches from the command line and the shebang line. We get a perl -cw execution:

Name "main::str" used only once: possible typo at override-bang.pl line 5.
override-bang.pl syntax OK

What if we have conflicting options like -w to enable warnings and -X to disable them? Here’s enable-warnings.pl:

#!/usr/bin/perl -w

$str = "will produce a warning";

When we run this on its own, we get a warning as expected:

$ perl enable-warnings.pl
Name "main::str" used only once: possible typo at warnings.pl line 3.

When we add -X on the command line, there is no output:

$ perl -X enable-warnings.pl

How about the other way around with -X on the shebang? Here’s disable-warnings.pl:

#!/usr/bin/perl -X

$str = "will produce a warning";

When we run this with -w, we still don’t get output:

$ perl -X enable-warnings.pl

The -X always turns off warnings.

The shebang (-X) is taken in priority versus the command line and no warning is reported. It’s the same if we execute the file with perl -W disable-warnings.pl.

We could imagine that’s a rule to resolve conflicts with “last seen” parameter but wait, it’s not that simple.

How about -X versus -W, which enables all warnings? Who wins then? It turns out that the last on defined wins. We can see that right on the command line:

$ perl -W -X -e '$str = "will produce a warning"'
$ perl -X -W -e '$str = "will produce a warning"'
Name "main::str" used only once: possible typo at -e line 1.

As an exercise for the reader, try the different combinations of taint checking options: -T and -U.

A magic incantation

Sometimes we see some odd lines at the beginning of Perl programs. What the hell is this black magic? This is actually very smart opening is “polyglot” and correct for both shells (with or without shebang support) and perl:

#!/usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
    if $running_under_some_shell;

If we start the script with perl, the job is done and perl executes:

eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
if $running_under_some_shell;

That $running_under_some_shell has no value, so the code translate to a false conditional. This line is ignored and the rest of the file is interpreted normally.:

eval 'exec /usr/bin/perl -S $0 ${1+"$@"} if 0;'

What if we start the script with a shell that recognizes the shebang? The shell does the handover to perl, which then reads the first line (shebang then eval ...). The execution flow is then the same than above (magic incantation does nothing and file is interpreted). Nothing surprising there.

But what if we started the script with a shell that does not recognize the shebang so no handover occurs right away? This is actually where this magic is useful. The shell will ignore first line and will never reach third line. Why will it never reach third line? A newline terminates the shell command and exec will replace the current execution by perl. The rest of the script doesn’t matter after that exec. Our code changes from this:

#!/usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
    if $running_under_some_shell;

to effectively this:

eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'

Those $0 and $@ are shell words for the script name and arguments and the -S tells perl look for the value in $0 using PATH environment variable. (perldoc)

-x is fun

We’ve had fun with the perl interpreter and the shebang, but perl has a -x which is already fun by design. This option tells Perl that the program to execute is actually embedded in a larger chunk of unrelated text to ignore. Perhaps the Perl program is in the middle of an email message:

"I do not know if it is what you want, but it is what you get.
        -- Larry Wall"

#!/usr/bin/env perl

print "perl -x ignores everything before shebang\n";
print <DATA>;

__END__

"Fortunately, it is easier to keep an old interpreter around than an
old computer.
        -- Larry Wall"

Executing this as a program is a syntax error because the Larry Wall quote before the shebang is not valid Perl. When we execute this code with perl -x, everything before the shebang is ignored and it works:

$ perl -x email.txt
perl -x ignores everything before shebang

"Fortunately, it is easier to keep an old interpreter around than an
old computer.
        -- Larry Wall"

Out of curiosity, what if we tried to go one step further? How about multiple shebangs in a file, where one of them has a -x:

#!/usr/bin/perl -x
#!/usr/bin/perl

But it only produces an error:

Can't emulate -x on #! line.

There is however a trick to achieve this, by using shell eval. That perl -x is now executed in a shell process and not interpreted by perl binary like previously.:

#!/bin/sh
eval 'exec perl -x $0 ${1+"$@"}'
die "another day"; exit 1
#!perl
print "$]\n";

startperl

This article would not be complete without discussing a bit about the config variable $Config{startperl}. This variable comes from Config.pm that provides information about configuration environment (which you also see with perl -V):

$ perl -e 'use Config; print $Config{startperl}'
#!/usr/bin/perl

This is actually built during compilation from defaults or user/vendor provided configs. What if we want a different value? Simply specify the value of this during the ./Configure step, the configure option is -Dstartperl='...'. We then need to rebuild perl:

$ ./Configure -des -Dstartperl='#!/my/shebang'
$ make test install

Now our custom value is the default:

$ perl -e 'use Config; print $Config{startperl}'
#!/my/shebang

ExtUtils::MakeMaker and Module::Build seems also to use startperl among other methods to fix modules shebangs.

Take care to use an interpreter or a program that behaves like a perl interpreter! Some CPAN modules use startperl to write first line of generated perl tests. The /usr/bin/env limitation still apply here.

Resources

• The #! magic, details about the shebang/hash-bang mechanism on various Unix flavours

• Why it is better to usr /usr/bin/env interpreter instead of /path/to/interpreter

• Could someone explain this shebang line which uses sh and then does exec perl?

• A tiny portion comes from Sortie de Perl 5.30.0 (en français).