We did Ruby, we did Python, time for a classic language you probably aren't seeing much of these days - Perl.

But this isn't just a Perl episode. As doing decent session isolation on Perl side would be quite difficult (and to be honest, even our Ruby/Python versions only did fairly limited isolation), we're flipping how things work:

• previously we had one language server instance, and multiple sessions there
• now we'll create a new language server instance for every session.

perl_language_server

#!/usr/bin/env perl

use JSON;

sub eval_and_capture {
  my ($code) = @_;

  my $output;
  do {
    local *STDOUT;
    local *STDERR;
    open STDOUT, ">>", \$output;
    open STDERR, ">>", \$output;
    eval($code);
  };
  encode_json({output => $output||"", error => $@});
}

while (<>) {
  my $body = from_json($_);
  my $result = eval_and_capture($body->{code});
  print "$result\n";
  flush STDOUT;
}

This was all surprisingly simple.

Perl's eval already catches exceptions by deafult, to the very intuitively named $@ variable, so we don't need to do any kind of try/catch. It's actually not a bad default.

If you do local *STDOUT in a block, and reopen STDOUT, Perl will automatically restore it when it exits the block. This local trick works for a lot of things like variables, parts of variables, process ENV, and so on, and it's one of the very powerful things in Perl that no other language even tried to copy.

Opening to a reference to a scalar (\$output) redirects output to that scalar. It's that \ character that makes it redirect to $output instead of treating it as a file name.

And like in other language servers, we need to flush the output, so the buffering doesn't get it our way.

The code doesn't do any session management - everything you do will be in its main scope.

src/preload.js

let child_process = require("child_process")
let lineReader = require("promise-readline")
let { contextBridge } = require("electron")

let languageServers = {}

async function startLanguageServer() {
  let process = child_process.spawn(
    "./perl_language_server",
    [],
    {
      stdio: ["pipe", "pipe", "inherit"],
    },
  )
  return {
    process,
    stdin: process.stdin,
    stdout: lineReader(process.stdout),
  }
}

async function runCode(sessionId, code) {
  if (!languageServers[sessionId]) {
    languageServers[sessionId] = await startLanguageServer()
  }
  let { stdin, stdout } = languageServers[sessionId]
  await stdin.write(JSON.stringify({ code }) + "\n")
  let line = await stdout.readLine()
  return JSON.parse(line)
}

contextBridge.exposeInMainWorld(
  "api", { runCode }
)

The necessary change is tiny. Instead of single languageServer variable, it's now a dictionary of connections, keyed by session id.

We definitely could add some logic for closing processes we no longer use, and error handling, but it's fine for now.

Result

I wrote the usual Fibonacci code, and then searched the Internet for the most idiomatic Perl Hello World.

Here's the result if we press "Run All" button:

In the next episode we'll start a new project.

As usual, all the code for the episode is here.

If I made a distribution Foo and uploaded it to CPAN, I'd expect that it is install-able via various CPAN clients such as cpan, cpanm, cpm, that is, from a fresh perl installation, these commands should be successful:

cpan Foo
cpanm Foo
cpm install -g Foo

What's a bit non-obvious is that this requires a chain of conventions to be satisfied in order to happen smoothly... distribution Foo needs to properly ship with build procedure / installer and MEAT.json, in which all dependencies are correctly declared.

But that is not enough, even if I correctly authored all the meta-data in distribution Foo, if there is even a single miss in any other dependencies in Foo's dependency tree, the installation would fail.

For that reason, I thought it might be worth it to test the installation process during development, at least make a CI workflow that tries to install everything. The successful of such test would just be whether the installation is successfully finished or not. Conventionally the exit status ($?) reflects that.

Here's something I came up with. It is a GitHub workflow that first build a distribution, a .tar.gz file, then try to install that file with cpanm:

name: Installation Test

on:
  push:
    branches:
      - fun

jobs:
  build:
    runs-on: 'ubuntu-latest'
    steps:
      - uses: actions/checkout@v2
      - name: Setup Perl environment
        uses: shogo82148/actions-setup-perl@v1
      - name: Install Authoring Dependencies
        run: cpanm -n App::ModuleBuildTiny && cpanm -q -n --no-man-pages --installdeps .
      - name: Generate dist
        run: mbtiny dist
      - name: Display what is generated
        run: |-
          echo *.tar.gz
          tar tvzf *.tar.gz
      - uses: actions/upload-artifact@v2
        with:
          name: dist-for-installation-test
          path: '*.tar.gz'
          retention-days: 1
  install:
    runs-on: 'ubuntu-latest'
    needs: build
    container:
      image: perl:5.34
    steps:
      - uses: actions/download-artifact@v2
        with:
          name: dist-for-installation-test
      - name: Display the downloaded files
        run: ls -R
      - name: Install in a perl:5.34 container (--notest)
        run: cpanm --notest *.tar.gz

There are a lot of instructions but what matters is the final one cpanm --notest *.tar.gz. This would install whatever was built and all its dependencies, without running module tests`, and if even that failed, that means some meta data is missing and the distribution would not be install-able even if it is uploaded to CPAN.

Of course that just cpanm, I could also add cpan and cpm there to verify whether there is a difference between all these CPAN clients. Also, I could setup a matrix run so it runs on all perl versions.

This workflow is currently used in Perl-Critic-TooMuchCode, with a few runs already finished here.

The workflow contains two jobs, build and install. install needs build so it is always executed after successful build.

The build job runs on the default ubuntu-latest machine, but the install job runs in a container instance with presumably a different version of perl, and also without a clone of current repo. With this setup I can simulate the installation process on a fresh machine.

To share the distribution .tar.gz file across different jobs, the only way I can fin is by uploading the file to the "artifact" storage -- basically an external storage. This probably cost me something if a lot of files are accumulated. I changed the retention period to 1 day because I don't plan to download this anyway.

On the other hand, it could be part of doing the actual CPAN release. Maybe with some modification the workflow would build a new version with new version number, and I would just have to download the artifact then re-upload to CPAN. This would save the setup of preparing authoring tools. It could be a useful scenario for teaching new developers to upload something to CPAN.

The installation process also download a lot of stuffs from cpan.org and cost some bandwidth on the way. It's best not to do so on every commits or on a branch with frequent pushes. Definitely suitable pre-release though.

Most likely, this idea of "Installation as a test" isn't new, and it is a bit convenient to have it checked in CI.

Originally posted on gugod's blog -- CPAN installation as a test, with GitHub workflow

The perlcritic tool is often your first defense against “awkward, hard to read, error-prone, or unconventional constructs in your code,” per its description. It’s part of a class of programs historically known as linters, so-called because like a clothes dryer machine’s lint trap, they “detect small errors with big effects.” (Another such linter is perltidy, which I’ve referenced in the past.)

You can use perlcritic at the command line, integrated with your editor, as a git pre-commit hook, or (my preference) as part of your author tests. It’s driven by policies, individual modules that check your code against a particular recommendation, many of them from Damian Conway’s Perl Best Practices (2005). Those policies, in turn, are enabled by PPI, a library that transforms Perl code into documents that can be programmatically examined and manipulated much like the Document Object Model (DOM) is used to programmatically access web pages.

perlcritic enables the following policies by default unless you customize its configuration or install more. These are just the “gentle” (severity level 5) policies, so consider them the bare minimum in detecting bad practices. The full set of included policies goes much deeper, ratcheting up the severity to “stern,” “harsh,” “cruel,” and “brutal.” They’re further organized according to themes so that you might selectively review your code against issues like security, maintenance, complexity, and bug prevention.

• BuiltinFunctions::ProhibitSleepViaSelect
• BuiltinFunctions::ProhibitStringyEval
• BuiltinFunctions::RequireGlobFunction
• ClassHierarchies::ProhibitOneArgBless
• ControlStructures::ProhibitMutatingListFunctions
• InputOutput::ProhibitBarewordFileHandles
• InputOutput::ProhibitInteractiveTest
• InputOutput::ProhibitTwoArgOpen
• InputOutput::RequireEncodingWithUTF8Layer
• Modules::ProhibitEvilModules
• Modules::RequireBarewordIncludes
• Modules::RequireFilenameMatchesPackage
• Subroutines::ProhibitExplicitReturnUndef
• Subroutines::ProhibitNestedSubs
• Subroutines::ProhibitReturnSort
• Subroutines::ProhibitSubroutinePrototypes
• TestingAndDebugging::ProhibitNoStrict
• TestingAndDebugging::RequireUseStrict
• ValuesAndExpressions::ProhibitLeadingZeros
• Variables::ProhibitConditionalDeclarations
• Variables::RequireLexicalLoopIterators

My favorite above is probably ProhibitEvilModules. Aside from the colorful name, a development team can use it to steer people towards an organization’s favored solutions rather than “deprecated, buggy, unsupported, or insecure” ones. By default, it prohibits Class::ISA, Pod::Plainer, Shell, and Switch, but you should curate and configure a list within your team.

Speaking of working within a team, although perlcritic is meant to be a vital tool to ensure good practices, it’s no substitute for manual peer code review. Those reviews can lead to the creation or adoption of new automated policies to save time and settle arguments, but such work should be done collaboratively after achieving some kind of consensus. This is true whether you’re a team of employees working on proprietary software or a group of volunteers developing open source.

Of course, reasonable people can and do disagree over any of the included policies, but as a reasonable person, you should have good reasons to disagree before you either configure perlcritic appropriately or selectively and knowingly bend the rules where required. Other CPAN authors have even provided their own additions to perlcritic, so it’s worth searching CPAN under “Perl::Critic::Policy::” for more examples. In particular, these community-inspired policies group a number of recommendations from Perl developers on Internet Relay Chat (IRC).

Personally, although I adhere to my employer’s standardized configuration when testing and reviewing code, I like to run perlcritic on the “brutal” setting before committing my own. What do you prefer? Let me know in the comments below.

Cover image: “Everyone’s a critic — graifitti under Mancunian Way in Manchester” by Alex Pepperhill is licensed under CC BY-ND 2.0

I release SPVM 0.9014. Latest releases have some big changes.

add class, method, static keyword, omit SPVM:: namespace, and remove sub, self, keyword.

Before

# lib/SPVM/Point.spvm
package SPVM::Point {
  has x : int;
  has y : int;

  sub new : SPVM::Point () {

    return new SPVM::Point;

  }

  

  sub clear : void ($self : self) {

    $self->{x} = 0;

    $self->{y} = 0;

  }

}

After

# lib/SPVM/Point.spvm
class Point {
  has x : int;
  has y : int;

  static method new : Point () {

    return new Point;

  }

  

  method clear : void () {

    $self->{x} = 0;

    $self->{y} = 0;

  }

}

I imagine Moo, hash references, Mojo::Base, Object::Pad, Cor, etc. when choosing SPVM syntax.

See SPVM more Examples

Perl::Critic::TooMuchCode is a set of policy addons that generally checks for dead code or redundant code.

I feel grateful that this small project starts to draw some attention and endorsement and now it is receiving pull-requests from the Perl/CPAN community.

In version 0.17 we improved the policy ProhibitDuplicateLiteral and now it we can whitelist strings and numbers in configurations. If you somehow really need to use number 42 and "forty two" literally in the code many times, you list them in .perlcriticrc:

[TooMuchCode::ProhibitDuplicateLiteral]
whitelist = "forty two" 42

Thanks to @ferki from project Rex!

Rex is an automation framework, or remote-execution framework. In a sense, similar to Ansible. It's a simple way of telling machine what to do, with some code named Rexfile -- a task manifest. which is also perl code. Within which you'd repeat some strings literally such as:

service 'apache2',  ensure => 'started';
service 'mysql',    ensure => 'started';
service 'memcached, ensure => 'started';

... and that is OK. Because those manifests should be direct instead of indirect/abstract with the use of variables / constants to just hold the string 'started'. Doing such is an unnecessary level of indirection since the purpose of task manifests is to tell machine what to do and if human readers needs to read twice before they can understand what it really means, the is a problem.

Well, apparently in the context of coding Rexfile, some repetition are allowed. In general, perhaps repetition are OK in any DSL code. DSL itself already reduce some repetition by hiding the details and DSL keywords tends to be high-level constructs that are designed to be easily understandable for human readers. Repetition of DSL keywords almost never leads to be unreadable or "bad small".

I might have repeated the word "repetition" too many times.

Originally posted at: gugod's blog -- CPAN Release of TooMuchCode 0.17

Challenge, My solutions

TASK #1 › Consecutive Arrays

Task

Submitted by: Mark Anderson

You are given a sorted list of unique positive integers.

Write a script to return list of arrays where the arrays are consecutive integers.

My solution

This is pretty straight forward, so doesn't need much explanation. Even though the task says the list is ordered and unique, I do this anyway. You never know what input someone will provide!

I seed the @output array with the first number. Then then work through each number removing it from the array. If that number is one more than the last number in the last array of @output, I add the value to the existing row. If it is not, this means it is a new sequence, so add a new row to the array.

I then use map to display the result in the requested format.

Examples

 ./ch-1.pl 1 2 3 6 7 8 9
([1, 2, 3], [6, 7, 8, 9])

$ ./ch-1.pl 11 12 14 17 18 19
([11, 12], [14], [17, 18, 19])

$ ./ch-1.pl 2 4 6 8
([2], [4], [6], [8])

$ ./ch-1.pl 1 2 3 4 5
([1, 2, 3, 4, 5])

TASK #2 › Find Pairs

Task

Submitted by: Yary

You are given a string of delimiter pairs and a string to search.

Write a script to return two strings, the first with any characters matching the “opening character” set, the second with any matching the “closing character” set.

My solution

There would be a couple of way to tackle this, and my choice is based largely on the output in the examples. For this I take the first string (the delimiter parts) and work on it two characters at a time adding them to the $open and $close string. If the character is not an alphanumeric character, I escape it with a back quote. perlre states "Unlike some other regular expression languages, there are no backslashed symbols that aren't alphanumeric. So anything that looks like \\, \(, \), \[, \], \{, or \} is always interpreted as a literal character, not a metacharacter"

I then use this regexp string (wrapped in [^ and ]) to remove the characters that don't match the pattern and display the results.

Examples

$ ./ch-2.pl '""[]()' '"I like (parens) and the Apple ][+" they said.'
"(["
")]"

$ ./ch-2.pl '**//<>' '/* This is a comment (in some languages) */ <could be a tag>'
/**/<
/**/>

Hi there

If you remember, I mentioned the Outreachy program in the editorial of the weekly newsletter edition #522. It has finally come to an end as Rosheen Naeem successfully completed the internship as reported by the TPF in a blog post. Congratulations Rosheen.

The Perl Foundation is looking for mentors and project ideas for the next Outreachy rounds. If you have Perl or Raku project ideas, please get in touch with TPF.

Many years ago, I was approached for help by the Open Food Facts team as they found out about my distribution, Food::ECodes. Unfortunately it didn't work out as I was too busy with my other pet projects. I hope one day I can contribute to Open Food Facts. I remember I had trouble setting up a local development environment for my contributions. I haven't had a chance to see if there has been any improvements in this area to help newcomers to contribute.

I request Perl fans to come forward and help the cool fun project Open Food Facts.

Enjoy the rest of the newsletter and stay safe.

The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.

Part 1

You are given an array of positive integers, such that all the numbers appear even number of times except one number. Write a script to find that integer.

Solution

use strict;
use warnings;
sub find_odd_occurring{
    my %counts;
    for my $x (@_){
        $counts{$x}++;
    }
    for my $x (keys %counts){
        return $x if $counts{$x} % 2 != 0;
    }
}

MAIN:{
    print find_odd_occurring(2, 5, 4, 4, 5, 5, 2) . "\n";
    print find_odd_occurring(1, 2, 3, 4, 3, 2, 1, 4, 4) . "\n";
}

Sample Run

$ perl perl/ch-1.pl
5
4

Notes

I spent some time thinking if this could be done without two passes over the numbers. I do not think that is possible, since we have no limits on the off or even occurrences. For example, we could short circuit the checking if we knew that there might on be, say, three occurrences of the odd number. But here we have no such limitations and so we must tally all numbers in the list and then check to see which has an odd number of occurrences.

Part 2

You are given a tree. Write a script to find out if the given tree is Binary Search Tree (BST).

Solution

use strict;
use warnings;
package Tree130{
    use boolean;      
    use Class::Struct; 

    use constant LEFT => 0;
    use constant RIGHT => 1;

    package Node{
        use boolean;  
        use Class::Struct; 
        struct(
            value => q/$/,
            left => q/Node/,
            right => q/Node/
        );  
        true; 
    }  

    struct(
        root => q/Node/,
        nodes => q/@/
    );   

    sub print_tree{ 
        my($self) = @_;   
        my $left_child = $self->root()->left();
        my $right_child = $self->root()->right();
        print $self->root()->value() . " -> " . $left_child->value() . "\n" if $left_child;
        print $self->root()->value() . " -> " . $right_child->value() . "\n" if $right_child;
        print_tree_r($left_child);
        print_tree_r($right_child);
    }  

    sub print_tree_r{ 
        my($node) = @_;   
        my $left_child = $node->left();
        my $right_child = $node->right();
        print $node->value() . " -> " . $left_child->value() . "\n" if $left_child;
        print $node->value() . " -> " . $right_child->value() . "\n" if $right_child;
        print_tree_r($left_child) if $left_child;
        print_tree_r($right_child) if $right_child;
    } 

    sub min_tree_value{
        my($node) = @_; 
        my $left_child = $node->left();
        my $right_child = $node->right();
        return $node->value() if !$left_child && !$right_child;
        return [sort {$a <=> $b} ($node->value(), min_tree_value($left_child), min_tree_value($right_child))]->[0];
    }

    sub max_tree_value{
        my($node) = @_;   
        my $left_child = $node->left();
        my $right_child = $node->right();
        return $node->value() if !$left_child && !$right_child;
        return [sort {$a <=> $b} ($node->value(), max_tree_value($left_child), max_tree_value($right_child))]->[2];
    }

    sub is_bst{
        my($self, $node) = @_;
        return true if !$node;
        my $left_child = $node->left();
        my $right_child = $node->right();
        return false if $left_child && $node->value < max_tree_value($left_child);    
        return false if $right_child && $node->value > min_tree_value($right_child);   
        return false if !$self->is_bst($left_child) || !$self->is_bst($right_child);
        return true;    
    }

    sub insert{
        my($self, $source, $target, $left_right) = @_;   
        if(!$self->root()){      
            $self->root(new Node(value => $source));   
            push @{$self->nodes()},  $self->root();      
        }   
        my $source_node = [grep {$_->value() == $source} @{$self->nodes()}]->[0];
        my $target_node = new Node(value => $target);
        if($source_node){
            $source_node->left($target_node) if $left_right == LEFT;
            $source_node->right($target_node) if $left_right == RIGHT;
            push @{$self->nodes()}, $target_node;
        }
    }  
    true; 
}

package main{
    use constant LEFT => 0;
    use constant RIGHT => 1;

    my $tree = new Tree130(); 
    $tree->insert(8, 5, LEFT); 
    $tree->insert(8, 9, RIGHT); 
    $tree->insert(5, 4, LEFT); 
    $tree->insert(5, 6, RIGHT); 
    print $tree->is_bst($tree->root()) . "\n";
    $tree = new Tree130(); 
    $tree->insert(5, 4, LEFT); 
    $tree->insert(5, 7, RIGHT); 
    $tree->insert(4, 3, LEFT); 
    $tree->insert(4, 6, RIGHT); 
    print $tree->is_bst($tree->root()) . "\n";
} 

Sample Run

$ perl perl/ch-2.pl
1
0

Notes

All my code, for the time being at least, has converged on a pretty standard approach using Class::Struct. I have done this enough recently where I've convinced myself this is the best for several reasons

• This allows for object oriented construction of the data structure with almost the minimum overhead
• While providing for some OO structure, other than generating default accessor methods there is not too much done behind the scenes. Organizing the code this way does not feel like "cheating" in that there is any reliance on the OO framework, since it is so minimal.
• Many classic texts on data structures use C and that languages struct ability. Some superficial resemblance to that code is helpful in translating examples from the literature to Perl.

The first issue to deal with this part of the challenge is to construct a Binary Tree, but not do any sort of balancing when performing insertions into the tree. To do this I made a simple insert function which takes a source and target node and a third parameter which dictates whether the target is to be the left or right child of the source. In this way we can easily construct a broken binary tree.

Actually verifying whether the tree is a proper BST follows fairly directly from the definition of a Binary Tree. For each node, including the root, we check to see if the largest value to the left is smaller as well as the minimum value to the right being larger.

References

Challenge 130

Class::Struct

Binary Trees

1. Catmandu - a data toolkit
   • Version: 1.2016 on 2021-09-17
   • Votes: 21
   • Previous version: 1.2015 was 7 months, 26 days before
2. Graph - graph data structures and algorithms
   • Version: 0.9724 on 2021-09-13
   • Votes: 26
   • Previous version: 0.9723 was 12 days before
3. JSON::Validator - Validate data against a JSON schema
   • Version: 4.24 on 2021-09-16
   • Votes: 28
   • Previous version: 4.23 was 19 days before
4. Mojolicious::Plugin::OpenAPI - OpenAPI / Swagger plugin for Mojolicious
   • Version: 4.06 on 2021-09-14
   • Votes: 40
   • Previous version: 4.05 was 2 months, 4 days before
5. PDF::API2 - Create, modify, and examine PDF files
   • Version: 2.042 on 2021-09-16
   • Votes: 27
   • Previous version: 2.041 was 1 month, 19 days before
6. Proc::ProcessTable - Perl extension to access the unix process table
   • Version: 0.62 on 2021-09-13
   • Votes: 21
   • Previous version: 0.612 was 5 days before
7. RapidApp - Turnkey ajaxy webapps
   • Version: 1.3404 on 2021-09-17
   • Votes: 29
   • Previous version: 1.3402 was 17 days before
8. Sub::Util - Common Scalar and List utility subroutines
   • Version: 1.59 on 2021-09-12
   • Votes: 156
   • Previous version: 1.56 was 5 months, 13 days before
9. SPVM - Static Perl Virtual Machine. Fast Calculation, Fast Array Operation, and Easy C/C++ Binding.
   • Version: 0.9013 on 2021-09-18
   • Votes: 21
   • Previous version: 0.9012 was 8 days before
10. String::Random - Perl module to generate random strings based on a pattern
    • Version: 0.32 on 2021-09-14
    • Votes: 21
    • Previous version: 0.31 was 10 months, 28 days before
11. Test::Simple - Basic utilities for writing tests.
    • Version: 1.302187 on 2021-09-17
    • Votes: 171
    • Previous version: 1.302186 was 1 month, 22 days before

These are the ten most rated questions at Stack Overflow last week.
Between brackets: [question score / answers count]
Build date: 2021-09-18 20:51:39 GMT

1. Perl optimization: inlining a function changed the results - [4/1]
2. Why my micro-API does not have response body? - [3/2]
3. How to search and replace a word on multiple occurrence - [2/2]
4. perl - Hash::Merge duplicates same list within hashes instead of putting them once - [2/1]
5. Perl - how to create dynamic multi level hash using array of elements as keys - [2/1]
6. Error while using SSH command in shell script - [2/1]
7. running gam command inside perl script - [1/2]
8. in Perl, how to assign the print function to a variable? - [1/2]
9. In Perl, how to create a "mixed-encoding" string (or a raw sequence of bytes) in a scalar? - [1/2]
10. perl to modify clipboard before pasting - [1/1]

Dr. Ann Barcomb, an assistant professor at the University of Calgary, is conducting a study on practices for managing episodic, or occasional, contributors to the Perl/Raku project, in collaboration with The Perl Foundation. Following on from the survey she launched earlier in the year, she would like to interview community managers/leaders or those who have an overview of the participation of numerous contributors.

The interview will look at your experiences working with episodic contributors, and episodic contributions, in the Perl/Raku community. Additionally, she will ask if there is any difference between the current state and what you would like to see, in terms of episodic participation.

If you agree to be interviewed, quotations from the interview may be included in reports/papers, although not attributed directly to you. You have the option of having your name included in a list of participants, if you would like to receive recognition for your effort.

The results of the interviews will be delivered as part of a report to TPF, along with recommendations on practices (derived from previous research) which might be applied to improve the management of episodic participation. Subsequent research will involve working with interested community managers who participated in interviews, in order to implement the practices described in the proposal.

Please let me know if you are willing to be interviewed, and if you have any interest in the subsequent research. I really hope that this research will be relevant, and provide benefit to the Perl/Raku community, in addition to furthering understanding of practices for managing episodic participation in free/libre/open source software communities.

The University of Calgary Conjoint Faculties Research Ethics Board has approved this study (REB20-2135).

Read the full invitation to take part. InterviewRecruitment.pdf

If you are interested in taking part please use this link to schedule an interview at a convenient time. https://calendly.com/aadharsh-hariharan/tpf-research-interview

Interview consent is here: InterviewConsent.pdf

These are some answers to the Week 130 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 September 19, 2021 at 24:00). 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: Odd Number

You are given an array of positive integers, such that all the numbers appear even number of times except one number.

Write a script to find that integer.

Example 1:

Input: @N = (2, 5, 4, 4, 5, 5, 2)
Output: 5 as it appears 3 times in the array where as all other numbers 2 and 4 appears exactly twice.

Example 2:

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

Even though I have duly noted that the task specification states that only one number appears an odd number of time, I’ll expand slightly the task to find all the integers appearing an odd number of times, in the event that there is more than one.

Odd Number in Raku

In Raku, a Bag is a built-in immutable collection of distinct elements in no particular order that each have an integer weight assigned to them signifying how many copies of that element are considered “in the bag”. This is the perfect data structure to implement an histogram from a list of input values: just converting the input list into a bag, i.e. a list of unique key-values with the value being the frequency of the key. We then just need to filter out keys whose values are even to obtain the desired result.

my $bag = (2, 5, 4, 4, 5, 5, 2).Bag;
say grep { $bag{$_} % 2 }, $bag.keys;

This script displays the following output:

raku ./odd_number.raku
(5)

Adding a 2 to the input list will make the 2-count odd:

$ raku ./odd_number.raku
(5 2)

Odd Number in Perl

Perl doesn’t have a built-in Bag type, but it is almost as easy to implement an histogram using a hash. The algorithm is otherwise essentially the same:

#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;

my %histo;
$histo{$_}++ for (2, 5, 4, 4, 5, 5, 2);
say join " ", grep { $histo{$_} % 2 } keys %histo;

This script displays the following output:

$ perl odd_number.pl
5

Adding a 2 to the input list will make the 2-count odd:

$ perl odd_number.pl
2 5

Task 2: Binary Search Tree

You are given a tree.

Write a script to find out if the given tree is Binary Search Tree (BST).

According to Wikipedia, the definition of BST:

A binary search tree is a rooted binary tree, whose internal nodes each store a key (and optionally, an associated value), and each has two distinguished sub-trees, commonly denoted left and right. The tree additionally satisfies the binary search property: the key in each node is greater than or equal to any key stored in the left sub-tree, and less than or equal to any key stored in the right sub-tree. The leaves (final nodes) of the tree contain no key and have no structure to distinguish them from one another.

Example 1:

Input:
        8
       / \
      5   9
     / \
    4   6

Output: 1 as the given tree is a BST.

Example 2:

Input:
        5
       / \
      4   7
     / \
    3   6

Output: 0 as the given tree is a not BST.

We’ll implement the binary tree as a nested hash of hashes, in which the keys are val (the current node value), lc (left child node), and rc (right child node).

Binary Search Tree in Raku

we implement a recursive dft (depth-first traversal) subroutine to explore the tree. We return 0 when any value is larger than any previous value, except that a right child is larger than its immediate parent node.

use v6;

sub dft (%t, $min) {
    my $value = %t<val>;
    my $new-min = $value < $min ?? $value !! $min ;
    # say "$max $min $value $new-max $new-min";    
    if %t<lc>:exists {
        # say "%t<lc><val> $min";
        return 0 if %t<lc><val> > $value;
        return 0 if %t<lc><val> > $min;
        return 0 unless dft %t<lc>, $new-min;
    }
    if %t<rc>:exists {
        # say "%t<rc><val> $min";
        return 0 if %t<rc><val> < $value;
        return 0 if %t<rc><val> > $min;
        return 0 unless dft %t<rc>, $new-min;
    }
    return 1;
}
my %tree1 = (
    val => 8, 
    lc => { val => 5, 
            lc => {val => 4}, 
            rc => {val => 6}
          },
    rc => {val => 9}
);
#       8
#      / \
#     5   9
#    / \
#   4   6
say (dft %tree1, Inf), "\n";

my %tree2 = (val => 5, 
    lc => { val => 4, 
            lc => {val => 3}, 
            rc => {val => 6}
           },
    rc => {val => 7});
#       5
#      / \
#     4   7
#    / \
#   3   6
say dft %tree2, Inf;

This displays the following output:

$ raku ./bst.raku
1

0

Binary Search Tree in Perl

We also use a recursive dft (depth-first traversal) subroutine, with the same rules as above.

#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;
use Data::Dumper;

sub dft {
    my ($t, $min) = @_;
    my $value = $t->{val};
    my $new_min = $value < $min ? $value : $min ;
    # say " $min $value $new_min";    
    if (exists $t->{lc}) {
        # say "%t<lc><val> $min";
        return 0 if $t->{lc}{val} > $value;
        return 0 if $t->{lc}{val} > $min;
        return 0 unless dft($t->{lc}, $new_min);
    }
    if (exists $t->{rc}) {
        # say "%t<rc><val> $max $min";
        return 0 if $t->{rc}{val} < $value;
        return 0 if $t->{rc}{val} > $min;
        return 0 unless dft($t->{rc}, $new_min);
    }
    return 1;
}
my %tree1 = (
    val => 8, 
    lc => { val => 5, 
            lc => {val => 4}, 
            rc => {val => 6}
          },
    rc => {val => 9}
);
#       8
#      / \
#     5   9
#    / \
#   4   6
say "tree1: ", dft(\%tree1, 1e9), "\n";

my %tree2 = (val => 5, 
    lc => { val => 4, 
            lc => {val => 3}, 
            rc => {val => 6}
           },
    rc => {val => 7});
#       5
#      / \
#     4   7
#    / \
#   3   6
say "tree2: ", dft \%tree2, 1e9;

This displays the following output:

$ perl  bst.pl
tree1: 1

tree2: 0

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 September 26, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.

Finally enjoying again ...

Ever since I joined Oleeo, I keep talking about it in every monthly report.

Why?

Well, right from day one, I have been getting to work on something I never worked on before. To be honest with you, I was expecting to fight with good old CGI ridden code mostly. I find myself lucky to have such a great supporting team. Right now I am playing with Elastic Search and I am enjoying it. Thanks to CPAN for such a cool library, Search::Elasticsearch.

Did you notice last monthly report was published on 22nd Aug?

I have never been so late ever since I started the series of monthly report.

You must be thinking, why bother with monthly report? Who cares what I do?

I agree, nobody cares. But I still do it every month since Nov 2018, my first monthly report was published on 2nd Nov 2018. In two months time, I would complete 3 years of monthly reporting. Honestly speaking, I didn't realise it until now.

Going back to the original question, why?

Well, I do it to keep myself self-motivated and keep track of my pet projects. This time, at least I am not as late as last time. So there is a improvement, little bit though. I am getting the monthly report out on 16th as compared to 22nd last month. Hopefully in the near future, I would be back on track.

I am so much involved in learning new things these days, I hardly find time to do any YouTube videos. For the first time, I didn't do any Live Coding YouTube videos last month. In fact, I have even not participated in the weekly challenge in the month of August. I promise to get back on track soon.

I would like to talk about my involvement with Pull Request Club. During the peak of my game with Pull Request, I used to spend at least 2-4 hours every day looking for low hanging issues to fix. Ever since the weekly challenge started, I hardly find any time for the pull requests. Although I have never missed a monthly assignment for Pull Request Club, I am not happy with my contributions. Most of my contributions are limited to documentation and nothing ground breaking. I am grateful to everyone who have accepted my small contributions so far. It brings smile on my face every time.

In all of these drama, I am unable to give due attention to the book I am currently working on. At least, I have not dumped the idea. It is still very much alive. I should get back on track asap.

Let's take a quick look through last month main activities.

• Pull Request
• Git Commits
• The Weekly Challenge
• YouTube Channel
• Meet The Champion
• Pull Request Club
• Perl Blog
• Perl Weekly Newsletter
• Patreon

Pull Request

3 Pull Requests submitted in the month of August 2021.

2365 Pull Requests altogether.

Git Commits

686 commits recorded in the month of August 2021.

Overall 6156 commits recorded in the year 2021.

The Weekly Challenge

Following weekly challenges proposed in the month of August 2021:

• Challenge #124
• Challenge #125
• Challenge #126
• Challenge #127
• Challenge #128

And RECAPS are listed as below:

• RECAP Challenge #123
• RECAP Challenge #124
• RECAP Challenge #125
• RECAP Challenge #126
• RECAP Challenge #127

YouTube Channel

Last month, none created. However, there are plenty of videos available on my YouTube Channel. If you like the video then please do subscribe to my channel so that you don't miss the weekly fun live coding videos.

Meet The Champion

Last month, we declared Flavio Poletti as the Champion of The Weekly Challenge. Please checkout the interview with him.

If you are interested in past champions interview then you can find it all here.

Pull Request Club

Last month, I received ARGV::OrDATA by E. Choroba. I submitted one Pull Request and it has been kindly accepted and merged.

Overall participation to Pull Request Club

Perl Blog

Last month, I blogged about the Monthly Report - July.

Perl Weekly Newsletter

Last month, I edited two editions of the Perl Weekly Newsletter i.e. Issue #524 and Issue #526.

Patreon

At the end of last month, August 2021, the following people / organisation supported me in the past or continued supporting me even today. I am humbled by their generosity.

Do you want to sponsor my work?

Please follow the Patreon page.

Thank You.

Board update

There have been many changes at the Foundation over the last year including a number of changes to our Board.

Welcome

At our last formal meeting in August, we welcomed Daniel Sockwell (Codesections) to the Board of Directors.

Daniel has worked with the Foundation over the last year by serving on the Legal/Commercial Committee and by participating in the monthly community meetings. In his responses to questions during nomination, Daniel expressed a desire to bring Raku Steering Council representation to the Board and "to help [the Board] and the RSC/the Raku community more broadly better work together" so that Perl and Raku can support one another and avoid the "risk [of] getting in each other's way".

I am pleased to welcome Daniel on to the Board. Daniel brings additional capability and capacity to the team as well as a positive vision as to how Perl and Raku can co-exist, which I am confident is beneficial to all involved.

Farewell

During my time on the Board, I have had the pleasure of working with an experienced team, who warmly welcomed me to the Foundation and have all been generous with their time and support.

After many years of valued service across key roles, the following people have now retired from the Board:

• Jim Brandt (Former president)
• Dan Wright (Former treasurer)
• Allison Randal
• Curtis Poe
• Rik Signes
• Nat Torkington

Each has been invited to join the Advisory Board which is much less demanding whilst enabling us all to stay connected. More information on the developing Advisory Board is available here.

Details of the current Board of Directors is here.

I, and the Board members, would like to thank all past members for the commitment they made to the Board, we will miss their contributions and look forward to further conversation through the Advisory Board.

Board nominations

During the next few months, we will be seeking nominations for two additional Board members. If you know someone who might be willing to invest a few days per month, and can offer skills and experience that would be useful to the Foundation, then ask if they would consider being nominated to join the Board.

Ideally, they would already be known to the Board, are active in an open source community and they must demonstrate professional and positive characteristics.

The Board aims to represent the communities that it serves - we currently lack diversity, so please encourage nominations for those who do not feel represented at the Foundation.

Further details of what would make an ideal candidate and how to nominate will be posted in due course.

Stuart Mackintosh, President

The redundant and missing warnings were added in Perl 5.22 to cover the case where a call to the printf or sprintf had more (redundant) or fewer (missing) arguments than the format calls for. The documentation says that they may be extended to other built-ins (pack and unpack being named specifically) but as of Perl 5.34.0 only the printf() built-ins are covered.

I have (very occasionally) found myself writing a subroutine taking a printf-style format and some arguments, and letting the format specify which (if any) of the arguments actually appear in the output. If I just throw all the arguments after the format into the printf(), one of these warnings is very likely to be thrown, starting with 5.22, since use warnings; enables them by default.

Getting such code to work silently under versions of Perl both before and after the warnings were introduced puzzled me for a bit. Eventially I realized the solution was another pragma: if, which has been in core since Perl 5.6.2. To wit:

sub my_printf {
    no if "$]" >= 5.022, qw{ warnings redundant missing };
    return printf @_;
}

This is the second entry in a desultory series of blogs on the warnings pragma.

Jonathan reports a lot of progress on his grant. We would like to thank the sponsors and Jonathan for his work.

Here is his report:

Raku Dispatch and Compiler Improvements Grant Update

Since the approval of my grant in late June, I have been making a lot of progress with it. The grant allowed me to dedicate the vast majority of my working time in July and August to Raku (although I was away for 2 weeks of August on vacation). This report covers the work done between grant approval up to the end of August.

The key goal of the grant is to bring my work on a new generalized dispatch mechanism to the point where it can be merged and delivered to Raku users. In summary, the new dispatch mechanism:

• Delivers greatly improved performance for a number of constructs that are very slow in Rakudo/MoarVM today, including deferral with callsame and other such functions (thus also aiding code using wrap), multiple dispatch involving where clauses or named arguments, method calls on roles that are punned into classes, invocation of objects that implement CALL-ME, and others.
• Replaces many special-case performance mechanisms with a single, general, programmable one. This simplifies MoarVM internally, while simultaneously allowing it to do more optimization.

Far more details can be found in the presentation I gave about this work at The Raku Conference 2021 (slides, video).

At the point the grant got underway, the new dispatch mechanism was looking promising, but still some distance from being ready to ship. The work so far under this grant has decisively changed that, the expectation being that it will be merged shortly after the September monthly releases (of Rakudo and MoarVM) and thus be delivered to Raku users in the October releases.

Key tasks performed under the grant up to the end of August are as follows:

• Switch all method and subroutine dispatches in both NQP and Raku over to using the new dispatch mechanism, taking care of cross-language calls (for example, where the compiler calls bits of Raku code at BEGIN time)
• Switch over all implicit calls emitted during compilation to use the new dispatch mechanism also
• Switch the regex compiler over to emitting its calls using the new dispatch mechanism
• Replace the boolification mechanism and complex if/unless object ops, which previously involved an opaque chunk of C code, over to the new dispatch mechanism; this eliminated a bunch of code in the optimizer too
• Replace NQP's stringification and numification - which also involved a bunch of custom logic in MoarVM - with a dispatcher
• Bring the implementation of Raku multiple dispatch using the new dispatch mechanism to completion, including handling of required named arguments, typed exceptions on dispatch failure, Junction failover, Proxy args, dispatch based on argument unpacking, and nextcallee support in complex dispatch cases
• Add support for callwith to the method, wrap, and multiple dispatchers
• Various fixes to lastcall handling
• Switch NQP's multiple dispatch over to the new dispatcher
• Implement support for CALL-ME, which can be handled far more efficiently using the new dispatch mechanism (current Rakudo has an intermediate invocation that leads to slurping and re-flattening arguments, which in turn frustrates optimization; with the new dispatcher, the CALL-ME body can even be a candidate for inlining)
• Handle coercions using the new dispatch mechanism, again with some performance wins
• Replace the findmethod, tryfindmethod, and can ops with a dispatcher based solution; while the use of nqp::ops in modules is discouraged, these are among the more common ones, so retaining the API compatibility is good for the module ecosystem
• Implement a dispatcher-based solution for istype: if the answer cannot be given by the type cache, then a dispatcher is now used for the fallback. This opens the door to a range of future optimizations.
• Implement sink handling in Raku using a dispatcher, which in turn allows us to avoid a huge number of method calls in the common no-op situation, by instead using a type guard and mapping it directly to Nil
• Eliminate lots of superseded mechanisms in MoarVM: the multiple dispatch cache, smart coercion ops, the method cache, the legacy argument capture data structure, the invocation protocol mechanism, and the legacy calling conventions
• Replace a number of Rakudo extension ops with dispatcher-based solutions (these are C extensions to MoarVM, which we are seeking to fully eliminate; while this is not a goal for the new dispatcher work, we are now down to around 10 of them, putting it in reach in the near future; this is of some end user interest as it is currently a blocker for making a single executable that bundles MoarVM, Rakudo, and a program)
• Reinstate type statistics collection when using the new dispatcher, so the type specializer can start to do its optimization work again
• Start translating dispatch programs built at callsites into sequences of ops, including guards. This means that, in specialized code, we can very often avoid interpreting dispatch programs, and instead have JITted guard sequences (with the guards potentially being eliminated), and also exposes dispatches resulting in bytecode invocation for further optimization
• Reinstate specialization linking for bytecode invocations (this is where one piece of specialized code can directly call a specialized form of the caller without additional type checks); this is restricted so far to calls that don't have potential resumptions, so doesn't yet work for method or multi calls, for example
• Resinstate inlining, with the same restrictions as for specialization linking
• Reinstate OSR (On Stack Replacement, used to switch hot loops into their optimized form when it is available)
• Design and implement a solution for better handling of megamorphic method callsites, and make use of it in the NQP method dispatcher

A few other improvements were made not directly related to the new dispatch mechanism, but because the opportunity for improvement was spotted during performance analysis:

• Rework how action methods are invoked, such that most such invocations are monomorphic rather than all going through a megamorphic site; this should allow simple action methods to even be inlined in the future
• Make specializer statistics cleanup much cheaper, meaning the specializer thread can spend more time doing useful work

The total time worked up to the end of August on the grant is 144 hours 42 minutes, meaning that 55 hours and 18 minutes remain.

Hi there!

A long long time ago, when I was in high school, I participated in the annual competition of KöMaL, the Mathematical and Physical Journal for High Schools. (Look for the little UK flag for the English version). Back then we sent in the solution by snail-mail and we only had to write our name to be identified. However people with very common names were asked to include a 3-digit number between their names. There was no verification that two people with the exact same name did not pick the same number, but the chances were slim. Because my name is way too common in Hungary I picked the number 529 because it is 23^2. Funnily, if you squint it also resembles the initials of my name: SzG

Anyway, if you or your kids like math, informatics, or physics, I'd recommend it!

Enjoy your week!

If you windows Perl user, It is good to know How to show UTF-8 at the Windows command prompt .

How to show UTF-8 at the Windows command prompt

One liner is yet buggy, however UTF-8 showing is good in Windows command prompt.

The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.

Part 1

You are given a tree and a node of the given tree. Write a script to find out the distance of the given node from the root.

Solution

use strict;
use warnings;
package Tree129{
    use boolean;  
    use Tie::RefHash;
    use Class::Struct; 

    package Node{
        use boolean;  
        use Class::Struct; 
        struct(
            value => q/$/,
        );  
        true; 
    }  

    package Edge{
        use boolean;  
        use Class::Struct; 
        struct(
            weight => q/$/,
            source => q/Node/,
            target => q/Node/
        );  
        true; 
    }  

    struct(
        root => q/Node/,
        edges => q/%/
    );   

    sub print_tree{ 
        my($self) = @_;   
        for my $edge_source (keys %{$self->edges()}){
            for my $target (@{$self->edges()->{$edge_source}}){
                print $edge_source->value() . "->" . $target->value() . "\n";
            }
        }
    }  

    sub distance{
        my($self, $target) = @_;
        my $distance = 0;
        return $distance if($self->root()->value() == $target);
        my @nodes = @{$self->edges()->{$self->root()}};
        my @edge_sources = keys %{$self->edges()};
        do{
            $distance++;
            return $distance if((grep {$_->value() == $target} @nodes) > 0);
            my @child_nodes;
            for my $node (@nodes){
                my @k = grep {$_->value() == $node->value()} @edge_sources;
                push @child_nodes, @{$self->edges()->{$k[0]}} if $k[0] && $self->edges()->{$k[0]};
            }
            @nodes = @child_nodes;
        }while(@nodes);
        return -1;
    }

    sub insert{
        my($self, $source, $target) = @_;   
        if(!$self->root()){      
            $self->root(new Node(value => $source));  
            tie %{$self->edges()}, "Tie::RefHash";
            $self->edges($self->root() => [new Node(value => $target)]);          
        }   
        else{
            my $found = false;
            for my $edge_source (keys %{$self->edges()}){
                if($edge_source->value() == $source){
                    push @{$self->edges()->{$edge_source}}, new Node(value => $target);
                    $found = true;
                }
            }
            if(!$found){
                $self->edges()->{new Node(value => $source)} = [new Node(value => $target)];
            }
        }
    }  
    true; 
}

package main{
    my $tree = new Tree129(); 
    $tree->insert(1, 2); 
    $tree->insert(1, 3); 
    $tree->insert(3, 4); 
    $tree->insert(4, 5); 
    $tree->insert(4, 6); 
    print $tree->distance(6) . "\n";
    print $tree->distance(5) . "\n";
    print $tree->distance(2) . "\n";
    print $tree->distance(4) . "\n";
} 

Sample Run

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

Notes

In the past, for this sort of problem, I would separate out the Tree package into its own file . Here I decided to keep everything in one file, but still divide everything into the proper packages.

While creating a Tree package from scratch was fun, getting that data structure correct is just half the battle. Still need to solve the problem! To that end we need to start at the root of the tree and then descend and count how many levels down the node is found, if it exists. If not return -1.

One issue is that to store the edges I use a hash with Nodes as keys. To use a Node instance as a key we need to use Tie::RefHash. There is a slight trick here though, to properly retrieve the value we need to access the keys using keys. Here I store the keys in an array and grep for a match. A slightly awkward requirement, but the work around is easy enough.

Part 2

You are given two linked list having single digit positive numbers. Write a script to add the two linked list and create a new linked representing the sum of the two linked list numbers. The two linked lists may or may not have the same number of elements.

Solution

use strict;
use warnings;
package LinkedList129{
    use boolean;
    use Class::Struct;

    package Node{
        use boolean;
        use Class::Struct;
        struct(
            value => q/$/,
            previous => q/Node/,
            next => q/Node/
        );
        true;
    }

    struct(
        head => q/Node/,
        tail => q/Node/,
        length => q/$/
    );

    sub stringify{
        my($self) = @_;
        my $s = $self->head()->value();
        my $next = $self->head()->next();
        while($next && $next->next()){
            $s .= " -> " if $s; 
            $s = $s . $next->value();
            $next = $next->next();
        }
        $s = $s . " -> " . $next->value() if $next->value();
        $s .= "\n"; 
        return $s;
    }

    sub stringify_reverse{
        my($self) = @_;
        my $s = $self->tail()->value();
        my $previous = $self->tail()->previous();
        while($previous && $previous->previous()){
            $s .= " -> " if $s; 
            $s = $s . $previous->value();
            $previous = $previous->previous();
        }
        $s = $s . " -> " . $self->head()->value();
        $s .= "\n"; 
        return $s;
    }

    sub insert{
        my($self, $value) = @_;
        if(!$self->head()){
            $self->head(new Node(value => $value, previous => undef, next => undef));
            $self->tail($self->head());
            $self->length(1);
        }
        else{
            my $current = $self->head();
            my $inserted = false;
            do{
                if(!$current->next()){
                    $current->next(new Node(value => $value, previous => $current, next => undef));
                    $inserted = true; 
                }
                $current = $current->next();
            }while(!$inserted);
            $self->tail($current);
            $self->length($self->length() + 1);
        }
        return $value;
    }

    sub add{
        my($self, $list) = @_;
        my $shortest = [sort {$a <=> $b} ($self->length(), $list->length())]->[0];
        my($x, $y) = ($self->tail(), $list->tail());
        my $sum = new LinkedList129();
        my $carry = 0;
        do{
            my $z;
            if($x && $x->value() && $y && $y->value()){
                $z = $x->value() + $y->value() + $carry;
                ($x, $y) = ($x->previous(), $y->previous());
            }
            elsif($x && $x->value() && !$y){
                $z = $x->value() + $carry;
                ($x, $y) = ($x->previous(), undef);
            }
            elsif(!$x->value() && $y->value()){
                $z = $y->value() + $carry;
                ($x, $y) = (undef, $y->previous());
            }
            if(length($z) == 2){
                $carry = 1;
                $sum->insert(int(substr($z, 1, 1)));
            }
            else{
                $carry = 0;
                $sum->insert($z);
            }

        }while($x || $y);
        return $sum;
    }
    true;
}

package main{
    my $l0 = new LinkedList129();
    $l0->insert(1);
    $l0->insert(2);
    $l0->insert(3);
    $l0->insert(4);
    $l0->insert(5);
    my $l1 = new LinkedList129();
    $l1->insert(6);
    $l1->insert(5);
    $l1->insert(5);
    my $sum = $l0->add($l1);
    print "    " . $l0->stringify();
    print "+\n";
    print "              " . $l1->stringify();
    print "---" x ($l0->length() * 2) . "\n";  
    print "    " . $sum->stringify_reverse();
}

Sample Run

$ perl perl/ch-2.pl
    1 -> 2 -> 3 -> 4 -> 5
+
              6 -> 5 -> 5
------------------------------
    1 -> 3 -> 0 -> 0 -> 0

Notes

My opinion on LinkedList problems may not be shared by the majority of Team PWC. I love Linked List problems!

Similar to the first part of Challenge 129 Class::Struct is used to create the data structure central tot he problem. This LinkedList implementation just has an insert() and two stringify functions, along with the required add().

The problem asks to sum two linked lists of single digit numbers. The add() function works in the same way that one would manually add the numbers. The sum of the two lists is represented as a new Linked List, but to represent it properly it is output in reverse. That should be fine for the purposes of this challenge. Other options are:

• a function for inserting at the end of the list, insert at each addition step
• holding the sum in an array and when add() is finished with all list elements use the existing insert() and create a LinkedList instance to return by shifting off the array.

References

Challenge 129

Class::Struct

Tie::RefHash

1. App::Netdisco - An open source web-based network management tool.
   • Version: 2.049005 on 2021-09-09
   • Votes: 13
   • Previous version: 2.049004 was 6 days before
2. DBIx::Lite - Chained and minimal ORM
   • Version: 0.33 on 2021-09-07
   • Votes: 26
   • Previous version: 0.32 was 2 years, 8 months, 8 days before
3. Mojo::mysql - Mojolicious and Async MySQL/MariaDB
   • Version: 1.23 on 2021-09-11
   • Votes: 34
   • Previous version: 1.21 was 4 months, 13 days before
4. Mojo::Pg - Mojolicious ♥ PostgreSQL
   • Version: 4.26 on 2021-09-08
   • Votes: 68
   • Previous version: 4.25 was 6 months, 16 days before
5. Net::GitHub - Perl Interface for github.com
   • Version: 1.02 on 2021-09-08
   • Votes: 25
   • Previous version: 1.01 was 1 year, 4 months, 15 days before
6. Path::Iterator::Rule - Iterative, recursive file finder
   • Version: 1.015 on 2021-09-09
   • Votes: 23
   • Previous version: 1.014 was 3 years, 2 months, 12 days before
7. Prima - a perl graphic toolkit
   • Version: 1.63 on 2021-09-10
   • Votes: 33
   • Previous version: 1.62 was 2 months, 24 days before
8. Proc::ProcessTable - Perl extension to access the unix process table
   • Version: 0.612 on 2021-09-08
   • Votes: 21
   • Previous version: 0.611 was 21 days before
9. SPVM - Static Perl Virtual Machine. Fast Calculation, Fast Array Operation, and Easy C/C++ Binding.
   • Version: 0.9012 on 2021-09-10
   • Votes: 21
   • Previous version: 0.9011 was 10 days before
10. Test::MockModule - Override subroutines in a module for unit testing
    • Version: v0.177.0 on 2021-09-07
    • Votes: 14
    • Previous version: v0.176.0 was 8 months, 2 days before
11. Yancy - The Best Web Framework Deserves the Best CMS
    • Version: 1.077 on 2021-09-06
    • Votes: 40
    • Previous version: 1.076 was 26 days before

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

This week there isn't any remarkable distribution

Build date: 2021/09/11 14:07:22 GMT

Clicked for first time:

• JSON::Schema::Generate - Generate JSON Schemas from data!
• JSON::Schema::Modern - Validate data against a schema
• JSON::SchemaValidator - JSON Schema Validator
• JSONSchema::Validator - Validator for JSON Schema Draft4/Draft6/Draft7 and OpenAPI Specification 3.0
• Mail::POP3 - A POP3 stand-alone forking daemon or inetd server
• Syntax::Operator::Equ - equality operators that distinguish undef
• Test::Mojo::Role::Log - Testing Mojo Log messages
• URI::XS - fast URI framework, compatible with classic URI.pm, with C++ interface

Increasing its reputation:

• App::sdif (+1=2)
• Carp (+1=63)
• Class::Method::Modifiers (+1=29)
• Config::Tiny (+1=30)
• DBD::mysql (+1=49)
• Devel::StrictMode (+1=6)
• FFI::Platypus (+1=55)
• Gtk2 (+1=12)
• Gtk2::TrayIcon (+1=3)
• Gtk3 (+1=19)
• HTML::Packer (+1=7)
• HTTP::Tiny (+1=101)
• IO::All (+1=67)
• JSON::Schema (+1=9)
• JSON::Schema::AsType (+1=4)
• JSON::Schema::Tiny (+1=3)
• JSON::Validator (+1=28)
• libwww::perl (+1=153)
• Mojolicious::Plugin::AccessLog (+1=4)
• Mojolicious::Plugin::AssetPack (+1=49)
• Net::IMAP::Simple (+1=7)
• Net::WebSocket::Server (+1=2)
• Proc::ProcessTable (+1=21)
• Role::Tiny (+1=64)
• SQL::Bind (+1=7)
• Term::UI (+1=6)
• UV (+1=10)
• Web::Machine (+1=25)
• Web::Simple (+1=27)
• YAML (+1=65)

I am pleased to announce that the Outreachy internship concluded successfully again in 2021.

As previously announced, The Perl Foundation accepted Rosheen Naeem as an intern for 2021 to work on Open Food Facts. Stéphane Gigandet provided mentorship for her during the entire program. I would like to congratulate both for the successful program completion and express gratitude for their hard work.

Rosheen reported that she completed the following during the internship: * Worked on templatization of Perl scripts. * Added template files for Perl functions and modules. * Refactored the OpenFoodFacts Perl modules and functions. * Added Developer guide for the developers and newcomers. * Updated the docker development documentation and added the producer’s platform section. * Worked on UI of few files. * Worked on issues of OpenFoodFacts. * Added Perl Pod documentation. * Added new products and ingredients. * Fixed the directory structure.

Rosheen also wrote about her experience in her blog articles.

Stéphane says:

"We were very fortunate and happy to get Rosheen’s help this summer to improve the Perl code quality of Open Food Facts. Thanks to Rosheen, we made a lot of progress to better structure our code and document it, and to separate business from display logic thanks to templatization with Template::Toolkit. Those improvements are very useful to make our codebase friendlier for new contributors and much more pleasant to work with!"

*Open Food Facts *

Open Food Facts is a Wikipedia for food products, a free, nonprofit, collaborative and open project to gather photos and data for millions of food products from around the world.

Open Food Facts is written in Perl, and the project is looking for Perl developers to extend the impact of free and open food information: internationalizing and improving algorithms to “understand” ingredients list, analyzing the healthiness and environmental friendliness of food products and computing their Nutri-Score and Eco-Score, and much more!

Stéphane also gave a talk about Open Food Facts at the Perl and Raku Conference 2021 (video).

Outreachy

Outreachy, formerly The Outreach Program for Women, was started by the GNOME Foundation in 2006 to encourage women to participate in the GNOME project. Since inception the project has grown to include many Free and Open Source organisations, including The Perl Foundation, and now the program has been rebranded and extended to encourage the participation of other underrepresented groups.

Outreachy explicitly invites applicants from around the world who are women (cis and trans), trans men, and genderqueer people. Additionally, they explicitly invite residents and nationals of the United States of any gender who are Black/African American, Hispanic/Latino, American Indian, Alaska Native, Native Hawaiian, or Pacific Islander. Anyone who faces systemic bias or discrimination in the technology industry of their country is invited to apply.

Looking ahead

The Perl Foundation is looking for mentors and project ideas for the next Outreachy rounds. If you have Perl or Raku project ideas, please contact makoto@perlfoundation.org.

Hi there

How old is the Perl code that you work on currently?

Curtis wrote an interesting blog post talking about dealing with legacy code.

After a long time, I got the opportunity to work with good old CGI. It reminds me of my early learning days. Talking about CGI, I came across fun blog post talking about Migrating a Perl CGI application to AWS Lambda.

Please do share anything interesting you are trying using Perl. I am currently working on Elastic Search using Perl. As always CPAN provides great support e.g. Search::Elasticsearch.

What else changed in your routine?

For me, the school run is back. How about you?

Enjoy the rest of the newsletter. Hopefully next week we will have more perl blog posts.

The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.

Part 1

You are given m x n binary matrix having 0 or 1. Write a script to find out maximum sub-matrix having only 0.

Solution

use strict;
use warnings;
use Tree::Suffix; 

sub maximum_sub_matrix{
    my @matrix = @_;
    my @sub_matrix;

    my %indices;  
    my @indices_maximum;
    my $indices_previous = "";
    my $indices_current = "";
    my $tree = new Tree::Suffix(); 
    for my $i (0 .. @matrix - 1){
        $indices_current = "";
        for my $j (0 .. @{$matrix[0]} - 1){
            $indices_current .= $j if $matrix[$i][$j] == 0;  
            $indices_current .= "x" if $matrix[$i][$j] == 1;  
        }
        $tree->insert($indices_current);  
        for my $n (2 .. @{$matrix[0]}){
            for my $s ($tree->longest_common_substrings(1, $n)){
                if(!$indices{$s}){
                    $indices{$s} = [$i - 1, $i];  
                }
                else{ 
                    push @{$indices{$s}}, $i - 1, $i; 
                } 
            }
        }
        $tree->remove($indices_previous) if $indices_previous; 
        $indices_previous = $indices_current; 
    } 
    for my $s (keys %indices){
        my $max_area = -1; 
        my @indices = sort {$a <=> $b} do {my %seen; grep { !$seen{$_}++} @{$indices{$s}}};  
        unless($indices[0] < 0){
            my $area = 0;
            my $count = 0; 
            for(my $i = 0; $i <=  @indices - 1; $i++){ 
                $count++; 
                $area += length($s) if $i == 0;
                $area += length($s) if $i > 0 && $indices[$i] == $indices[$i - 1] + 1;   
                do{$area = 0; $count = 0} if $i > 0 && $indices[$i] != $indices[$i - 1] + 1;  
            }
            if($area >= $max_area){
                $max_area = $area; 
                push @indices_maximum, [$s, $count];      
            } 
        } 
    } 
    for (0 .. $indices_maximum[0][1] - 1){
        push @sub_matrix, [(0) x length($indices_maximum[0][0])];  
    }  
    return @sub_matrix; 
}

MAIN:{
    my @sub_matrix = maximum_sub_matrix(
        [1, 0, 0, 0, 1, 0],
        [1, 1, 0, 0, 0, 1],
        [1, 0, 0, 0, 0, 0]
    );
    for my $row (@sub_matrix){
        print "[" . join(" ", @{$row}) . "]\n"; 
    }  
} 

Sample Run

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

Notes

At first this seemed like a very similar Dynamic Programming style approach like the one used in Challenge 117 would be suitable. The idea being to start with the top row and the track in a hash all the different possible submatrices that arise as we work downwards in the matrix. While this is definitely a DP problem tracking the possible submatrices in this way is completely inefficient! Unlike the problem of Challenge 117 in which the possible paths descending the triangle are all completely known and predictable, here a lot of extra work needs to be done.

In order to determine overlap between the zeroes in successive rows of the matrix the rows are converted to strings and then the common substrings are computed using Tree::Suffix. Because we are looking for any possible overlap we need to repeat the common substring search for different lengths. The process to do this is a bit cumbersome, but it does work! So, at least the solution I had in mind ended up working but it's all so convoluted. Clearly more elegant solutions exist. One positive feature here though is that multiple maximum sized submatrices can be identified. In the example output you can see that two solutions exist, both with an "area" of six. Here which one gets shown is just based on the random ordering of the keys in %indices, but determining all solutions could be easily done. Since this was not part of the original challenge it was left undone.

Part 2

You are given a list of intervals. Write a script to determine conflicts between the intervals.

Solution

use strict;
use warnings;
use Date::Parse;
use Heap::MinMax;

sub number_platforms{
    my($arrivals, $departures) = @_;
    my $platforms = 0; 
    my $heap = new Heap::MinMax();
    $heap->insert(str2time(shift @{$departures}));  
    for my $i (0 .. @{$departures}){
        $platforms++ if str2time($arrivals->[$i]) < $heap->min();  
        $heap->pop_min() if str2time($arrivals->[$i]) >= $heap->min();  
        $heap->insert(str2time($departures->[$i]));  
    }    
    return $platforms; 
}

MAIN:{
    print number_platforms(
        ["11:20", "14:30"],
        ["11:50", "15:00"]
    ) . "\n"; 
    print number_platforms(
        ["10:20", "11:00", "11:10", "12:20", "16:20", "19:00"],
        ["10:30", "13:20", "12:40", "12:50", "20:20", "21:20"],
    ) . "\n"; 
}

Sample Run

$ perl perl/ch-2.pl
1
3

Notes

First, all times have to be converted to something numeric and so Date::Parse's str2time is used to convert the times to Unix epoch timestamps.

Heaps are not usually something I commonly use, even for these challenge problems they never seem to be convenient. Here though is a pretty standard use of a Heap! Here the use of a Heap allows for easy access to the next departure time. If a train arrives before the next departure, increase the number of platforms.

References

Challenge 128

Date::Parse

Heap::MinMax

Tree::Suffix

1. App::Netdisco - An open source web-based network management tool.
   • Version: 2.049004 on 2021-09-03
   • Votes: 13
   • Previous version: 2.049001 was 12 days before
2. Graph - graph data structures and algorithms
   • Version: 0.9723 on 2021-09-01
   • Votes: 26
   • Previous version: 0.9722 was 1 month, 28 days before
3. GraphQL - Perl implementation of GraphQL
   • Version: 0.52 on 2021-09-03
   • Votes: 18
   • Previous version: 0.51 was 1 month, 30 days before
4. IO - Perl core IO modules
   • Version: 1.48 on 2021-09-01
   • Votes: 53
   • Previous version: 1.45 was 7 months, 28 days before
5. JSON::Validator - Validate data against a JSON schema
   • Version: 4.23 on 2021-08-28
   • Votes: 28
   • Previous version: 4.22 was 1 day before
6. OpenAPI::Client - A client for talking to an Open API powered server
   • Version: 1.02 on 2021-08-28
   • Votes: 14
   • Previous version: 1.01 was 2 months, 11 days before
7. RapidApp - Turnkey ajaxy webapps
   • Version: 1.3402 on 2021-08-31
   • Votes: 29
   • Previous version: 1.3401 was 7 months, 23 days before
8. SPVM - Static Perl Virtual Machine. Fast Calculation, Fast Array Operation, and Easy C/C++ Binding.
   • Version: 0.9011 on 2021-08-31
   • Votes: 21
   • Previous version: 0.9010 was 6 days before
9. Storable - persistence for Perl data structures
   • Version: 3.25 on 2021-08-30
   • Votes: 46
   • Previous version: 3.15 was 2 years, 4 months, 7 days before
10. Sys::Virt - libvirt Perl API
    • Version: v7.7.0 on 2021-09-02
    • Votes: 15
    • Previous version: v7.5.0 was 2 months before
11. Text::Template - Expand template text with embedded Perl
    • Version: 1.60 on 2021-09-03
    • Votes: 22
    • Previous version: 1.59 was 1 year, 2 months before
12. WWW::Mechanize::Chrome - automate the Chrome browser
    • Version: 0.68 on 2021-08-29
    • Votes: 15
    • Previous version: 0.67 was 1 month, 20 days before

A new alias

Since 2012, Yet Another Society has also been officially known by a less confusing name: The Perl Foundation. Now it has another alias: The Raku Foundation. Like the TPF alias, this new name is a dba – it doesn't change any of the realities of how YAS (aka TPF, aka TRF) is organized, governed, or structured. Pretty much the only legal effect is to allow YAS to cash checks made out to "the Raku Foundation" in the same way it can cash ones made out to "The Perl Foundation".

In the short term, we're hopeful that this will make the sponsorship committee's job easier – the rich history connecting Perl and Raku is important to those of us in the communities, but we shouldn't need to explain that history to someone who just wants to fund Perl or Raku grants. In the slightly longer term, I'm hopeful that having the two aliases will make it easier for the Perl and Raku communities to define ourselves as the separate (though philosophically aligned) languages that we are. Perl and Raku share deep ties,but address different use cases, and having the "Raku Foundation" alias should help lay the groundwork for separating those use cases as we present ourself to a wider audience.

Raku trademark rights secured

The YAS legal committee hasn't just been involved in securing the dba; we've also been working to register "Raku" as a trademark. Well, I say "we", but the vast majority of the credit should go to Nige Hamilton, who shepherded the effort through to completion. I'm therefore happy to announce that we have now secured the Raku trademark in the United States, the United Kingdom, and the European Union.

Trademark rights are mostly something we hope never to need to use. They would help us deal with situations such as someone claiming to represent Raku despite flouting our Code of Conduct or someone trying to sell a counterfeit "Raku". I very much doubt anything like that will happen, but trademark rights are like backups – it's far better to have them and not need them than to need them and not have them.

Laying foundations

It's an exciting time for Raku – our first independent conference just concluded, the new dispatch system (and all the performance improvements that entails) just around the corner, and the Raku AST system and all the superpowers it will unlock (real macros!) not too much further behind. In the midst of these technical and community milestones, it would be easy to neglect some of the more administrative/legal tasks. But those tasks are vital, and neglecting them would be a mistake. So a sincere thanks to Nige and all of the TPF volunteers for all the work they do to support the Perl and Raku communities.

Stats

Number of new CPAN distributions this period: 65

Number of authors releasing new CPAN distributions this period: 32

Authors by number of new CPAN distributions this period:

Hi there,

The number of posts has been really low in the last couple of weeks. I really hope that with the new school-year in the northern hemisphere, we'll see an uptick in Perl-related content.

Other:

I just saw a Tweet explaining why the person does not wear a mask. He writes because he is vaccinated he isn't likely to be infected and he accepts the risks. Well, I really try to avoid arguing with strangers on the Internet so I did not write to him, but basically he said that he accepts the risk of endangering others.

In reality he spread two types of viruses. Potentially he spreads the Covid19 virus and for sure he spreads the idea that not caring for others is acceptable. For one, people who are unsure about the masks, seeing him without a mask will more likely stop wearing masks too.

Get vaccinated if you can and wear a mask when among people!

Enjoy your week!

The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.

Part 1

You are given two sets with unique numbers. Write a script to figure out if they are disjoint.

Solution

use strict;
use warnings;
use boolean;

sub disjoint{
    my($list1, $list2) = @_;
    my @a = map { my $n = $_; grep  $n == $_ , @{$list2} }  @{$list1};
    return boolean(@a == 0);#boolean() used for better stringification
}

MAIN:{
    my(@S1, @S2);
    @S1 = (1, 2, 5, 3, 4);
    @S2 = (4, 6, 7, 8, 9);
    print disjoint(\@S1, \@S2) . "\n";
    @S1 = (1, 3, 5, 7, 9);
    @S2 = (0, 2, 4, 6, 8);
    print disjoint(\@S1, \@S2) . "\n";
}

Sample Run

$ perl perl/ch-1.pl
0
1

Notes

I cannot think of a way of determining conflicts between these two lists which is all that more efficient than comparing them in this way. Sorting helps a little in some cases but if the overlapping element(s) are at the end of the sorted list you need to traverse the entire list anyway. Sorting would help the average case and since we need only find one overlapping element and then stop looking this would have some noticeable effect in the case of very large lists. But then I'd have to write a for-loop in order to break out of the loop early and instead I wanted to experiment with this grep inside a map construct! This worked without too much hassle, the only consideration really being to assign map's list value alias $_ to a variable so as to not conflict with grep's $_.

The use of boolean() is just to make sure that a 1 or 0 is printed as the final result.

Part 2

You are given a list of intervals. Write a script to determine conflicts between the intervals.

Solution

use strict;
use warnings;
sub conflicts{
    my @intervals = @_;
    my @conflicts;
    @intervals = sort { $a->[1] <=> $b->[1] } @intervals;
    {
        my $interval = pop @intervals;
        my($i, $j) = @{$interval};
        for $interval (@intervals){
            my($m, $n) = @{$interval};
            do { unshift @conflicts, [$i, $j]; last } if $i >= $m && $i <= $n;
        }
        redo if @intervals;
    }
    return @conflicts;
}

MAIN:{
    my(@Intervals);
    @Intervals = ([1, 4], [3, 5], [6, 8], [12, 13], [3, 20]);
    map { print "[" . join(", ", @{$_}) . "] " } conflicts(@Intervals);
    print "\n";
    @Intervals = ([3, 4], [5, 7], [6, 9], [10, 12], [13, 15]);
    map { print "[" . join(", ", @{$_}) . "] " } conflicts(@Intervals);
    print "\n";
}

Sample Run

$ perl perl/ch-2.pl
[3, 5] [3, 20]
[6, 9]

Notes

The examples given in the problem statement are with the [minimum, maximum] intervals sorted by the maximum value. This makes the problem a bit easier since then we need only check to see, when working down the sorted list, if the minimum is in one of the other intervals.

Since it isn't totally clear if this is something that should be assumed for all inputs I added a sort in conflicts() to ensure this is the case.

References

Challenge 127

C++ solution for Part 1

C++ solution for Part 2

Disjoint Sets