Perl Advent Calendar 2019

Enjoy Christmas

2019-12-25T00:00:00Z

It's been twenty years since I published the first Perl Advent Calendar.

I was at a Perl Monger meeting this summer when someone asked me if I had some advice after all this time. Maybe: Steal from the best but make it your own? That's after all what I do - I wait for people to do all the hard work of writing the code and all I do is write about what they've been doing. I have it easy. They deserve all the praise.

So in the interests of giving good advice and stealing from the best, I'm going to steal from Mary Schmich

Ladies and Gentlemen of Christmas 2019

Enjoy Christmas. If I could offer you only one tip for the future, Enjoying Christmas would be it. The long term benefits of friends and family have been proved by scientists whereas the rest of my advice has no basis more reliable than my own meandering experience. I will dispense this advice now

Enjoy the power and beauty of creating new things; or never mind. You will not understand the power and beauty of creating new things until they have become commonplace. But trust me, in 20 years you'll look back at code you have written recall in a way you can’t grasp now how much possibility lay before you and how fabulous it was. You are more able that you imagine

Don’t worry about the future; or worry, but know that worrying is as effective as trying to get your code to pass tests by running the same test twentieth time without changing it. The real troubles in your project are apt to be things that never crossed your worried mind; the kind that blindside you five minutes after you deploy

Deploy one thing user facing every day that scares you

Release often

Don’t be reckless with other people’s code bases; don’t put up with people who are reckless with yours

Write documentation

Don’t waste your time on platform jealousy; sometimes your language is ahead, sometimes it's behind. The race is long, and in the end, it’s only with your own development that matters

Remember the github stars you receive; forget the trolls. If you succeed in doing this, tell me how

Keep your old release notes. Throw away your old bug reports

Refactor

Don’t feel guilty if you don’t know what stack to use. The most interesting people I know didn’t know at 22 what they would end up coding in. Some of the most interesting 40-year-olds I know still don’t

Write tests

Be kind to your typing knuckles, you’ll miss them when when they're gone

Maybe you’ll IPO, maybe you won’t Maybe you’ll be acquired, maybe you won’t Maybe you’ll sunset your service at 40 Maybe you’ll open source, have to ask for help on gofundme, and enjoy every minute. Whatever you do, don’t congratulate yourself too much, or berate yourself either. What technology, protocol, or company that comes out on top is mostly chance; And it won't last.

Enjoy your editor. Use it every way you can. Don’t be afraid of it, or what other people think of it. It’s the greatest tool you’ll ever own.

Blog, even if you think you have nothing to talk about

Read the documentation, even if you ignore it

Do not read too much into the hot new thing; It will only make you feel outdated

Get to know your mentors; you never know when they’ll be gone for good

Be nice to your bug reporters; they are your best form of feedback and the People most likely to stick with your project long term

Understand that while users come and go, the precious few who are passionate you should hold on to

Work hard to bridge the gaps in geography and lifestyle, because the more you grow the more you need perspectives that are not like yours

Write pure machine code once, but stop before you become obsessive

Write Excel macros once, but stop before you forget the fundamentals

Explore new code

Accept certain inalienable truths: new technologies will age, companies will fail, you too will get old-- and when you do, you’ll fantasize that when you were young technologies were everlasting, companies were indestructible and newbies repeated their elders

Respect people in the community

Don’t expect anyone else to make your code work for you

Maybe you have a cushy job, maybe you have a support team; but you never know when either one might run out

Don’t mess too much with your stack at one time, or by the time you're ready to deploy, you'll need to start over

Be careful whose advice you buy, but be patient with those who supply it Advice is a form of nostalgia. Dispensing it is a way of fishing the past from the disposal, wiping it off, painting over the ugly parts and recycling it for more than it’s worth

But trust me on enjoying Christmas

We Wish You a Meme Christmas

2019-12-24T00:00:00Z

It's true. I've featured cat pictures and animated gifs. I've created Christmas playlists. I've shown you images of Christmas lights. I've even had an excuse to embedded entire Chistmas movies.

Now...it's finally time to create memes.

Imager

Imager is a handy dandy image drawing library in Perl that we're going to be using for our Meme creation needs.

Imager has about a gazillion methods to do pretty much every standard graphics manipulation you can imagine. But, shockingly, it doesn't have a way to draw standard meme text (Impact font, white text, black outline.) We can fix that by adding our own plugin:

package Imager::MemeString;

use 5.024;
use warnings;
use experimental 'signatures';

use Imager ();
use Imager::Font ();

# the Imager way is to directly declare functions in the main
# 'Imager' namespace.  Here we're using the full package-qualified
# syntax for naming a function to place 'meme_string' directly in
# the 'Imager' namespace rather than our own.
sub Imager::meme_string( $img, %args) {
    # meme text is upper case!
    my $string = uc delete $args{string};

    # Impact is the &quot;classic&quot; font for Memes. This should be the
&nbsp;&nbsp;&nbsp;&nbsp;# location for the ttf file on disk - this below is the standard
&nbsp;&nbsp;&nbsp;&nbsp;# location on macOS Catalina.
    my $font = Imager::Font-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;file =&gt; '/System/Library/Fonts/Supplemental/Impact.ttf',
&nbsp;&nbsp;&nbsp;&nbsp;);

    # by default text will be centered around the middle of the image
    my $x = delete $args{x} // $img-&gt;getwidth / 2;
&nbsp;&nbsp;&nbsp;&nbsp;my $y = delete $args{y};

    # these are the defaults - you can override this by just
&nbsp;&nbsp;&nbsp;&nbsp;# specifying different things in the arguments.
    my %defaults = (
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;font =&gt; $font,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;aa =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;halign =&gt; 'center',
&nbsp;&nbsp;&nbsp;&nbsp;);

    # We're cheating here.  If we were doing this properly we'd
&nbsp;&nbsp;&nbsp;&nbsp;# render the text to a different &quot;layer&quot; image and then use an
&nbsp;&nbsp;&nbsp;&nbsp;# algoritm to outline it black.  What we do instead is simplier:
&nbsp;&nbsp;&nbsp;&nbsp;# We just draw the same text over and over with horizontal and
&nbsp;&nbsp;&nbsp;&nbsp;# vertical offsets.
    for my $xoffset ( -3 .. 3 ) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;for my $yoffset ( -3 .. 3) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$img-&gt;align_string(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;x =&gt; $x + $xoffset,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;y =&gt; $y + $yoffset,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;%defaults,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;%args,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;color =&gt; 'black',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;string =&gt; $string,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;}

    # draw the same text one last time in white
    $img-&gt;align_string(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;x =&gt; $x,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;y =&gt; $y,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;%defaults,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;%args,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;color =&gt; 'white',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;string =&gt; $string,
&nbsp;&nbsp;&nbsp;&nbsp;);
}

1;

Now all we need is a wrapper script that loads our meme template, uses this new method to draw the meme text, and saves it out again:

#!/usr/bin/perl

use 5.024;
use warnings;

use Imager ();
use Imager::MemeString();

my $template = shift or die 'Forgot to pass template filename!';
my $output   = shift or die 'Forgot to pass output filename!';

my $img = Imager-&gt;new;

# Read in the template image. The Imager object will have the same
# dimensions as the file we just read in
$img-&gt;read( file =&gt; $template ) or die $img-&gt;errstr;

# draw the meme string.  Because we're only passing in &quot;y&quot; not &quot;x&quot;
# it'll automatically be centred horizontally
$img-&gt;meme_string( string =&gt; &quot;Hello, World&quot;, y =&gt; 50, size =&gt; 50 );

# and save the new image out
$img-&gt;write( file =&gt; $output, type =&gt; 'jpeg' )
&nbsp;&nbsp;&nbsp;&nbsp;or die &quot;Cannot write: &quot;,$img-&gt;errstr;

Okay, bring on the memes! (email me links to any you create!)

Testing our Impatience

2019-12-23T00:00:00Z

"I can make your tests take half the time", was the claim that Garland Snowboughs had made.

Twice as fast? Rustic Mullingfig had hardly started building out the implementation of his Christmas Tree class. It wasn't possible that he'd made the code go slow yet - there really wasn't much of it.

"Go on then mate, I'll bet you a mince pie that you can't manage it."

The bet was on.

The Tests in Question

There really wasn't much to the code yet. So far Rustic had only implemented the planted attribute (that defaulted to the time the object was created) and some stringification.

package XmasTree;
use Moose;
use experimental 'signatures';

use DateTime;
has 'planted' =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;is =&gt; 'ro',
&nbsp;&nbsp;&nbsp;&nbsp;default =&gt; sub { DateTime-&gt;now }
);

use overload '&quot;&quot;' =&gt; 'as_string';
sub as_string ($self) {
&nbsp;&nbsp;&nbsp;&nbsp;return &quot;A Xmas Tree, planted on @{[ $self-&gt;planted ]}&quot;;
}

1;

And he'd written two basic tests - one for the stringification:

#!/usr/bin/perl

use Test2::V0;
use XmasTree;

# look, a year 2020 bug!
like( XmasTree-&gt;new, qr/An Xmas Tree, planted on 2019/ );

done_testing;

And one for the planted attribute itself:

#!/usr/bin/perl

use Test2::V0;
use XmasTree;

is( XmasTree-&gt;new, object {
&nbsp;&nbsp;&nbsp;&nbsp;call planted =&gt; object {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;prop blessed =&gt; 'DateTime';

        # look, a year 2020 bug!
        call year =&gt; 2019;
&nbsp;&nbsp;&nbsp;&nbsp;};
});
done_testing;

These ran pretty darn quickly:

    shell$ yath -Ilib t

    ** Defaulting to the &#39;test&#39; command **

    ( PASSED )  job  1    t/planted.t
    ( PASSED )  job  2    t/stringification.t

    ================================================================================

    Run ID: A60F80C6-251F-11EA-ADBC-83BD753448D3

    All tests were successful!


    1.17659s on wallclock (0.19 usr 0.02 sys + 0.93 cusr 0.11 csys = 1.25 CPU)

How is Garland going to speed those tests up?

Faster

The first thing Garland changed was to add the -P option to yath.

yath is the Test2 test harness (yath stands for Yet Another Test Harness.) Each test it runs forks a new process, executes the test script, and gathers the STDERR and STDOUT of the child process in the parent test harness process to work out the results.

The -P option tells the harness to load the mentioned module before it forks. So by specifying -PDateTime we only have to load DateTime once in the parent process, not twice, once in each child process as it loads

    shell$ yath -PDateTime -PMoose  -Ilib t

    ** Defaulting to the &#39;test&#39; command **

    ( PASSED )  job  1    t/planted.t
    ( PASSED )  job  2    t/stringification.t

    ================================================================================

    Run ID: D10B83C4-251F-11EA-BDAA-9B6707E666E2

    All tests were successful!


    0.90175s on wallclock (0.19 usr 0.02 sys + 0.68 cusr 0.10 csys = 0.99 CPU)

Whoo! That only took 77% of the time it previously did...but Garland had promised more! Can we make it faster still?

Faster Still

The key realization is that not only that DateTime and other CPAN modules we use do not change between the different test scripts we execute, they don't change between different runs of the same test script. Or, to put it another way...we want to load them into memory once and then every time after (until we eventually upgrade our Perl modules) we won't have to run them again.

To do this yath has a daemon mode. You can start it up by using the start command:

    shell$ yath start -PDateTime -PMoose
    Waiting for runner...

    Persistent runner started!
    Runner PID: 3199
    Runner dir: /tmp/yath-test-3198-JClS5vpt
    Runner logs:
    standard output: /tmp/yath-test-3198-JClS5vpt/output.log
    standard  error: /tmp/yath-test-3198-JClS5vpt/error.log

    Use `yath watch` to monitor the persistent runner

    0.58685s on wallclock (0.19 usr 0.02 sys + 0.00 cusr 0.00 csys = 0.21 CPU)

Now whenever we run yath from this directory it'll contact this daemon and have it run the tests instead - and its already loaded the modules!

    shell$ yath t

    ** Persistent runner detected, defaulting to the &#39;run&#39; command **

    ( PASSED )  job 3485-1    t/planted.t
    ( PASSED )  job 3485-2    t/stringification.t

    ================================================================================

    Run ID: D682502A-2520-11EA-8563-D1A3990446BB

    All tests were successful!


    0.35264s on wallclock (0.18 usr 0.03 sys + 0.00 cusr 0.00 csys = 0.21 CPU)

Okay, that took less than 30% of the original time it took - over three times as fast!

Of course, this speed up will become more significant the more stable unchanging CPAN modules we pull in as our codebase becomes bigger.

We can even make this easier by having a preload module that we use whenever we get ready to start testing.

package reloadStandard;

use 5.024;
use warnings;

use Moose ();
use DateTime ();

1;

And then

    shell$ yath start -PreloadStandard
    ...

But more importantly, what this means is that Garland is owed some mince pies!

Comparing More

2019-12-22T00:00:00Z

Cinnamon Candybubbles has been really interested in the Wise Old Elf's lecture yesterday on Test2. She'd been particularly intregied by the comparison operators that allow you to build a complex datastructure of comparisons to pass into is.

Test2::Tools::Compare lists a whole bunch of these operators that are immediately available in Test2::V0. But what she wanted to extend the operators?

What Cinnamon wants to do is write a simple comparison function that she can use to check if a value is one of Santa's reindeer or not.

#!/usr/bin/perl
use Test2::V0;
use Test2::Tools::SantasReindeer;

my $ds = {
&nbsp;&nbsp;&nbsp;&nbsp;reindeer =&gt; [ 'Donner', 'Prancer', 'Robbie' ],
&nbsp;&nbsp;&nbsp;&nbsp;driver   =&gt; 'Santa',
};

# insist that all reindeer are Santa's reindeer
is($ds, hash {
&nbsp;&nbsp;&nbsp;&nbsp;field reindeer =&gt; array {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;all_items(santas_reindeer());
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;etc();
&nbsp;&nbsp;&nbsp;&nbsp;};
&nbsp;&nbsp;&nbsp;&nbsp;etc();
});

done_testing();

How can she do this?

Writing a Test2::Tools Class

Test2's standard extension mechanism is to provide tools in the Test2::Tools namespace that provide functions that interoperate with existing Test2 functionality. These classes don't need to subclass any particular class nor have any specific functions or method defined - they can access anything they need to about the Test2 context by using the context function from Test2::API.

In this case Cinnamon isn't even going to do that - she's not actually writing any code that performs a test per se. She's providing a function that the tests in Test2::Tools::Compare can use to compare data structures.

Writing a Test2::Tools class that exports comparison functions isn't that hard - it's just like any other Exporter based code.

package Test2::Tools::SantasReindeer;
use Exporter qw( import );
our @EXPORT = qw( santas_reindeer );

# we're going to re-use existing Test2 comparison classes
use Test2::Compare::Set;
use Test2::Compare::String;

# return the same as in_set(qw(Rudolph Dasher Dancer...))
sub santas_reindeer {
&nbsp;&nbsp;&nbsp;&nbsp;my $set = Test2::Compare::Set-&gt;new( checks =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;map { Test2::Compare::String-&gt;new( input =&gt; $_ ) } qw(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Rudolph Dasher Dancer Prancer Vixen Comet Cupid Donner Blitzen
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;)
&nbsp;&nbsp;&nbsp;&nbsp;]);
&nbsp;&nbsp;&nbsp;&nbsp;$set-&gt;set_reduction('any');
&nbsp;&nbsp;&nbsp;&nbsp;return $set;
};

1;

This works, and correctly identifies that Robbie is not one of Santa's reindeer:

    shell$  perl -Ilib /tmp/testing.t
    not ok 1
    # Failed test at /tmp/testing.t line 17.
    # +-------------------------+-----------------------+----+---------+--------+
    # | PATH                    | GOT                   | OP | CHECK   | LNs    |
    # +-------------------------+-----------------------+----+---------+--------+
    # |                         | HASH(0x7f9fab817670)  |    | &lt;HASH&gt;  | 14, 17 |
    # | {reindeer}              | ARRAY(0x7f9fab817658) |    | &lt;ARRAY&gt; | 15     |
    # | {reindeer}[2] &lt;Check 0&gt; | Robbie                | eq | Rudolph |        |
    # | {reindeer}[2] &lt;Check 1&gt; | Robbie                | eq | Dasher  |        |
    # | {reindeer}[2] &lt;Check 2&gt; | Robbie                | eq | Dancer  |        |
    # | {reindeer}[2] &lt;Check 3&gt; | Robbie                | eq | Prancer |        |
    # | {reindeer}[2] &lt;Check 4&gt; | Robbie                | eq | Vixen   |        |
    # | {reindeer}[2] &lt;Check 5&gt; | Robbie                | eq | Comet   |        |
    # | {reindeer}[2] &lt;Check 6&gt; | Robbie                | eq | Cupid,  |        |
    # | {reindeer}[2] &lt;Check 7&gt; | Robbie                | eq | Donner  |        |
    # | {reindeer}[2] &lt;Check 8&gt; | Robbie                | eq | Blitzen |        |
    # +-------------------------+-----------------------+----+---------+--------+

Though it's a little on the verbose side - the Cinnamon doesn;t really want to know all the names that don't match, they want to simply know that it doesn't match any of Santa's reindeer

Writing a Custom Comparison

The tools we previously wrote simply re-used existing comparisons. How about Cinnamon writes her own comparison operator, so she can have full control over the output?

This makes her Tools module considerable simplier at least..

package Test2::Tools::SantasReindeer;
use Exporter qw( import );
our @EXPORT = qw( santas_reindeer );

use Test2::Compare::SantasReindeer;

sub santas_reindeer {
&nbsp;&nbsp;&nbsp;&nbsp;return Test2::Compare::SantasReindeer-&gt;new;
};

1;

Test2::Compare::SantasReindeer should be a subclass of the Test2::Compare::Base class. A simple implementation would be:

package Test2::Compare::SantasReindeer;
use base qw(Test2::Compare::Base);

use strict;
use warnings;

use List::Util qw( any );

sub name { &quot;Santa's Reindeer&quot; }

sub verify {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my %params = @_;

    # if this value didn't exist at all, need to return false
    return 0 unless $params{exists};

    # return true if and only if what we got matches
    return any { $params{got} eq $_ } qw(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Rudolph Dasher Dancer Prancer Vixen Comet Cupid Donner Blitzen
&nbsp;&nbsp;&nbsp;&nbsp;);
}

1;

Cinnamon had to implement two methods: name (which returns the name of the test that will be shown in output) and verify (which returns true or false if it matches or not).

The output is much more readable now

    shell$ $  perl -Ilib /tmp/testing.t
    not ok 1
    # Failed test at /tmp/testing.t line 17.
    # +---------------+-----------------------+------------------+--------+
    # | PATH          | GOT                   | CHECK            | LNs    |
    # +---------------+-----------------------+------------------+--------+
    # |               | HASH(0x7f917f001870)  | &lt;HASH&gt;           | 14, 17 |
    # | {reindeer}    | ARRAY(0x7f917f001858) | &lt;ARRAY&gt;          | 15     |
    # | {reindeer}[2] | Robbie                | Santa&#39;s Reindeer |        |
    # +---------------+-----------------------+------------------+--------+

Embracing The Negative

Ever since the cuban missile crisis Grand-Santa hasn't been allowed to fly the sliegh any more. This is easy to express in a test with the ! operator:

#!/usr/bin/perl
use Test2::V0;

my $ds = {
&nbsp;&nbsp;&nbsp;&nbsp;driver =&gt; 'Grand-Santa',
};

# no Grand-Santa!
is($ds, hash {
&nbsp;&nbsp;&nbsp;&nbsp;field driver =&gt; !string(&quot;Grand-Santa&quot;);
&nbsp;&nbsp;&nbsp;&nbsp;etc();
});

This helpfully prints out useful info in the diagnostics making it clear that the test was negated too.

    # Seeded srand with seed &#39;20191220&#39; from local date.
    not ok 1
    # Failed test at - line 12.
    # +----------+----------------------+----+-------------+-------+
    # | PATH     | GOT                  | OP | CHECK       | LNs   |
    # +----------+----------------------+----+-------------+-------+
    # |          | HASH(0x7fa50d817040) |    | &lt;HASH&gt;      | 9, 12 |
    # | {driver} | Grand-Santa          | ne | Grand-Santa | 10    |
    # +----------+----------------------+----+-------------+-------+

What if Cinnamon does't want any of Santa's reindeer on our sleigh? It should be as simple as writing the following:

#!/usr/bin/perl
use Test2::V0;
use Test2::Tools::SantasReindeer;

my $ds = {
&nbsp;&nbsp;&nbsp;&nbsp;type     =&gt; 'training flight',
&nbsp;&nbsp;&nbsp;&nbsp;reindeer =&gt; [ 'Donner', 'Prancer', 'Robbie' ],
&nbsp;&nbsp;&nbsp;&nbsp;driver   =&gt; 'Arthur',
};

# insist that all reigndeer aren't Santa's
is($ds, hash {
&nbsp;&nbsp;&nbsp;&nbsp;field reindeer =&gt; array {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;all_items(!santas_reindeer());
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;etc();
&nbsp;&nbsp;&nbsp;&nbsp;};
&nbsp;&nbsp;&nbsp;&nbsp;etc();
});

done_testing();

Does that work?

    perl -Ilib /tmp/testing.t
    # Seeded srand with seed &#39;20191220&#39; from local date.
    not ok 1
    # Failed test at /tmp/testing.t line 18.
    # +---------------+-----------------------+----+---------+--------+
    # | PATH          | GOT                   | OP | CHECK   | LNs    |
    # +---------------+-----------------------+----+---------+--------+
    # |               | HASH(0x7f9501017670)  |    | &lt;HASH&gt;  | 15, 18 |
    # | {reindeer}    | ARRAY(0x7f9501017658) |    | &lt;ARRAY&gt; | 16     |
    # | {reindeer}[0] | Donner                | eq |         |        |
    # | {reindeer}[1] | Prancer               | eq |         |        |
    # | {reindeer}[2] | Robbie                | eq |         |        |
    # +---------------+-----------------------+----+---------+--------+

Ooops, Cinnamon now checking that the names are equal to false. What changes does she have to make?

The Test2::Compare::SantasReindeer needs to overload the ! operator, save that in the instance, and then the code can decide what comparison to run in verify later on.

Thankfully, Cinnamon doesn't have to code all of that - the overloading aspect can be handled just by loading Test2::Compare::Negatable which will set the +NEGATED attribute for us.

package Test2::Compare::SantasReindeer;
use base qw(Test2::Compare::Base);

use strict;
use warnings;

use List::Util qw( any none );

# Overloads '!' for us.
use Test2::Compare::Negatable;

my @REINDEER = qw(
&nbsp;&nbsp;&nbsp;&nbsp;Rudolph Dasher Dancer Prancer Vixen Comet Cupid Donner Blitzen
);

sub name { &quot;Santa's Reindeer&quot; }

sub verify {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my %params = @_;

    # Always check if $got exists! This method must return false if no
&nbsp;&nbsp;&nbsp;&nbsp;# value at all was received.
    return 0 unless $params{exists};

&nbsp;&nbsp;&nbsp;&nbsp;return none { $params{got} eq $_ } @REINDEER if $self-&gt;{+NEGATE};
&nbsp;&nbsp;&nbsp;&nbsp;return any  { $params{got} eq $_ } @REINDEER;
}

1;

Now Cinnamon's test works as it should:

    mark@Tarrant:~/tmp$  perl -Ilib /tmp/testing.t
    # Seeded srand with seed &#39;20191220&#39; from local date.
    not ok 1
    # Failed test at /tmp/testing.t line 18.
    # +---------------+-----------------------+------------------+--------+
    # | PATH          | GOT                   | CHECK            | LNs    |
    # +---------------+-----------------------+------------------+--------+
    # |               | HASH(0x7f857200ea70)  | &lt;HASH&gt;           | 15, 18 |
    # | {reindeer}    | ARRAY(0x7f857200ea58) | &lt;ARRAY&gt;          | 16     |
    # | {reindeer}[0] | Donner                | Santa&#39;s Reindeer |        |
    # | {reindeer}[1] | Prancer               | Santa&#39;s Reindeer |        |
    # +---------------+-----------------------+------------------+--------+

But the output is still a little confusing; Currently the diagnostics are saying that the problem is that Donner and Prancer aren't Santa's Reindeer when the point of the test was that they are, but we don't want them to be.

Cinnamon has one more method to override in the class to get the output she desires:

sub operator { shift-&gt;{+NEGATE} ? &quot;isn't one of&quot; : &quot;is one of&quot; }

Now the output looks like

    shell$ perl -Ilib /tmp/testing.t
    not ok 1
    # Failed test at /tmp/testing.t line 18.
    # +---------------+-----------------------+--------------+------------------+--------+
    # | PATH          | GOT                   | OP           | CHECK            | LNs    |
    # +---------------+-----------------------+--------------+------------------+--------+
    # |               | HASH(0x7ff5e2802870)  |              | &lt;HASH&gt;           | 15, 18 |
    # | {reindeer}    | ARRAY(0x7ff5e2802858) |              | &lt;ARRAY&gt;          | 16     |
    # | {reindeer}[0] | Donner                | isn&#39;t one of | Santa&#39;s Reindeer |        |
    # | {reindeer}[1] | Prancer               | isn&#39;t one of | Santa&#39;s Reindeer |        |
    # +---------------+-----------------------+--------------+------------------+--------+

    shell$ perl -Ilib /tmp/testing.t
    not ok 1
    # Failed test at /tmp/testing.t line 18.
    # +---------------+-----------------------+-----------+------------------+--------+
    # | PATH          | GOT                   | OP        | CHECK            | LNs    |
    # +---------------+-----------------------+-----------+------------------+--------+
    # |               | HASH(0x7f8687017670)  |           | &lt;HASH&gt;           | 15, 18 |
    # | {reindeer}    | ARRAY(0x7f8687017658) |           | &lt;ARRAY&gt;          | 16     |
    # | {reindeer}[2] | Robbie                | is one of | Santa&#39;s Reindeer |        |
    # +---------------+-----------------------+-----------+------------------+--------+

Comparatively Good

Cinnamon Candybubbles ended up with a comparison that was not only quick to type, but more importantly very easy to understand when looking at the diagnostic output.

Test2: Test Harder (but easier)

2019-12-21T00:00:00Z

"Right, my fellow Elves, calm down", the Wise Old Elf shouted over the rabble gathed in the elf lecture hall, "Today I'm going to be talking to you about Testing"

There were loud groans from the audience. They'd been writing tests for years. It was like teaching their Grandmother to suck Eggnog.

"Now now...how many of you are familiar with the latest changes in Test2?"

Less noise now. Maybe there was something here they could learn after all.

"There's so much to cover. I could tell you about the underlying event system that allows decoupling of parts of the test system. I could talk about the new structure of creating interoperable test frameworks. I could talk to about the new harness features...but today, today I'm going to talk to you about Test2::V0.

Test2::V0 is like a smorgasbord of all the good bits of Test2 wrapped up in one delectable package. When you might previously grab Test::More, you should grab Test2::V0. Because...because it not only uses all of the cool tech on its backend, but because it's so darn handy to use."

Making the Easy Stuff Easy: Strictness, Warnings and UTF8

"Lazyness! One of the greatest virtue of the Perl programmer! Why type a lot when you can type a little? Why not have sensible defaults."

There were plenty of nodding heads now. Writing tests is a Cost of Doing Business - so making it as simple as possible to do the right thing without thinking about it is critical.

The Wise Old Elf threw the most basic Perl script up on the screen.

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests =&gt; 1;

ok(1, 'Do we want to build a \N{SNOWMAN}?');

"Now here's the same code written in an idiomatic fashion with Test2::V0."

#!/usr/bin/perl

use Test2::V0;

ok(1, &quot;Do you want to build a \N{SNOWMAN}?&quot;);

done_testing;

"Who can spot the difference?"

Tiramisu Shinytree raised her hand. "There's no strict or warnings!"

"Correct! Test2::V0 (like Moose, Mojolicious, and many other common tools) turns those on for you automatically. Anything else?"

It was Bluebell Brandycake's turn. "There's no plan!"

"Well yes, Test2 allows you to use done_testing rather than having to count each and every test and declare a plan, but modern versions of Test::More allow that too. Anything else? Anyone spot the bug?"

Silence. Can you spot it? The Wise Old Elf decided to show the class the output of the scripts.

    shell $ perl /tmp/more.t
    1..1
    Wide character in print at /opt/perl/bin/lib/site_perl/5.28.1/Test2/Formatter/TAP.pm line 144.
    ok 1 - Do you want to build a X?

    shell $ perl /tmp/2v0.t
    ok 1 - Do you want to build a X?
    1..1

The crowd groaned. They'd forgotten Fowler's Rule on Unicode (there's always another unicode bug, you just haven't found it yet)

"Yep. Test2::V0 also reconfigures the output handles to encode as UTF-8 which I bet you always forget - until you see that warning message."

Deep Testing

"The next thing you'll notice is that Test2::V0 based tests are, well, naturally deeper than their Test::More counterparts. Where in Test::More if you wanted to test data structures you'd have to use is_deeply..."

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests =&gt; 1;

use Reindeer::Santa  qw(original_team);
my @results = original_team();

is_deeply(\@original_tam, [
&nbsp;&nbsp;&nbsp;&nbsp;'Dasher', 'Dancer', 'Prancer', 'Vixen',
&nbsp;&nbsp;&nbsp;&nbsp;'Comet', 'Cupid', 'Donner', 'Blitzen',
], 'check reindeer');

"With Test2::V0 you'd just use is."

#!/usr/bin/perl

use Test2::V0

use Reindeer::Santa  qw(original_team);
my @results = original_team();

is(\@original_tam, [
&nbsp;&nbsp;&nbsp;&nbsp;'Dasher', 'Dancer', 'Prancer', 'Vixen',
&nbsp;&nbsp;&nbsp;&nbsp;'Comet', 'Cupid', 'Donner', 'Blitzen',
], 'check reindeer');

The Wise Old Elf went onto explain it was so much more. To demonstrate, he set a little programming exercise.

Write a test that checks the output is a hashref that has three entries in it. The first is a name (which must be a string). The second is an age which must be equal to eighteen or the string "adult". The third is an info array that has four elements: A true value, an instance of Snowman, an instance that has an as_string method that returns Anna, and finally something that is a valid RFC 1123 date time. The top level hash can have any other alphanumeric keys except error.

The elves spent a long time producing page after page of code. There were debates. Arguments. And thirty minutes later no-one was done.

They were quite shocked when the Wise Old elf showed them his simple solution:

is($data, hash {
   # insist that name is a string (not a ref, etc!)
   field name =&gt; match qr//;

   # insist that the person's age 18 (or 18.0, etc) or &quot;adult&quot;
   field age  =&gt; in_set(number(18), &quot;adult&quot;);

   # info is an array
   field info =&gt; array {
       # the first element must be a true value
       item T();

       # the second element must be an instance of Snowman
       item object { blessed =&gt; 'Snowman' };

       # the third element must return 'Anna' when as_string is called on it
       item object { call as_string =&gt; 'Anna' };

       # the fourth element must be parseable as a RFC 1123 time
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# the validator sub must return true if passes, false if not
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# (and Try::Tiny's try returns undef on exception)
       item validator(sub {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return try {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;DateTime::Format::HTTP-&gt;parse_datetime( $_ );
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;1;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;};
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;});

       # and there must only be four elements
       end();
&nbsp;&nbsp;&nbsp;};

   # we don't want a field called &quot;error&quot;
   field error =&gt; DNE();  # does not exist

   # allow any other fields that keys are alphanumeric
   all_keys(match qr/^[A-Za-z0-9]+$/aa);
&nbsp;&nbsp;&nbsp;etc();
&nbsp;&nbsp;&nbsp;}, &quot;compare&quot;);

Exception Checking

"Sparkle Candytoes, what are an elf's favorite colors?"

Sparkle beamed. "Red and Green, Wise Old Elf"

"Correct! When we write good tests we don't just test the green path - what our code does wh its supposed to, we also check the red path. Does it handle hte errors correctly".

"We want to make sure that our code throws the right exceptions. Without the exception breaking our test of course! Test2::V0 has its own exception capturing code:"

&nbsp;use autodie;

ok(dies {
&nbsp;&nbsp;&nbsp;&nbsp;open my $fh, &quot;&lt;&quot;, &quot;file-that-does-not-exist&quot;;
}, 'open throws exception on non existent file');

"Since dies returns the actual exception thrown we can improve the test, by checking if the exception contained the right string:

    like(dies {
       open my $fh, &quot;&lt;&quot;, &quot;file-that-does-not-exist&quot;;
    }, qr/No such file/, &#39;open throws exception on non existent file&#39;);

Or even check that something dies with the right kind of errors

    isa_ok(dies {
        Mojo::Exception-&gt;throw(&#39;boom&#39;)
    }, &#39;Mojo::Exception&#39;, &#39;exception was an instance of Mojo::Exception);

Subtests

"Now class, who can spot the problem with this code?"

use Test::More;

subtest 'horse' =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;is $cart, 'cart', 'cart';
};

done_testing;

No hands up. "Cinnamon Candybubbles, how about you".

"I think it works, Wise Old Elf"

"Oh, it does, it does. It just looks confusing"

    # Subtest: horse
        not ok 1 - cart
        #   Failed test &#39;cart&#39;
        #   at - line 4.
        #          got: undef
        #     expected: &#39;cart&#39;
        1..1
        # Looks like you failed 1 test of 1.
    not ok 1 - horse
    #   Failed test &#39;horse&#39;
    #   at - line 5.
    1..1

"You have to read the comments to figure out what's going on. The cart is literally before the horse."

The Wise Old Elf showed them the same code in Test2::V0:

use Test2::V0;  # only this line changed!

subtest 'horse' =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;is $cart, 'cart', 'cart';
};

done_testing;

But the output is very different

    not ok 1 - horse {
        not ok 1 - cart
        # Failed test &#39;cart&#39;
        # at - line 5.
        # +---------+-------+
        # | GOT     | CHECK |
        # +---------+-------+
        # | &lt;UNDEF&gt; | cart  |
        # +---------+-------+
        1..1
    }
    # Failed test &#39;horse&#39;
    # at - line 6.
    1..1

And More

"Now class, I'd like to talk to you about...", began the Wise Old Elf, only to be interrupted by the ringing of the lunch bell. Test2 is a big topic. More will have to wait for another day...

Controlling your Terminal with Perl

2019-12-20T00:00:00Z

iTerm is a heck of a terminal emulator for macOS. Not only is it rock solid, fast, and efficient - it's also exteremly powerful - and can both be controlled by Perl and can control Perl.

Are We Nearly There Yet?

In addition to the standard control sequences iTerm supports Proprietary Escape Codes that can get it to do non-standard things a real dumb terminal would never be able to do.

For example, my standard wrapper for running tests in Perl looks like this:

   perl -e &#39;print &quot;\e]50;ClearScrollback\a&quot;&#39; &amp;&amp;
   yath -v -Ilib t/01mytest.t \
   &amp;&amp; perl -e &#39;print &quot;\e]9;\nALL OK\a&quot;&#39; || perl -e &#39;print &quot;\e]9;\nFAILED\a&quot;&#39;

That first sends the control sequence to clear the screen and delete all history (so scrolling to the top takes me to the top of the test.) It then runs the tests, and I can go make a cup of tea, because the script will send a notification that'll bleep as soon as tests are done running to tell me if it's succeeded or failed.

Clickable Links

Another neat trick that iTerm supports allowing programs to markup their output so that text becomes clickable. For example this creates a clickable link to google about Perl.

print &quot;Search more about &quot;;
my $href = 'http://google.com?q=Perl';
my $text = 'Perl';
print &quot;\e]8;;$href\a$text\e]8;;\a&quot;;
print &quot;.\n&quot;;

Of course, the links don't have to be pages on the web - you can trigger anything that has a URL scheme on macOS. Here I can click on the bullet point links to add them to OmniFocus:

#!/usr/bin/perl

use 5.024;
use warnings;
use experimental 'signatures';

say &quot;* &quot;.clickable_link('Buy Milk', 'omnifocus:///add?name=Buy%20milk');
say &quot;* &quot;.clickable_link('Debug Program', 'omnifocus:///add?name=Debug%20Program');

sub clickable_link($text, $href) {
&nbsp;&nbsp;&nbsp;&nbsp;return &quot;\e]8;;$href\a$text\e]8;;\a&quot;;
}

Clickable Recognizable Text

So far we've been talking about having the programs running in the terminal in control. What if we want to do it the other way round - configure the terminal to react to things in the terminal and decide what to do itself?

This kind of thing is configured in the Profiles section of iTerm's preferences. iTerm can be configured to switch to any profile you create automatically. For example here I've configured it to switch to this profile whenever I'm in the RuleTheWorld project dir in my homedir.

Now I can click on the Edit button below Smart Selection to define some new selection rules. Let's create one for Perl error messages.

Now if if hit Edit I can start defining context menu opens for when I right click on anything that matches the regex. The first menu item I create can also be activated by cmd-clicking on the match.

Now when I command-click on an error message it'll open the file in VSCode at the right line number.

Triggers

Triggers are similar to clickable text, except you don't have to click on them - they happen immediately as the terminal sees the text being sent to it.

For example, you might recognize the message Hypnotoad prints out when starting up and open the browser window. Or you might have a command on the remove server print out something (like a file name) in a recognizable format and have the local machine do something like it (such as trigger a script to download that file and open in the editor).

One of my all time favorite hacks is to have iTerm color code the backgrounds of my Perl error messages so they're easy to spot.

I use two different colors for the highlighting - red indicates the error message came from an absolute path (meaning it's an installed library, not my code, and I'm less likely to change it) whereas green means it's local code that I probably need to fix.

Of course, combined with the previous tip, I can cmd-click on these links to open them in vscode.

Complete Control

For the ultimate control you can have iTerm start a "coprocess". This means that as well as rendring what it's being sent it'll also send a copy to an external running program (a co-process.) That process can either simply monitor what's being printed to the terminal, or it can send it's own output which will be interpreted as the user having typed that at the terminal.

Coprocessses can be started manually, or by a user key combination, or even by a trigger recognizing some text that indicates a program you want to control automatically from you

Syncing our `lib` directory

One cool trick I use coprocesses for is transferring my lib directory of custom modules to any machine I'm connected to. Rather than worrying about if that machine can access the internet, if I can put the fils in my home directory somewhere insecure or not, or if I can connect directly to the machine I'm logged into to transfer files - I have a different solution.

I just type them in again on each machine.

Or rather, the co-process does this for me. Here's an the example coprocess script to transfer the lib directory.

    #!/bin/sh

    echo &#39;stty_orig=`stty -g`&#39;
    echo &#39;stty -echo&#39;
    echo &#39;clear&#39;
    echo &#39;echo &quot;Please wait, transfering&quot;&#39;
    echo &quot;cd ~&quot;;
    echo &quot;base64 -d | tar -xzf -&quot;
    cd ~
    tar -czf - -C ~ lib | base64 -b 72
    perl -e &#39;print &quot;\x{04}&quot;&#39;
    echo &#39;clear&#39;
    echo &#39;echo &quot;All done!&quot;&#39;
    echo &#39;stty $stty_orig&#39;

If you squint hard enough you can actually work out what this is doing. It types a command on the remote machine to base64 decode anything that the user types and send it to tar to spit out to the filesystem. It then runs a command locally to tarball up the lib dir and print out the base64 encoding - effectively typing it over the wire to the command we just set up. It finally sends a ctrl-d to let the other end we're done before resetting the terminal.

Conclusion

I've barely scratchd the surface of what iTerm2 can do here, but I hope I've convinced you to give yourself th gift of an optimized environment this year!

Memories of Past Lives

2019-12-19T00:00:00Z

Sometimes, Christmas can be the most stressful time of year. Even at the North Pole, it's not all gumdrops and candycanes.

Take, for example, one very red faced and obviously upset elf. Jolly Pudding was muttering under his breath at his computer after his code had shown yet another error message and ground to a halt.

"And breath!" the Wise Old Elf consoled, "And tell me what the matter is."

"Well", Jolly explained, "I'm writing this quick one off script to produce a report on the toy produced this year. The trouble is that the code keeps failing after about half an hour or so. It's really annoying to debug."

"So you need it to run faster so you can debug it quicker?"

"Yes. That's exactly it! Right now I have sit here, twiddling my thumbs for half an hour each time. What's worse is by the time it fails again I've totally lost the train of thought."

"What you need to do is cache the results of what you did get to run okay between runs.", whe Wise Old Elf explained sagely, "Then you'd be able to get to the point where the code breaks instantly"

"Oh, I don't know...that seems like a lot of work for a one off script."

"I've got the perfect module for you: Memoize"

"Memozie! You can't be serious!"

A Blast from the past.

Memoize was originally featured in the first ever Perl Advent calendar entry twenty years ago, back before there even were articles on each module.

Memoize can be used to cache the results of a function call so if it's called again with the same arguments the cached version is returned. The classic example is the fibonacci sequence.

Without memoize:

sub fib($n) {
&nbsp;&nbsp;&nbsp;&nbsp;return 1 if $n &lt;= 2;
&nbsp;&nbsp;&nbsp;&nbsp;return fib($n-1) + fib($n-2);
}

say fib(50);

Running this takes a while to execute:

    $ time perl fib.pl
    102334155

    real    1m6.912s
    user    1m6.872s
    sys     0m0.032s

Now the sam code with Memoize:

use Memoize;

sub fib($n) {
&nbsp;&nbsp;&nbsp;&nbsp;return 1 if $n &lt;= 2;
&nbsp;&nbsp;&nbsp;&nbsp;return fib($n-1) + fib($n-2);
}
memoize('fib');

say fib(50);

Runs much, much faster

    $ time perl fib.pl
    102334155

    real    0m0.055s
    user    0m0.009s
    sys     0m0.009s

Persisting between program runs

This is all very well, but Memoize uses an in memory cache. Jolly's problem is that each time he runs his code his program has to re-do all the work up until the point that it crashes. Using memoize like above won't speed up his code at all as every time the script runs it starts with a fresh empty cache.

What we need to do is what the Wise Old Elf suggested - persist our results between program runs.

Well, Memoize can do that:

sub divide($n,$d) {
    # make this take artificially long for the purposes of
&nbsp;&nbsp;&nbsp;&nbsp;# the demo
    sleep 1;
&nbsp;&nbsp;&nbsp;&nbsp;
&nbsp;&nbsp;&nbsp;&nbsp;return $n / $d;
}

use DB_File;
tie my %cache =&gt; 'DB_File', '/tmp/memoize', O_RDWR|O_CREAT, 0666;
memoize 'divide', SCALAR_CACHE =&gt; [HASH =&gt; \%cache];

for (10..-10) {
&nbsp;&nbsp;&nbsp;&nbsp;say &quot;100 divided by $_ is &quot; . divide(100,$_);
}

Now the first time we run this it takes a while:

    $time perl div.pl 
    100 divided by -10 is -10
    100 divided by -9 is -11.1111111111111
    100 divided by -8 is -12.5
    100 divided by -7 is -14.2857142857143
    100 divided by -6 is -16.6666666666667
    100 divided by -5 is -20
    100 divided by -4 is -25
    100 divided by -3 is -33.3333333333333
    100 divided by -2 is -50
    100 divided by -1 is -100
    Illegal division by zero at div.pl line 15.

    real    0m11.051s
    user    0m0.031s
    sys     0m0.004s

But the next time is much much quicker:

    $ time perl div.pl 
    100 divided by -10 is -10
    100 divided by -9 is -11.1111111111111
    100 divided by -8 is -12.5
    100 divided by -7 is -14.2857142857143
    100 divided by -6 is -16.6666666666667
    100 divided by -5 is -20
    100 divided by -4 is -25
    100 divided by -3 is -33.3333333333333
    100 divided by -2 is -50
    100 divided by -1 is -100
    Illegal division by zero at div.pl line 15.

    real    0m1.028s
    user    0m0.016s
    sys     0m0.012s

Whooo! instant death!

Methods

What if the thing we need to cache is a method call?

package Fetcher;
use Mo;
use experimental 'signatures';

use HTTP::Tiny;

has 'url';

sub fetch ($self) {
&nbsp;&nbsp;&nbsp;&nbsp;my $response = HTTP::Tiny-&gt;new-&gt;get( $self-&gt;url );
&nbsp;&nbsp;&nbsp;&nbsp;die &quot;Failed!\n&quot; unless $response-&gt;{success};
&nbsp;&nbsp;&nbsp;&nbsp;return $response-&gt;{content};
}

use Memoize;
use DB_File;
tie my %cache =&gt; 'DB_File', '/tmp/memoize', O_RDWR|O_CREAT, 0666;
memoize 'fetch', SCALAR_CACHE =&gt; [HASH =&gt; \%cache];

1;

Each time we run our Santa detecting script:

#!/usr/bin/perl

use 5.024;
use warnings;

use Fetcher;

for (qw(
&nbsp;&nbsp;&nbsp;&nbsp;http://www.bbc.co.uk/news/
&nbsp;&nbsp;&nbsp;&nbsp;http://www.cnn.com/
&nbsp;&nbsp;&nbsp;&nbsp;http://news.ycombinator.com/
)) {
&nbsp;&nbsp;&nbsp;&nbsp;my $f = Fetcher-&gt;new( url =&gt; $_ );
&nbsp;&nbsp;&nbsp;&nbsp;say &quot;SANTA IS HAPPENING&quot; if $f-&gt;fetch =~ /santa/i;
}

It takes the about same time:

    $ time perl -I. santa.pl 

    real    0m1.254s
    user    0m0.090s
    sys     0m0.026s

    $ time perl -I. santa.pl 

    real    0m2.921s
    user    0m0.087s
    sys     0m0.028s

    $ time perl -I. santa.pl 

    real    0m1.203s
    user    0m0.085s
    sys     0m0.024s

The problem is that Memoize sees each instance of $f as being different between each run - it can't tell that an $f constructed with the same url will produce the same result. We can fix this with a normalizer

memoize 'fetch',
&nbsp;&nbsp;&nbsp;SCALAR_CACHE =&gt; [HASH =&gt; \%cache],
&nbsp;&nbsp;&nbsp;NORMALIZER =&gt; sub ($f,@) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return $f-&gt;url;
&nbsp;&nbsp;&nbsp;};

It's the job of the normalizer to take the arguments and return a suitable cache key. Here we're just using the URL that $f has, as that's the only thing that matters. Caching now works:

    $ time perl -I. santa.pl 

    real    0m3.503s
    user    0m0.125s
    sys     0m0.022s
    
    $ time perl -I. santa.pl 

    real    0m0.068s
    user    0m0.063s
    sys     0m0.005s

In Conclusion

So it turns out what we'd been thinking purely as a way of speeding up our code in limited circumstances is even more valuable as a tool to create temporary code in development to help us stop going insane. There's life in the old module yet!

P.S. You can Leave it in the production code

What if your one off script becomes something you run once a day or so? We all know that happens more often than we'd like.

The above code isn't suitable for that - it'll forever remember the news on the day the code was first run! (Or at least until the computer is restarted and /tmp is cleared out). What we need is for our cache to expire after, say, an hour.

Memoize, with the help of another core module, can do that too with layers of tied hashes:

tie my %cache =&gt; 'DB_File', '/tmp/memoize', O_CREAT|O_RDWR, 0666];
tie my %forgetful =&gt; 'Memoize::Expire', LIFETIME =&gt; 3600, HASH =&gt; \%cache; 
memoize 'fetch',
&nbsp;&nbsp;&nbsp;&nbsp;SCALAR_CACHE =&gt; [HASH =&gt; \%forgetful],
&nbsp;&nbsp;&nbsp;&nbsp;NORMALIZER =&gt; sub ($f,@) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return $f-&gt;url;
&nbsp;&nbsp;&nbsp;&nbsp;};

Core Strength

2019-12-18T00:00:00Z

One of the things to consider in the brave new world of Perl Lambda functions we've been exploring together over the last few days, is dependance cost. Every individual web endpoint is effectively its own bundle of dependencies. If we're not careful, the dependencies can add up quickly - for example, DateTime and its required dependencies alone adds 30MB+ of source code and support files. This is a problem when we've got a platform enforced hard limit of 50MB of decompressed files in our Lambda sourcecode zipfile - we either need to start splitting things out into layers, or slimming down.

One thing we should not overlook is that Perl already comes with a collection of awesome modules for doing the core tings (hence the name - the core distribution.) We should use more of those when we can! But how do we know if chosen module is available?

Module::CoreList is a CPAN module designed to solve this problem. It keeps detailed information on what core modules were included with the main Perl distribution for each release.

It's accessible on the web from http://corelist.rpee.be/, via the module interface, or most simply, via a command line tool.

Streching our Core Muscles

The command line tool has a bunch of really handy options - let's take tour and see what we can work out.

How about when a perl module was first released with perl?

    shell$ corelist List::Util
    Data for 2019-11-20
    List::Util was first released with perl v5.7.3

What was the date that went live?

    shell$ corelist -r 5.7.3
    Perl v5.7.3 was released on 2002-03-05

According to the List::Util's documentation the any function has been available since version 1.33. What version of perl was that released with?

    shell$ corelist -a List::Util
    Data for 2019-11-20
    List::Util was first released with perl v5.7.3
    v5.7.3     1.06_00   
    v5.8.0     1.07_00   
    v5.8.1     1.13      
    v5.8.2     1.13      
    v5.8.3     1.13      
    v5.8.4     1.13      
    v5.8.5     1.14      
    v5.8.6     1.14      
    v5.8.7     1.14      
    v5.8.8     1.18      
    v5.8.9     1.19      
    v5.9.0     1.13      
    v5.9.1     1.13      
    v5.9.2     1.14      
    v5.9.3     1.18      
    v5.9.4     1.18      
    v5.9.5     1.19      
    v5.10.0    1.19      
    v5.10.1    1.21      
    v5.11.0    1.21      
    v5.11.1    1.21      
    v5.11.2    1.22      
    v5.11.3    1.22      
    v5.11.4    1.22      
    v5.11.5    1.22      
    v5.12.0    1.22      
    v5.12.1    1.22      
    v5.12.2    1.22      
    v5.12.3    1.22      
    v5.12.4    1.22      
    v5.12.5    1.22      
    v5.13.0    1.22      
    v5.13.1    1.23      
    v5.13.2    1.23      
    v5.13.3    1.23      
    v5.13.4    1.23      
    v5.13.5    1.23      
    v5.13.6    1.23      
    v5.13.7    1.23      
    v5.13.8    1.23      
    v5.13.9    1.23      
    v5.13.10   1.23      
    v5.13.11   1.23      
    v5.14.0    1.23      
    v5.14.1    1.23      
    v5.14.2    1.23      
    v5.14.3    1.23      
    v5.14.4    1.23      
    v5.15.0    1.23      
    v5.15.1    1.23      
    v5.15.2    1.23      
    v5.15.3    1.23      
    v5.15.4    1.23      
    v5.15.5    1.23      
    v5.15.6    1.23      
    v5.15.7    1.23      
    v5.15.8    1.23      
    v5.15.9    1.23      
    v5.16.0    1.23      
    v5.16.1    1.25      
    v5.16.2    1.25      
    v5.16.3    1.25      
    v5.17.0    1.23      
    v5.17.1    1.25      
    v5.17.2    1.25      
    v5.17.3    1.25      
    v5.17.4    1.25      
    v5.17.5    1.25      
    v5.17.6    1.25      
    v5.17.7    1.26      
    v5.17.8    1.27      
    v5.17.9    1.27      
    v5.17.10   1.27      
    v5.17.11   1.27      
    v5.18.0    1.27      
    v5.18.1    1.27      
    v5.18.2    1.27      
    v5.18.3    1.27      
    v5.18.4    1.27      
    v5.19.0    1.27      
    v5.19.1    1.27      
    v5.19.2    1.27      
    v5.19.3    1.31      
    v5.19.4    1.32      
    v5.19.5    1.35      
    v5.19.6    1.35      
    v5.19.7    1.35      
    v5.19.8    1.36      
    v5.19.9    1.38      
    v5.19.10   1.38      
    v5.19.11   1.38      
    v5.20.0    1.38      
    v5.20.1    1.38      
    v5.20.2    1.38      
    v5.20.3    1.38      
    v5.21.0    1.38      
    v5.21.1    1.39      
    v5.21.2    1.39      
    v5.21.3    1.39      
    v5.21.4    1.41      
    v5.21.5    1.41      
    v5.21.6    1.41      
    v5.21.7    1.41      
    v5.21.8    1.41      
    v5.21.9    1.41      
    v5.21.10   1.41      
    v5.21.11   1.41      
    v5.22.0    1.41      
    v5.22.1    1.41      
    v5.22.2    1.41      
    v5.22.3    1.41      
    v5.22.4    1.41      
    v5.23.0    1.42_01   
    v5.23.1    1.42_01   
    v5.23.2    1.42_01   
    v5.23.3    1.42_01   
    v5.23.4    1.42_01   
    v5.23.5    1.42_01   
    v5.23.6    1.42_01   
    v5.23.7    1.42_01   
    v5.23.8    1.42_01   
    v5.23.9    1.42_02   
    v5.24.0    1.42_02   
    v5.24.1    1.42_02   
    v5.24.2    1.42_02   
    v5.24.3    1.42_02   
    v5.24.4    1.42_02   
    v5.25.0    1.42_02   
    v5.25.1    1.45_01   
    v5.25.2    1.45_01   
    v5.25.3    1.45_01   
    v5.25.4    1.45_01   
    v5.25.5    1.45_01   
    v5.25.6    1.46      
    v5.25.7    1.46_02   
    v5.25.8    1.46_02   
    v5.25.9    1.46_02   
    v5.25.10   1.46_02   
    v5.25.11   1.46_02   
    v5.25.12   1.46_02   
    v5.26.0    1.46_02   
    v5.26.1    1.46_02   
    v5.26.2    1.46_02   
    v5.26.3    1.46_02   
    v5.27.0    1.46_02   
    v5.27.1    1.46_02   
    v5.27.2    1.48      
    v5.27.3    1.48      
    v5.27.4    1.48      
    v5.27.5    1.49      
    v5.27.6    1.49      
    v5.27.7    1.49      
    v5.27.8    1.49      
    v5.27.9    1.49      
    v5.27.10   1.50      
    v5.27.11   1.50      
    v5.28.0    1.50      
    v5.28.1    1.50      
    v5.28.2    1.50      
    v5.29.0    1.50      
    v5.29.1    1.50      
    v5.29.2    1.50      
    v5.29.3    1.50      
    v5.29.4    1.50      
    v5.29.5    1.50      
    v5.29.6    1.50      
    v5.29.7    1.50      
    v5.29.8    1.50      
    v5.29.9    1.50      
    v5.29.10   1.50      
    v5.30.0    1.50      
    v5.30.1    1.50      
    v5.31.0    1.50      
    v5.31.1    1.50      
    v5.31.2    1.50      
    v5.31.3    1.50      
    v5.31.4    1.52      
    v5.31.5    1.52      
    v5.31.6    1.53

Or, more sucinctly:

    corelist -a List::Util | perl -ne &#39;/^\s+(\S+)\s+(\S+)/ &amp;&amp; $2 &gt;= 1.33 &amp;&amp; print &amp;&amp; exit&#39;
      v5.19.5    1.35

If I find a bug in the module do I have to install a new version of perl to get an update, or can I just download an updated version of the module from the CPAN? And where can I report that bug to?

    corelist -u List::Util
    Data for 2019-11-20
    List::Util was first released with perl v5.7.3
    upstream: cpan
    bug tracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Scalar-List-Utils

(I can get a new version from the CPAN, and that's the bug tracker URL)

    corelist -u PerlIO
    Data for 2019-11-20
    PerlIO was first released with perl v5.7.3
    upstream: undef
    bug tracker: unknown

(PerlIO is shipped with perl, and I report bugs the same way I do with the core language itself, via perlbug)

What do we see if we search for a module that doesn't exist in core (even if we think it should be)

    shell$ corelist DateTime

    Data for 2019-11-20
    DateTime was not in CORE (or so I think)

This, of course, doesn't mean that DateTime might not come preinstalled on your system (on macOS for example it's distributed with the operating system.) Just it's not in the main core distribution!

What about something that was added to the core distribution but then removed again?

    $ corelist CGI
    Data for 2019-11-20
    CGI was first released with perl 5.004, deprecated (will be CPAN-only)
    in v5.19.7 and removed from v5.21.0

What about a core language level feature

    shell$ corelist -f say
    Data for 2019-11-20
    feature &quot;say&quot; was first released with the perl v5.9.5 feature bundle

(this means you can use feature "say" on any perl after v5.9.5)

You can even find out what were the module changes between Perl 5.28 and 5.30 for example:

    $ corelist --diff v5.28.0 v5.30.0
    App::Cpan                                 1.67      1.672
    Archive::Tar                              2.30       2.32
    Archive::Tar::Constant                    2.30       2.32
    Archive::Tar::File                        2.30       2.32
    B                                         1.74       1.76
    B::Concise                               1.003      1.004
    B::Debug                                  1.26   (absent)
    B::Deparse                                1.48       1.49
    B::Op_private                         5.028000   5.030000
    B::Terse                                  1.08       1.09
    CPAN                                      2.20       2.22
    CPAN::Distribution                        2.19       2.22
    CPAN::Mirrors                             2.12       2.21
    CPAN::Plugin                              0.96       0.97
    CPAN::Plugin::Specfile                    0.01       0.02
    CPAN::Shell                             5.5007     5.5008
    Compress::Raw::Bzip2                     2.074      2.084
    Compress::Raw::Zlib                      2.076      2.084
    Compress::Zlib                           2.074      2.084
    Config                                   5.028       5.03
    Config::Extensions                        0.02       0.03
    Config::Perl::V                           0.29       0.32
    Cwd                                       3.74       3.78
    DB_File                                  1.840      1.843
    Data::Dumper                             2.170      2.174
    Devel::PPPort                             3.40       3.52
    Devel::Peek                               1.27       1.28
    Digest::SHA                               6.01       6.02
    Encode                                    2.97       3.01
    Encode::Unicode                           2.17       2.18
    Errno                                     1.29       1.30
    ExtUtils::CBuilder                    0.280230   0.280231
    ExtUtils::CBuilder::Base              0.280230   0.280231
    ExtUtils::CBuilder::Platform::Unix    0.280230   0.280231
    ExtUtils::CBuilder::Platform::VMS     0.280230   0.280231
    ExtUtils::CBuilder::Platform::Windows   0.280230   0.280231
    ExtUtils::CBuilder::Platform::Windows::BCC   0.280230   0.280231
    ExtUtils::CBuilder::Platform::Windows::GCC   0.280230   0.280231
    ExtUtils::CBuilder::Platform::Windows::MSVC   0.280230   0.280231
    ExtUtils::CBuilder::Platform::aix     0.280230   0.280231
    ExtUtils::CBuilder::Platform::android   0.280230   0.280231
    ExtUtils::CBuilder::Platform::cygwin   0.280230   0.280231
    ExtUtils::CBuilder::Platform::darwin   0.280230   0.280231
    ExtUtils::CBuilder::Platform::dec_osf   0.280230   0.280231
    ExtUtils::CBuilder::Platform::os2     0.280230   0.280231
    ExtUtils::Manifest                        1.70       1.72
    ExtUtils::Miniperl                        1.08       1.09
    ExtUtils::ParseXS                         3.39       3.40
    ExtUtils::ParseXS::Constants              3.39       3.40
    ExtUtils::ParseXS::CountLines             3.39       3.40
    ExtUtils::ParseXS::Eval                   3.39       3.40
    ExtUtils::ParseXS::Utilities              3.39       3.40
    File::Copy                                2.33       2.34
    File::Find                                1.34       1.36
    File::Glob                                1.31       1.32
    File::GlobMapper                         1.000      1.001
    File::Path                                2.15       2.16
    File::Spec                                3.74       3.78
    File::Spec::AmigaOS                       3.74       3.78
    File::Spec::Cygwin                        3.74       3.78
    File::Spec::Epoc                          3.74       3.78
    File::Spec::Functions                     3.74       3.78
    File::Spec::Mac                           3.74       3.78
    File::Spec::OS2                           3.74       3.78
    File::Spec::Unix                          3.74       3.78
    File::Spec::VMS                           3.74       3.78
    File::Spec::Win32                         3.74       3.78
    File::Temp                              0.2304     0.2309
    Filter::Util::Call                        1.58       1.59
    GDBM_File                                 1.17       1.18
    HTTP::Tiny                               0.070      0.076
    I18N::Langinfo                            0.17       0.18
    IO                                        1.39       1.40
    IO::Compress::Adapter::Bzip2             2.074      2.084
    IO::Compress::Adapter::Deflate           2.074      2.084
    IO::Compress::Adapter::Identity          2.074      2.084
    IO::Compress::Base                       2.074      2.084
    IO::Compress::Base::Common               2.074      2.084
    IO::Compress::Bzip2                      2.074      2.084
    IO::Compress::Deflate                    2.074      2.084
    IO::Compress::Gzip                       2.074      2.084
    IO::Compress::Gzip::Constants            2.074      2.084
    IO::Compress::RawDeflate                 2.074      2.084
    IO::Compress::Zip                        2.074      2.084
    IO::Compress::Zip::Constants             2.074      2.084
    IO::Compress::Zlib::Constants            2.074      2.084
    IO::Compress::Zlib::Extra                2.074      2.084
    IO::Dir                                   1.39       1.40
    IO::File                                  1.39       1.40
    IO::Handle                                1.39       1.40
    IO::Pipe                                  1.39       1.40
    IO::Poll                                  1.39       1.40
    IO::Seekable                              1.39       1.40
    IO::Select                                1.39       1.40
    IO::Socket                                1.39       1.40
    IO::Socket::INET                          1.39       1.40
    IO::Socket::UNIX                          1.39       1.40
    IO::Uncompress::Adapter::Bunzip2         2.074      2.084
    IO::Uncompress::Adapter::Identity        2.074      2.084
    IO::Uncompress::Adapter::Inflate         2.074      2.084
    IO::Uncompress::AnyInflate               2.074      2.084
    IO::Uncompress::AnyUncompress            2.074      2.084
    IO::Uncompress::Base                     2.074      2.084
    IO::Uncompress::Bunzip2                  2.074      2.084
    IO::Uncompress::Gunzip                   2.074      2.084
    IO::Uncompress::Inflate                  2.074      2.084
    IO::Uncompress::RawInflate               2.074      2.084
    IO::Uncompress::Unzip                    2.074      2.084
    IPC::Cmd                                  1.00       1.02
    JSON::PP                               2.97001       4.02
    JSON::PP::Boolean                      2.97001       4.02
    Locale::Codes                             3.56   (absent)
    Locale::Codes::Constants                  3.56   (absent)
    Locale::Codes::Country                    3.56   (absent)
    Locale::Codes::Country_Codes              3.56   (absent)
    Locale::Codes::Country_Retired            3.56   (absent)
    Locale::Codes::Currency                   3.56   (absent)
    Locale::Codes::Currency_Codes             3.56   (absent)
    Locale::Codes::Currency_Retired           3.56   (absent)
    Locale::Codes::LangExt                    3.56   (absent)
    Locale::Codes::LangExt_Codes              3.56   (absent)
    Locale::Codes::LangExt_Retired            3.56   (absent)
    Locale::Codes::LangFam                    3.56   (absent)
    Locale::Codes::LangFam_Codes              3.56   (absent)
    Locale::Codes::LangFam_Retired            3.56   (absent)
    Locale::Codes::LangVar                    3.56   (absent)
    Locale::Codes::LangVar_Codes              3.56   (absent)
    Locale::Codes::LangVar_Retired            3.56   (absent)
    Locale::Codes::Language                   3.56   (absent)
    Locale::Codes::Language_Codes             3.56   (absent)
    Locale::Codes::Language_Retired           3.56   (absent)
    Locale::Codes::Script                     3.56   (absent)
    Locale::Codes::Script_Codes               3.56   (absent)
    Locale::Codes::Script_Retired             3.56   (absent)
    Locale::Country                           3.56   (absent)
    Locale::Currency                          3.56   (absent)
    Locale::Language                          3.56   (absent)
    Locale::Script                            3.56   (absent)
    Math::BigFloat                        1.999811   1.999816
    Math::BigFloat::Trace                     0.49       0.51
    Math::BigInt                          1.999811   1.999816
    Math::BigInt::Calc                    1.999811   1.999816
    Math::BigInt::CalcEmu                 1.999811   (absent)
    Math::BigInt::FastCalc                  0.5006     0.5008
    Math::BigInt::Lib                     1.999811   1.999816
    Math::BigInt::Trace                       0.49       0.51
    Math::BigRat                            0.2613     0.2614
    Module::CoreList                    5.20180622 5.20190522
    Module::CoreList::Utils             5.20180622 5.20190522
    Module::Load                              0.32       0.34
    Module::Metadata                      1.000033   1.000036
    NDBM_File                                 1.14       1.15
    Net::Ping                                 2.62       2.71
    ODBM_File                                 1.15       1.16
    POSIX                                     1.84       1.88
    PerlIO::encoding                          0.26       0.27
    PerlIO::scalar                            0.29       0.30
    Pod::Man                                  4.10       4.11
    Pod::ParseLink                            4.10       4.11
    Pod::Text                                 4.10       4.11
    Pod::Text::Color                          4.10       4.11
    Pod::Text::Overstrike                     4.10       4.11
    Pod::Text::Termcap                        4.10       4.11
    SDBM_File                                 1.14       1.15
    Storable                                  3.08       3.15
    Storable::Limit                        (undef)   (absent)
    Test2                                 1.302133   1.302162
    Test2::API                            1.302133   1.302162
    Test2::API::Breakage                  1.302133   1.302162
    Test2::API::Context                   1.302133   1.302162
    Test2::API::Instance                  1.302133   1.302162
    Test2::API::Stack                     1.302133   1.302162
    Test2::Event                          1.302133   1.302162
    Test2::Event::Bail                    1.302133   1.302162
    Test2::Event::Diag                    1.302133   1.302162
    Test2::Event::Encoding                1.302133   1.302162
    Test2::Event::Exception               1.302133   1.302162
    Test2::Event::Fail                    1.302133   1.302162
    Test2::Event::Generic                 1.302133   1.302162
    Test2::Event::Note                    1.302133   1.302162
    Test2::Event::Ok                      1.302133   1.302162
    Test2::Event::Pass                    1.302133   1.302162
    Test2::Event::Plan                    1.302133   1.302162
    Test2::Event::Skip                    1.302133   1.302162
    Test2::Event::Subtest                 1.302133   1.302162
    Test2::Event::TAP::Version            1.302133   1.302162
    Test2::Event::V2                      1.302133   1.302162
    Test2::Event::Waiting                 1.302133   1.302162
    Test2::EventFacet                     1.302133   1.302162
    Test2::EventFacet::About              1.302133   1.302162
    Test2::EventFacet::Amnesty            1.302133   1.302162
    Test2::EventFacet::Assert             1.302133   1.302162
    Test2::EventFacet::Control            1.302133   1.302162
    Test2::EventFacet::Error              1.302133   1.302162
    Test2::EventFacet::Hub                1.302133   1.302162
    Test2::EventFacet::Info               1.302133   1.302162
    Test2::EventFacet::Info::Table        (absent)    (undef)
    Test2::EventFacet::Meta               1.302133   1.302162
    Test2::EventFacet::Parent             1.302133   1.302162
    Test2::EventFacet::Plan               1.302133   1.302162
    Test2::EventFacet::Render             1.302133   1.302162
    Test2::EventFacet::Trace              1.302133   1.302162
    Test2::Formatter                      1.302133   1.302162
    Test2::Formatter::TAP                 1.302133   1.302162
    Test2::Hub                            1.302133   1.302162
    Test2::Hub::Interceptor               1.302133   1.302162
    Test2::Hub::Interceptor::Terminator   1.302133   1.302162
    Test2::Hub::Subtest                   1.302133   1.302162
    Test2::IPC                            1.302133   1.302162
    Test2::IPC::Driver                    1.302133   1.302162
    Test2::IPC::Driver::Files             1.302133   1.302162
    Test2::Tools::Tiny                    1.302133   1.302162
    Test2::Util                           1.302133   1.302162
    Test2::Util::ExternalMeta             1.302133   1.302162
    Test2::Util::Facets2Legacy            1.302133   1.302162
    Test2::Util::HashBase                 1.302133   1.302162
    Test2::Util::Trace                    1.302133   1.302162
    Test::Builder                         1.302133   1.302162
    Test::Builder::Formatter              1.302133   1.302162
    Test::Builder::Module                 1.302133   1.302162
    Test::Builder::Tester                 1.302133   1.302162
    Test::Builder::Tester::Color          1.302133   1.302162
    Test::Builder::TodoDiag               1.302133   1.302162
    Test::More                            1.302133   1.302162
    Test::Simple                          1.302133   1.302162
    Test::Tester                          1.302133   1.302162
    Test::Tester::Capture                 1.302133   1.302162
    Test::Tester::CaptureRunner           1.302133   1.302162
    Test::Tester::Delegate                1.302133   1.302162
    Test::use::ok                         1.302133   1.302162
    Thread::Queue                             3.12       3.13
    Time::HiRes                             1.9759     1.9760
    Time::Local                               1.25       1.28
    Time::Piece                             1.3204       1.33
    Time::Seconds                           1.3204       1.33
    Unicode                                 10.0.0     12.1.0
    Unicode::Collate                          1.25       1.27
    Unicode::Collate::CJK::Big5               1.25       1.27
    Unicode::Collate::CJK::GB2312             1.25       1.27
    Unicode::Collate::CJK::JISX0208           1.25       1.27
    Unicode::Collate::CJK::Korean             1.25       1.27
    Unicode::Collate::CJK::Pinyin             1.25       1.27
    Unicode::Collate::CJK::Stroke             1.25       1.27
    Unicode::Collate::CJK::Zhuyin             1.25       1.27
    Unicode::Collate::Locale                  1.25       1.27
    Unicode::UCD                              0.70       0.72
    User::grent                               1.02       1.03
    XS::APItest                               0.98       1.00
    XS::Typemap                               0.16       0.17
    arybase                                   0.15   (absent)
    bigint                                    0.49       0.51
    bignum                                    0.49       0.51
    bigrat                                    0.49       0.51
    bytes                                     1.06       1.07
    deprecate                                 0.03       0.04
    experimental                             0.019      0.020
    feature                                   1.52       1.54
    lib                                       0.64       0.65
    ok                                    1.302133   1.302162
    parent                                   0.236      0.237
    perlfaq                               5.021011 5.20190126
    re                                        0.36       0.37
    sigtrap                                   1.08       1.09
    threads::shared                           1.58       1.60
    utf8                                      1.21       1.22
    vars                                      1.04       1.05
    version                                 0.9923     0.9924
    version::regex                          0.9923     0.9924
    warnings                                  1.42       1.44

Beyond a Core Workout

One thing to consider however is that core modules aren't your own source of modules on the enviroment.

Consider running a Lambda function and using Try::Tiny. Not a core module:

    $ corelist Try::Tiny
    Data for 2019-11-20
    Try::Tiny was not in CORE (or so I think)

But you can still use it in an AWS::Lambda powered function without having to supply it yourself in the zipfile! How is this possible? Well, it's because AWS::Lambda itself uses the module, and therefore it's in the default layer that your Lambda function uses.

What you need to do is look at the dependance graph for AWS::Lambda so you can see not only the direct dependencies of AWS::Lambda but its dependencies' dependencies and so on. You can probably use all of these too!

You can literally see a graph for each module's dependancies by visiting https://cpandeps.grinnz.com/. For example, here's the graph for AWS::Lambda.

Similarly, we noted that DateTime is available on macOS Catalina. Therefore, any runtime dependencies it requires must also be installed, correct? Well, it's not quite that easy. You'd expect the excellent Params::ValidationCompiler to be available as it's a requirement of the DateTime 1.51 module that's on the CPAN. But macOS only bundles version 1.06, which doesn't require Params::ValidationCompiler, so it's not there. You have to sweat the details!

Keep Working It

Of course, if you need something from the CPAN, you should go ahead and grab it. But, sometimes it's good to run slim...

Taking the Sleigh to a CloudFront

2019-12-17T00:00:00Z

The Wise Old Elf was very impressed how Sugarplum Snoozysnaps had saved Christmas this year by moving some code to AWS Lambda at the last moment. So impressed that he wanted her to investigate how it could be used to do more.

Right now the elves were running dedicated servers for a few internal Mojolicious apps. Would it be possible to port these to run entirely on AWS Lambda?

Bundling Mojolicious

First, let's download Mojolicious to a local directory with cpanm

    $shell cpanm -L extra Mojolicious
    --&gt; Working on Mojolicious
    Fetching http://www.cpan.org/authors/id/S/SR/SRI/Mojolicious-8.27.tar.gz ... OK
    Configuring Mojolicious-8.27 ... OK
    Building and testing Mojolicious-8.27 ... OK
    Successfully installed Mojolicious-8.27
    1 distribution installed

This creates a local copy of Mojolicious in our file system like so:

    shell$ find extra/lib/perl5
    extra/lib/perl5
    extra/lib/perl5/Mojo.pm
    extra/lib/perl5/Test
    extra/lib/perl5/Test/Mojo.pm
    extra/lib/perl5/ojo.pm
    extra/lib/perl5/Mojolicious.pm

Sugarplum can now ask AWS::Lambda::Quick to upload this for her with the rest of her code by specifying extra as an argument to extra_files.

#!/usr/bin/perl5
use strict;
use warnings;

use AWS::Lambda::Quick (
&nbsp;&nbsp;&nbsp;&nbsp;name        =&gt; 'mojo',
&nbsp;&nbsp;&nbsp;&nbsp;extra_files =&gt; [ 'extra' ],
&nbsp;&nbsp;&nbsp;&nbsp;timeout     =&gt; 10,
);

Once that's done she can modify her script to load modules from the lib dir within the extra dir. Note the use of the LAMBDA_TASK_ROOT environment variable to help us locate those files:

# Where we put the local Mojo
use lib &quot;$ENV{'LAMBDA_TASK_ROOT'}/extra/lib/perl5&quot;;

Since Mojolicious is a pure Perl distribution just uploading the installed files works regardless of different system architecture or perl versions between Sugarplum's local machine and the virtual machine AWS Lambda is running under.

Connecting Lambda to Mojolicious

Sugarplum needs to plumb the various bits together now, to get Mojolicious to somehow understand the hashref passed into the handler function and get it to spit out the hashref that the handler is expected to return.

The first stage is to get AWS::Lambda to talk to any standard web server that can communicate via the PSGI function

use AWS::Lambda::PSGI;

my $psgi_app = sub {
&nbsp;&nbsp;&nbsp;&nbsp;return [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;200,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ 'Content-Type' =&gt; 'text/plain' ],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ '&lt;html&gt;&lt;body&gt;Hello, World @ '.time.'&lt;/body&gt;&lt;/html&gt;' ],
&nbsp;&nbsp;&nbsp;&nbsp;];
}

sub handler { 
&nbsp;&nbsp;&nbsp;&nbsp;return AWS::Lambda::PSGI-&gt;wrap( $psgi_app )-&gt;( @_ );
}

We already know how to get Mojolicious to produce a PSGI application. Sugarplum can use that instead of the hard coded application above:

use Mojolicious::Lite;

my $psgi_app = app-&gt;start('psgi');

sub handler { 
&nbsp;&nbsp;&nbsp;&nbsp;return AWS::Lambda::PSGI-&gt;wrap( $psgi_app )-&gt;( @_ );
}

get '/' =&gt; 'index';

1;

__DATA__

@@ index.html.ep

&lt;html&gt;
&lt;body&gt;
Hello, World @ &lt;%= scalar time %&gt;
&lt;/body&gt;
&lt;/html&gt;

And works! Well, at least Mojolicious executes and produces output of some sort...

Uh, but what happened to her page? Why isn't it producing her hello world application?

Well, we remember we declared a route on / but look at that debug output that's not what the on the server is: It's running on /mojo for the base of /quick.

We'll fix that, but before we do, let's consider how Sugarplum is going to host this as a top level domain.

Configuring Cloudfront

Cloudfront is AWS's CDN solution that can sit infront of origin servers, S3 buckets, and - most usefully to Ms Snoozysnaps - the API Gateway running her Lambda function.

For today's exercise Sugarplum is just going to use one of Amazon's own subdomains. When Sugarplum releases the live version she's going to setup a CNAME for domain name she owns - but for development testing she doesn't want to go to the trouble of verifying all that with Amazon.

Sugarplum needs to load up the web interface to setup a new Cloudfront distribution and click on "Web" to see

Origin Domain Name should be set to the Lambda gateway domain name (in this case '52p3rf890b.execute-api.us-east-1.amazonaws.com')
Origin Path should be set to /quick/mojo
Origin Protocol Policy (which will show after you set Origin Domain Name) should be set to HTTPS Only (as our API gateway doesn't support HTTP)
Object Caching should be set to Customize, and all the TTLs should be set to 0 to disable caching. Sugarplum Snoozysnaps will want to eventually to have her Mojo app produce custom caching headers to avoid each and every request running through Lambda, but this is good for development.

Finally we Sugarplum can click on the Create Distribution at the very bottom of the page. She's probably got time to go get a cup of fresh eggnog while AWS churns away getting all that set up and allowing domain names to propagate.

When the interface finally tells us it's ready, we can load it up...and still see errors. At least this time we can tell exactly what is broken.

Making the Paths Work

Sugarplum now knows what she needs to do to modify the paths.

The base URL needs to have /quick stripped off of it
The url itelf needs to have /mojo stripped off

It's important to do both of these so that URLs that Mojolicious creates linking to named routes (i.e. with the url_for or link_to helpers) end up linking to the right place.

Modification of the URLs can be managed by adding a hook that does the modifications before dispatch

app-&gt;hook(before_dispatch =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $c = shift;

    # see https://mojolicious.org/perldoc/Mojolicious/Guides/Cookbook#Rewriting
&nbsp;&nbsp;&nbsp;&nbsp;# for details on what exactly we're doing here

    # remove the '/quick' from the base url
    shift @{$c-&gt;req-&gt;url-&gt;base-&gt;path-&gt;trailing_slash(1)};

    # remove the '/mojo' from the main url
    shift @{$c-&gt;req-&gt;url-&gt;path-&gt;leading_slash(0)};
});

A live test

Just to make sure this is working let's add a few routes that will (a) link to each other via route names (b) change content randomly each page load

#!/usr/bin/perl

use strict;
use warnings;

use AWS::Lambda::Quick (
&nbsp;&nbsp;&nbsp;&nbsp;name        =&gt; 'mojo',
&nbsp;&nbsp;&nbsp;&nbsp;extra_files =&gt; [ 'extra' ],
&nbsp;&nbsp;&nbsp;&nbsp;timeout     =&gt; 10,
);

use lib &quot;$ENV{'LAMBDA_TASK_ROOT'}/extra/lib/perl5&quot;;

use AWS::Lambda::PSGI;
use Mojolicious::Lite;

my $psgi_app = app-&gt;start('psgi');
sub handler { return AWS::Lambda::PSGI-&gt;wrap( $psgi_app )-&gt;( @_ ); }

app-&gt;hook(before_dispatch =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $c = shift;
&nbsp;&nbsp;&nbsp;&nbsp;shift @{$c-&gt;req-&gt;url-&gt;base-&gt;path-&gt;trailing_slash(1)};
&nbsp;&nbsp;&nbsp;&nbsp;shift @{$c-&gt;req-&gt;url-&gt;path-&gt;leading_slash(0)};
});

#   path         template    route name
get '/'       =&gt; 'index'  =&gt; 'main-page';
get '/random' =&gt; 'random' =&gt; 'merry-christmas-page';

1;

__DATA__

@@ index.html.ep

&lt;html&gt;
&lt;body&gt;
&lt;p&gt;Hello, World&lt;/p&gt;
&lt;p&gt;&lt;%= link_to 'Say Merry Christmas' =&gt; 'merry-christmas-page' %&gt;&lt;/p&gt;
&lt;/body&gt;
&lt;/html&gt;

@@ random.html.ep

&lt;html&gt;
&lt;body&gt;
% my @options = (
%     &quot;Merry Christmas&quot;,
%     &quot;Happy Holidays&quot;,
%     &quot;Bon Noel&quot;,
%     &quot;Feliz Navidad&quot;,
% );
%= $options[ rand @options ];   # render a random @option
&lt;/body&gt;
&lt;/html&gt;

Once we've uploaded that we can finally test it in the browser

Paws to Plan What Todo

2019-12-16T00:00:00Z

Christmas is a busy time of the year. So much to do! And who can keep track of it all?

Why, I can, with the help of OmniGroup's OmniFocus app. It's an excellent all singing-all dancing GTD machine. Fully scriptable (both on macOS and iOS) and with Focus views allowing you to filter your tasks by context, tag, or any other dimension, it really is a programmer's todo list app.

However, the one feature that OmniFocus is missing is a way to add things to its inbox of new tasks via a REST interface. Sure, you can email things to a private email address on the OmniGroup servers so next time OmniFocus syncs it'll import them into its encrypted database, but email sucks as an import mechanism. SMTP is a fiddly little protocol, requiring non-core libraries, authentication, and considerable thought into avoiding anti-spam technologies. A HTTP endpoint can be accessed from anywhere - from Perl, from curl, or even from JavaScript in a browser bookmarklet.

What I need is some way to bridge between an HTTP request to sending an email into my todo list.

After reading yesterday's Perl Advent Calendar we know we can use AWS::Lambda::Quick to very quickly throw together a web accessible HTTP API. Maybe we can use something like that here?

Permissions

In order to send email our Lambda services is going to have do more than just do some calculations and spit out a web page. Amazon offer an extensive range of web services APIs that allow Lambda to do anything from simply persisting data to a database to using Hyperledger Frabric for Blockchain shenanigans. Sometimes it seems like they've got an API for everything and the kitchen sink (actually they really do).

In order to send mail from our Lambda function we're going to need tp make use of Amazon Web Services's Simple Email Services (AWS SES.) But, before we can make use of that we're going to have to grant our Lambda function permission to actually call it!

As part of the setup that AWS::Lambda::Quick does, it creates a new AWS IAM Role that gives it permission to do things. This role, called perl-aws-lambda-quick, is initially configured to attach the AWSLambdaRole and CloudWatchLogsFullAccess policies so the Lambda function can be executed and so logs can be written. It's through modifying this role we're going to get SES access.

First we write a new policy document that describes access to SES. In a production environment we'd probably want to limit the addresses that people can send emails from or to, but for our purposes today a broad policy that grants ses:SendEmail and ses:SendRawEmail for anywhere is fine.

{
&nbsp;&nbsp;&nbsp;&nbsp;&quot;Version&quot;: &quot;2012-10-17&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&quot;Statement&quot;: [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;Action&quot;: [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;ses:SendEmail&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;ses:SendRawEmail&quot;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;Resource&quot;: &quot;*&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;Effect&quot;: &quot;Allow&quot;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;]
}

Then we can use the aws command line interface to create a new policy from that document (which we've saved in /tmp/allow-all-ses.json)

    shell$ aws iam create-policy \
             --policy-name allow-all-ses \
             --policy-document file:///tmp/allow-all-ses.json

That command returns a bunch of data:

{
&nbsp;&nbsp;&nbsp;&nbsp;&quot;Policy&quot;: {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;PolicyName&quot;: &quot;allow-all-ses&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;PermissionsBoundaryUsageCount&quot;: 0,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;CreateDate&quot;: &quot;2019-12-15T22:56:49Z&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;AttachmentCount&quot;: 0,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;IsAttachable&quot;: true,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;PolicyId&quot;: &quot;ANPA25GBIG3Z2LOSXPAAH&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;DefaultVersionId&quot;: &quot;v1&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;Path&quot;: &quot;/&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;Arn&quot;: &quot;arn:aws:iam::749877081843:policy/allow-all-ses&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;UpdateDate&quot;: &quot;2019-12-15T22:56:49Z&quot;
&nbsp;&nbsp;&nbsp;&nbsp;}
}

Most important in there is the ARN of the newly created policy. We can now attach that to our existing role.

    shell$ aws iam attach-role-policy \
             --policy-arn arn:aws:iam::749877081843:policy/allow-all-ses \
             --role-name perl-aws-lambda-quick

Hooray! Our Lambda functions now has permission to send email in general. However, we can't still can't send any old email just yet - because we haven't verified our email addresses.

You have to prove to Amazon that you own any email address you're sending email from. This process is as simple as using the CLI to get Amazon to send you an email with a link you can click on:

    shell$ aws ses verify-email-identity --email-address mark@twoshortplanks.com

You'll also need to move SES out of sandbox mode if you don't want to have to verify email addresses you send to as well. This is a complicated process where you have to explain what I'm doing sending email to real humans. For now, I can just verify my destination address too so I'll be able to send to that address without further ado:

    shell$ aws ses verify-email-identity --email-address sent-to-of@twoshortplanks.com

Writing The Perl Code

In order to call the AWS API we're going to need to make use of Paws (the hilariously named Perl AWS interface.) Paws is an interface to all of AWS's current APIs - but for today we're just going to be making use of the Paws::SES::SendEmail workflow.

In order to use Paws we need to install the modules somewhere where our Lambda script can make use of them. One option is to use the extra_files option to AWS::Lambda::Quick to bundle up all the files along with our source code.

A simpler option is to make use of Lambda layers. These are common reusable zipfiles that layer their contents on top of the Lambda filesystem.

use AWS::Lambda::Quick (
&nbsp;&nbsp;&nbsp;&nbsp;name =&gt; 'send-to-omnifocus',
&nbsp;&nbsp;&nbsp;&nbsp;extra_layers =&gt; [ $layer_arn ],
&nbsp;&nbsp;&nbsp;&nbsp;timeout =&gt; 10,
);

(We've also bumped out the timeout now to ten seconds to give our function more time to do stuff.)

One of the best things about layers is that they can be shared between accounts. In fact, all AWS::Lambda::Quick always uses the standard Perl Lambda prebuilt layer to provide the AWS::Lambda code that drives the handler. Here we're just adding a second shared layer ontop of that (AWS Lambda currently allows you to have up to five layers and your per-function source code.)

Since we want to use Paws we don't even have to build our own layer - we can use one of the standard ones. Instead of passing in the ARN, we can just pass in the AWS::Lambda::Quick identifier for a layer it knows about and it'll use the ARN for the layer in your region.

use AWS::Lambda::Quick (
&nbsp;&nbsp;&nbsp;&nbsp;name =&gt; 'send-to-omnifocus',
&nbsp;&nbsp;&nbsp;&nbsp;extra_layers =&gt; [ 'paws' ],
&nbsp;&nbsp;&nbsp;&nbsp;timeout =&gt; 10,
);

Finally, we can get to writing the actual meat of the function:

#!/usr/bin/perl

use strict;
use warnings;

use AWS::Lambda::Quick (
&nbsp;&nbsp;&nbsp;&nbsp;name =&gt; 'send-to-omnifocus',
&nbsp;&nbsp;&nbsp;&nbsp;extra_layers =&gt; [ 'paws' ],
&nbsp;&nbsp;&nbsp;&nbsp;timeout =&gt; 10,
);

use JSON::PP qw( encode_json );
use Paws;

# this is my own personal address that forwards to my top secret
# OmniGroup maildrop address.
my $EMAIL_ADDRESS = 'send-to-omnifocus@twoshortplanks.com';

sub handler {
&nbsp;&nbsp;&nbsp;&nbsp;my $args = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $param = $args-&gt;{queryStringParameters};

&nbsp;&nbsp;&nbsp;&nbsp;my $text = $param-&gt;{text} or return _error(400, &quot;Missing text&quot;);
&nbsp;&nbsp;&nbsp;&nbsp;my $note = $args-&gt;{note} // q{};

    # get access to AWS's Simple Email Service
    my $ses = Paws-&gt;service(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'SES',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;region =&gt; 'us-east-1',
&nbsp;&nbsp;&nbsp;&nbsp;);

    # and use it to send an email
    $ses-&gt;SendEmail(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Destination =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;ToAddresses =&gt; [ $EMAIL_ADDRESS ],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Message =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Subject =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Charset =&gt; 'UTF-8',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Data    =&gt; $text,        # todo text goes in the subject
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Body =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Text =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Charset =&gt; 'UTF-8',  # todo details go in the body
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Data    =&gt; $note,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Source =&gt; 'mark@twoshortplanks.com',
&nbsp;&nbsp;&nbsp;&nbsp;);

&nbsp;&nbsp;&nbsp;&nbsp;return {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;statusCode =&gt; 200,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;headers =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'Content-Type' =&gt; 'application/json',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;body =&gt; '{&quot;ok&quot;:true}',
&nbsp;&nbsp;&nbsp;&nbsp;};
}

sub _error {
&nbsp;&nbsp;&nbsp;&nbsp;my $status  = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $message = shift;
&nbsp;&nbsp;&nbsp;&nbsp;return {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;statusCode =&gt; $status,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;headers =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'Content-Type' =&gt; 'application/json',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;body =&gt; encode_json({
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;ok =&gt; JSON::PP::false,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;error =&gt; $message,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}),
&nbsp;&nbsp;&nbsp;&nbsp;}
}

1;

And now we can execute it

    shell$ perl send-to-omnifocus.pl
    https://52p3rf890b.execute-api.us-east-1.amazonaws.com/quick/send-to-omnifocus

And start adding todo entires:

    shell$ curl &#39;https://52p3rf890b.execute-api.us-east-1.amazonaws.com/quick/send-to-omnifocus?text=Write+More+Perl+Advent+Articles&#39;

Now...I just have to do those things.

Suddenly Serverless

2019-12-15T00:00:00Z

It was five minutes to midnight on Christmas Eve. And Sugarplum Snoozysnaps was going to have a heart attack.

All these months of planning. And it'd all come crashing down thirty seconds ago. Literally. They never should have made the server racks out of candy canes. Too tempting for Yukon Cornelius' sweet tooth.

Now in five minutes the elves on the shelves needed to know the exact moment to fly home so they wouldn't impact Santa coming the other way and the website that they were meant to check was down.

"In the next five minutes I've got to write a whole new web service. I've got to deploy it live. And it's got to scale up to millions of hits."

Don't Panic Sugarplum! You're the most experienced Elf that Santa has. You can find a way to do the impossible again!

AWS Lambda

AWS Lambda is one of the new breed of serverless infrastructure offerings. Serverless doesn't mean that there aren't web servers running the code behind the scenes, but rather the programmer doesn't have to worry about them - their concerns only go as far as writing individual logic that creates the pages. Someone else handles the rest.

This means that Sugarplum doesn't have to worry about setting up new hardware in the next three hundred seconds she has to spare. It even means that she doesn't have to worry about configuring a pack of virtual machines or even a bunch of Kubernetes pods. All she has to worry about is writing the function - Amazon will take care of the compute for running them and scaling what's needed so the elves on the shelves don't overload anything. The north pole will get the first million hits for free, then they'll be billed a small amount for each hit.

So, what does a Lambda function look like in Perl? Why it's nothing more than a script that contains a handler function and ends with a true value.

sub handler {
&nbsp;&nbsp;&nbsp;&nbsp;my $data = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $name = $data-&gt;{queryStringParameters}{who} // &quot;Santa&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;return {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;statusCode =&gt; 200,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;headers =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'Content-Type' =&gt; 'text/plain',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;body =&gt; &quot;Hello, $name&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;};
}

1;

Deploying with Lambda is quick - it takes just a few seconds to push up some code and enable it live. Can Sugarplum get it done in time?

Do It Quickly

Okay, first things first. Sugarplum has to install the AWS tooling on her machine. This'll take her about thirty seconds. She only has to copy and paste three lines from the AWS webpages to her command line:

    shell$ curl &quot;https://s3.amazonaws.com/aws-cli/awscli-bundle.zip&quot; -o &quot;awscli-bundle.zip&quot;
    shell$ unzip awscli-bundle.zip
    shell$ sudo ./awscli-bundle/install -i /usr/local/aws -b /usr/local/bin/aws

Luckily for Sugarplum the north pole has already set up an Amazon account for use with AWS, and has funding source associated with it (less lucky for the Wise Old Elf whose credit card is about to take a pounding in the next few minutes.)

She can spend about a minute finding the AWS credentials for her account which she can then use in conjunction with the aws configure command:

    shell$ aws configure
    AWS Access Key ID [********************]:
    AWS Secret Access Key [********************]:
    Default region name [us-east-1]:
    Default output format [None]:

She now has access to the awesome power of AWS. She's got three minutes and thirty seconds to get everything live!

The Actual Coding

Three minutes later she's got the most basic of web pages ready to go:

use lib qw( lib );
use NorthPole::ElfOnTheShelfDispatch qw( time_to_go );

my $template = &lt;&lt;'HTML';
&lt;html&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;head&gt;&lt;title&gt;Elf on the Shelf Dispatch Instructions&lt;/title&gt;&lt;/head&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;body&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;h1&gt;INSTRUCTION&lt;/h1&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;p&gt;It is absolutely imperative at this time you INSTRUCTION&lt;/p&gt;
&lt;/html&gt;
HTML

sub handler {
&nbsp;&nbsp;&nbsp;&nbsp;my $data = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $name = $data-&gt;{queryStringParameters}{name};
&nbsp;&nbsp;&nbsp;&nbsp;
&nbsp;&nbsp;&nbsp;&nbsp;my $instruction = time_to_go($name) ? 'LEAVE NOW' : 'STAY PUT';
&nbsp;&nbsp;&nbsp;&nbsp;my $html = $template;
&nbsp;&nbsp;&nbsp;&nbsp;$template =~ s/INSTRUCTION/$instruction/g;

&nbsp;&nbsp;&nbsp;&nbsp;return {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;statusCode =&gt; 200,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;headers =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'Content-Type' =&gt; 'text/html',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;body =&gt; $html
&nbsp;&nbsp;&nbsp;&nbsp;};
}

1;

Thank goodness she was able to re-use the NorthPole::ElfOnTheShelfDispatch module that used to run on those destroyed servers. Using a combination of the time of day and the elf's family name (the clan the Elf was in determined where they'd been deployed around the world) it was able to work out what the elf should do at the moment they refreshed the page.

Now all Sugarplum has to do was work out how to deploy this code to AWS. Should be straight forward, right...it's just a few API calls.

Complexity

The great thing about AWS is that it's a super powerful set of infrastructure that's capable of doing almost anything you can ask of it. The problem is, you have to work out how to ask for exactly what you want.

To configure the AWS Lambda function to respond to a HTTP URL you need to take the following steps:

Create a zip file containing all your code and supporting code.
Create (or update) an AWS Lambda function with this zip file, and configure Lambda to use the latest Perl layers to automatically bring in the necessary AWS::Lamba support code.
Define a Role with the permissions to run your code.
Create a REST API with AWS Gateway API.
Configure a resource for that REST API for this script.
Set up a method and put method response for that resource.
Manage an integration and integration response for that resource.

Nothing too complicated...I'm sure Sugarplum can get all that done in the next thirty seconds.

CPAN to the Rescue!

When you need to setup a Lambda function in a hurry there's AWS::Lambda::Quick.

All you need to do is put a single use statement at the top of your code:

use AWS::Lambda::Quick (
&nbsp;&nbsp;&nbsp;&nbsp;name =&gt; 'elf-on-the-shelf-go',
);

Or, rather, since we need to also upload the lib directory:

use AWS::Lambda::Quick (
&nbsp;&nbsp;&nbsp;&nbsp;name =&gt; 'elf-on-the-shelf-go',
&nbsp;&nbsp;&nbsp;&nbsp;extra_files =&gt; ['lib'],
);

And then run the script.

    shell$ perl elf-on-the-shelf-go.pl
    https://52p3rf890b.execute-api.us-east-1.amazonaws.com/quick/elf-on-the-shelf-go

Look, it's printed out a URL where it's already live!

AWS::Lambda::Quick has handled all the interactions with AWS for us, uploading a copy of the script (slightly modified so it no longer depends on AWS::Lambda::Quick> and configuring AWS to serve it for us on the URL it printed out. That didn't even take 30 seconds!

If we want, we can even see what it's up to:

    shell$ export AWS_LAMBDA_QUICK_DEBUG=1
    shell$ perl elf-on-the-shelf-go.pl
    updating function code
    function code updated
    updating function configuration
    searching for existing role
    found existing role
    function configuration updated
    searching for existing rest api
    found existing existing rest api
    searching of existing resource
    found exiting resource
    checking for existing method
    found existing method
    checking for existing method response
    found existing method response
    checking for existing integration
    found existing integration
    checking for existing integration response
    found existing integration response
    https://52p3rf890b.execute-api.us-east-1.amazonaws.com/quick/elf-on-the-shelf-go

All that's left for us to do is test it:

https://52p3rf890b.execute-api.us-east-1.amazonaws.com/quick/elf-on-the-shelf-go?who=Candy+Sweettooth

https://52p3rf890b.execute-api.us-east-1.amazonaws.com/quick/elf-on-the-shelf-go?who=Zippy+Flyfast

Well done Sugarplum, Christmas is once again truly saved!

Animated GIFs

2019-12-14T00:00:00Z

Ah, animated GIFs. Truly the best thing on the Internet since cat videos!

How do people make those? I've no idea how other people do it, but I make 'em with Perl.

GD can create animated GIFs piecemeal. The simple steps involved are:

Print out the result of gifanimbegin to start the gif
Create a new GD image. For each image print out the result of calling gifanimadd, making sure to pass in the previous image you output so GD only has to write out the changed pixels.
Finally print out the result of gifanimend

And that's all there really is to it.

#!/usr/bin/perl

use strict;
use warnings;

use GD::Image;

# constants
my $FONT_FACE = '/System/Library/Fonts/Supplemental/Bodoni 72 Smallcaps Book.ttf';
my $FONT_SIZE = 14;   # in pt
my $BLACK     = 0;    # color in the GIF89a color map
my $WHITE     = 100;  # color in the GIF89a color map

# write this out to a file
open my $out, &quot;&gt;:raw&quot;, &quot;/tmp/out.gif&quot;;

# load the background image
my $image = background_image();

# start an animated gif
#   first argument means to use the global GIF89a color map
#   second argument means to turn on looping
print $out $image-&gt;gifanimbegin(1,1);

# send the background as the first frame of the animated gif
print $out $image-&gt;gifanimadd;

# process each line at a time
my $prev_frame = $image;
while (&lt;DATA&gt;) {
&nbsp;&nbsp;&nbsp;&nbsp;chomp;
&nbsp;&nbsp;&nbsp;&nbsp;my @words = split /\s+/, $_;

    # for each of the words that we're going to highlight
&nbsp;&nbsp;&nbsp;&nbsp;# we need to write a new frame
    for my $word_index (0..$#words) {
        # create the GD image for that frame
        my $frame = draw_frame(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;words      =&gt; \@words,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;word_index =&gt; $word_index,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;line       =&gt; $line,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;);

        # add the frame.  Because we're enabling compression and
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# passing in the previous frame only the pixels that are
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# changed per frame are actually saved - not the entire
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# image of santa each time
        print $out $frame-&gt;gifanimadd(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;0,                 # dummy
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;0,                 # dummy,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;0,                 # dummy,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;int(240 / @words), # two and a half seconds to read a line
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;1,                 # enabling comparing to previous frame
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$prev_frame        # previous frame to compare to
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;);

        # remember this frame for the next time round
        $prev_frame = $frame;
&nbsp;&nbsp;&nbsp;&nbsp;}
}

# finally write out the end of the animated gif
print $out $image-&gt;gifanimend;

sub background_image {
&nbsp;&nbsp;&nbsp;&nbsp;return GD::Image-&gt;new(&quot;/tmp/santa.jpg&quot;);
}

sub draw_frame {
&nbsp;&nbsp;&nbsp;&nbsp;my %args = @_;
&nbsp;&nbsp;&nbsp;&nbsp;my $new_image = background_image();

&nbsp;&nbsp;&nbsp;&nbsp;my @words = @{ $args{words} };

    # &quot;draw&quot; the whole string as a class method, which doesn't
&nbsp;&nbsp;&nbsp;&nbsp;# actually draw at all, but lets us know how wide the whole
&nbsp;&nbsp;&nbsp;&nbsp;# string is so we can center it
    my $width = (GD::Image-&gt;stringFT(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$BLACK,$FONT_FACE,$FONT_SIZE,0,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;0,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;0,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;join(' ', @words),
&nbsp;&nbsp;&nbsp;&nbsp;))[4];
&nbsp;&nbsp;&nbsp;&nbsp;my $x = 250 - $width/2;

    # work out the three strings (left of / before hightlight,
&nbsp;&nbsp;&nbsp;&nbsp;# the middle / hightlight, and then right of / after highlight)
    my $left_of  = join '', map { &quot;$_ &quot; } splice @words, 0, $args{word_index};
&nbsp;&nbsp;&nbsp;&nbsp;my $middle   = shift( @words ) . ' ';
&nbsp;&nbsp;&nbsp;&nbsp;my $right_of = join ' ', @words;

    # draw each string.  stringFT returns the bounds as an array.
&nbsp;&nbsp;&nbsp;&nbsp;# Index 4 of this array is the x in the top right corner, i.e.
&nbsp;&nbsp;&nbsp;&nbsp;# what we want to assing to $x so we start drawing there again.
    $x = ($new_image-&gt;stringFT(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$BLACK, $FONT_FACE, $FONT_SIZE, 0,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$x,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;425,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$left_of,
&nbsp;&nbsp;&nbsp;&nbsp;))[4];

&nbsp;&nbsp;&nbsp;&nbsp;$x = ($new_image-&gt;stringFT(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$WHITE, $FONT_FACE, $FONT_SIZE, 0,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$x,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;425,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$middle,
&nbsp;&nbsp;&nbsp;&nbsp;))[4];

&nbsp;&nbsp;&nbsp;&nbsp;$new_image-&gt;stringFT(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$BLACK, $FONT_FACE, $FONT_SIZE, 0,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$x,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;425,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$right_of,
&nbsp;&nbsp;&nbsp;&nbsp;);

&nbsp;&nbsp;&nbsp;&nbsp;return $new_image;
}

__DATA__
Twas the night before Christmas, when all through the house
Not a creature was stirring, not even a mouse;
The stockings were hung by the chimney with care,
In hopes that St. Nicholas soon would be there;
The children were nestled all snug in their beds,
While visions of sugar-plums danced in their heads;
And mamma in her kerchief, and I in my cap,
Had just settled our brains for a long winter's nap
When out on the lawn there rose such a clatter,
I sprang from my bed to see what was the matter,
Away to the window I flew like a flash,
Tore open the shutters and threw up the sash.
The moon, on the breast of the new-fallen snow,
Gave a lustre of mid-day to objects below;
When, what to my wondering eyes should appear,
But a miniature sleigh, and eight tiny rein-deer,
With a little old driver, so lively and quick,
I knew in a moment it must be St. Nick.
More rapid than eagles his coursers they came,
And he whistled, and shouted, and called them by name;
&quot;Now, Dasher! now, Dancer! now, Prancer and Vixen!
On! Comet, on! Cupid, on! Dunder and Blitzen—
To the top of the porch, to the top of the wall!
Now, dash away, dash away, dash away all!&quot;
As dry leaves that before the wild hurricane fly,
When they meet with an obstacle, mount to the sky,
So, up to the house-top the coursers they flew,
With a sleigh full of toys—and St. Nicholas too.
And then in a twinkling I heard on the roof,
The prancing and pawing of each little hoof.
As I drew in my head, and was turning around,
Down the chimney St. Nicholas came with a bound.
He was dressed all in fur from his head to his foot,
And his clothes were all tarnished with ashes and soot;
A bundle of toys he had flung on his back,
And he looked like a peddler just opening his pack;
His eyes how they twinkled! his dimples how merry!
His cheeks were like roses, his nose like a cherry;
His droll little mouth was drawn up like a bow,
And the beard on his chin was as white as the snow;
The stump of a pipe he held tight in his teeth,
And the smoke, it encircled his head like a wreath.
He had a broad face, and a little round belly
That shook when he laughed, like a bowl full of jelly.
He was chubby and plump—a right jolly old elf;
And I laughed when I saw him in spite of myself.
A wink of his eye, and a twist of his head,
Soon gave me to know I had nothing to dread.
He spoke not a word, but went straight to his work,
And filled all the stockings; then turned with a jerk,
And laying his finger aside of his nose,
And giving a nod, up the chimney he rose.
He sprang to his sleigh, to his team gave a whistle,
And away they all flew like the down of a thistle;
But I heard him exclaim, ere he drove out of sight,
&quot;Merry Christmas to all, and to all a good night!&quot;

Maybe for my next gif I'll include the entire works of Shakespeare...

Draft Solution

2019-12-13T00:00:00Z

Productivity

Nougat Jinglebubbles was an expert in Productivity (with a capital P.) That meant that he could spend hours and hours of each day optomizing his computer setup to ensure that he'd shaved a few seconds off of his workflow rather than working on debugging the new Christmas letter OCR software like he was supposed to be doing.

Today he was looking at the latest version of Drafts Pro for his macOS laptop.

Drafts is an application that allows you to capture text on your iPhone, iPad, Apple Watch or Mac and have that content sync between the devices.

What's more, on iOS Drafts allows you to define actions to process that text, to easily ship it off to an email client, or create a calendar entry, or append it to a list in dropbox, or send it to your task management software. Or, if you were feeling really adventurous you could setup actions that executed JavaScript code to do pretty much wanted you wanted.

Tap, tap, productive! (Eventually, after many hours of debugging.)

And now with this week's new release enabling feature parity with the iOS releases, you can even set up processing actions on your Mac. And of course running on the Mac without the restrictions of iOS you'll be able to do whatever you want - run Perl scripts, process files on the local file system, everything!

Oh No. No, wait you can't.

The problem is that JavaScript still runs inside the same type of sandbox on macOS. There is no way to shell out to Perl and get some real programming done.

Or is there?

And now for something somewhat unrelated.

Wouldn't it be nice to have a web server always running on your Mac. We could quickly visit a local web page and get some graphs on disk usage, or visit a page that used AppleScript to pull out info from our calendar, or scraped some news from the web to show us or...the list goes on.

The trouble is that our local laptops only have so much memory. And if we run twenty or so web servers all the time, sitting idle waiting for requests, that memory quickly runs out.

Worse, if we've got twenty web servers running we have to find some way to manage all of that. To restart them all when we make code changes. To ensure that they're running all the time. That sounds like a real pain in the jingle bells.

A different kind of serverless

How can we run a web server on our local machine without running a web server? What we need is a super-server - a server that can listen on any port we'd like to pretend there's a web server running and fire up some program on demand whenever someone connects to it.

On Linux that kind of functionality it provided by inetd (or xinetd or any of the other itterations.) On macOS that functionality is just one of the things the all powerful launchd daemon can do.

launchd is enterprise level software - you can tell by the way you have to configure it using XML. Here's an example plist file:

&lt;?xml version=&quot;1.0&quot; encoding=&quot;UTF-8&quot;?&gt;
&lt;!DOCTYPE plist PUBLIC &quot;-//Apple//DTD PLIST 1.0//EN&quot; &quot;http://www.apple.com/DTDs/PropertyList-1.0.dtd&quot;&gt;
&lt;plist version=&quot;1.0&quot;&gt;
&lt;dict&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;key&gt;Label&lt;/key&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;string&gt;org.perladvent.example&lt;/string&gt;

&nbsp;&nbsp;&nbsp;&nbsp;&lt;!-- this is the program we want to run.  We can't specify
        a script here with a shebang line, it has to be an
        actual executable, so we specify our perl and pass
        the name of the script as an argument --&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;key&gt;ProgramArguments&lt;/key&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;array&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;string&gt;/usr/bin/perl&lt;/string&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;string&gt;/Users/Nougat/servers/example.pl&lt;/string&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;/array&gt;

&nbsp;&nbsp;&nbsp;&nbsp;&lt;!-- we don't want to be loaded right away, we want to loaded
        on demand when someone tries to connect to the port --&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;key&gt;OnDemand&lt;/key&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;true/&gt;

&nbsp;&nbsp;&nbsp;&nbsp;&lt;!-- here's where we're listening - on port 54321 --&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;key&gt;Sockets&lt;/key&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;dict&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;key&gt;Listeners&lt;/key&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;array&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;dict&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;key&gt;SockFamily&lt;/key&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;string&gt;IPv4&lt;/string&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;key&gt;SockServiceName&lt;/key&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;string&gt;54321&lt;/string&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;/dict&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;/array&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;/dict&gt;

&nbsp;&nbsp;&nbsp;&nbsp;&lt;!-- finally we want to configure launchd to emulate
         inetd in 'nowait' mode.  This'll mean that launchd
         will handle all the port stuff for us.  It'll
         execute our program when someone connects and pass data
         sent to the port to the program via STDIN and anything
         output to STDOUT will be sent back across the port --&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;key&gt;inetdCompatibility&lt;/key&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;dict&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;key&gt;Wait&lt;/key&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;false/&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;/dict&gt;
&lt;/dict&gt;
&lt;/plist&gt;

As we want the code to run as the user we're logged in as we need to create this file inside ~/Library/LaunchAgents. It should be named org.perladvent.example.plist, as that's what corresponds to the label key in the plist.

Once the file has been created we need to tell launchd to load it

   $ launchctl load ~/Library/LaunchAgents/org.perladvent.example.plist

No output from this command is good news!

Writing the 'server' script

We now need to write a program that takes input on STDIN and produces output on STDOUT. Easy, right?

#!/usr/bin/perl

use 5.024;
use warnings;

# disable STDOUT buffering
$| = 1;

use Chatbot::Eliza;
my $bot = Chatbot::Eliza-&gt;new;

while (&lt;STDIN&gt;) {
&nbsp;&nbsp;&nbsp;&nbsp;say '-- ',$bot-&gt;transform( $_ );
}

We can now connect to our server with telnet and talk to the bot over the local loopback interface:

    $ telnet 127.0.0.1 54321
    Trying 127.0.0.1...
    Connected to localhost.
    Escape character is &#39;^]&#39;.
    Hello
    -- Hi. What seems to be your problem?
    I&#39;ve run out of tape to wrap the presents
    -- That&#39;s quite interesting.
    Santa will be mad.
    -- Does talking about this bother you?
    A little.
    -- I&#39;m not sure I understand you fully.
    No-one does.
    -- Why &#39;no&#39;?
    Everything is no!
    -- Are you saying no just to be negative?
    ^]
    telnet&gt; quit
    Connection closed.

Okay, so we can write a simple 'server' that sends data back and forth. How about handling web pages?

PSGI

The PSGI standard is a simple protocol that allows web servers and web frameworks to have a common standard to communicate with each other. In theory any framework that is PSGI compatible can be used with any PSGI compatible webserver and vice versa.

Here's what the world's simplest PSGI compatible web app looks like:

my $psgi = sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $env = shift;
&nbsp;&nbsp;&nbsp;&nbsp;return [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'200',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ 'Content-Type' =&gt; 'text/plain' ],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ &quot;Hello person using $env-&gt;{HTTP_USER_AGENT}&quot; ],
&nbsp;&nbsp;&nbsp;&nbsp;];
};

Like all PSGI apps it's just a subroutine that takes a hash reference and returns a bunch of array refs. Nothing more complicated than that.

What we're going to do is write a shim so that when launchd executes our script it'll be able to use this - or any other PSGI compatible app - to generate the output.

# Process via PSGI.  

use HTTP::Request;
use HTTP::Response;
use HTTP::Message::PSGI;

# Only bother gathering the headers, ignore the body of the request
my $input = &quot;&quot;;
while (&lt;STDIN&gt;) {
&nbsp;&nbsp;&nbsp;&nbsp;last if /^\r\n$/;
&nbsp;&nbsp;&nbsp;&nbsp;$input .= $_;
}

print 'HTTP/1.1 ' . HTTP::Response-&gt;from_psgi(
&nbsp;&nbsp;&nbsp;&nbsp;$psgi-&gt;( HTTP::Request-&gt;parse( $input )-&gt;to_psgi )
)-&gt;as_string;

Wow, that was pretty straight forward. Does it work?

    $ curl -v 127.0.0.1:54321
    *   Trying 127.0.0.1...
    * TCP_NODELAY set
    * Connected to 127.0.0.1 (127.0.0.1) port 54321 (#0)
    &gt; GET / HTTP/1.1
    &gt; Host: 127.0.0.1:54321
    &gt; User-Agent: curl/7.64.1
    &gt; Accept: */*
    &gt;
    &lt; HTTP/1.1 200 OK
    &lt; Content-Type: text/plain
    * no chunk, no close, no size. Assume close to signal end
    &lt;
    Hello person using curl/7.64.1
    * Closing connection 0

Awesome

Using a more advanced framework

Okay, so now we can plug in any framework we want, like Mojolicious:

#!/usr/bin/perl

use Mojolicious::Lite;
use HTTP::Request;
use HTTP::Response;
use HTTP::Message::PSGI;

get '/' =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $c = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $input = $c-&gt;param('text');

&nbsp;&nbsp;&nbsp;&nbsp;my $output = reverse $input;

&nbsp;&nbsp;&nbsp;&nbsp;$c-&gt;render( text =&gt; $output );
}

# create a PSGI app from the Mojolicious app
app-&gt;log-&gt;level('error');
my $psgi = app-&gt;start('psgi');

# Process via PSGI.  Only bother with GET requests
my $input = &quot;&quot;;
while (&lt;STDIN&gt;) { last if /^\r\n$/; $input .= $_ }
print 'HTTP/1.1 ' . HTTP::Response-&gt;from_psgi(
&nbsp;&nbsp;&nbsp;&nbsp;$psgi-&gt;( HTTP::Request-&gt;parse( $input )-&gt;to_psgi )
)-&gt;as_string;

So there's a really simple example of a server that can manipulate any text that's passed into it.

    $ curl 127.0.0.1:54321?text=Example
    elpmaxE

I wonder if Nougat would find this helpful?

Back to the Draft

One of the things that Drafts can from within JavaScript is make HTTP requests. Including, say, to a server we have running on demand on localhost.

var response = HTTP.create().request({
&nbsp;&nbsp;&nbsp;&nbsp;&quot;url&quot;: &quot;http://127.0.0.1:54321&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&quot;method&quot;: &quot;GET&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&quot;parameters&quot;: { &quot;text&quot; : draft.content }
})
draft.content = response.responseText

So Nougat needs to take the following steps:

Configure a Launchd plist to run a Perl script whenever something connects to a port on localhost
Load the plist. This only needs to be done once - it'll happen automatically on restart
Write a script that speaks PSGI at that location. If you use Mojolicious or another framework you can have it do different things on different paths!
Configure an action in Drafts that uses a JavaScript step to call this URL

And with that, he can execute Perl actions to his heart's content!

(Maybe he should get back to work though!)

Now With Added Interactivity

2019-12-12T00:00:00Z

Yesterday the Wise Old Elf was showing a hacky way to quickly throw together a GUI with a touch of HTML, JavaScript and a smattering of Perl code. It was really quick to create a GUI using that - but is there an even quicker, and easier, way?

Introducing GUIDeFATE

GUIDeFATE is a Perl GUI 'framework' (and I use that word in the loosest possible sense) that's primary goal is to allow you to quickly throw together a user interface in the least possible time. You sacrifice the precise control that you might have with a traditional framework in order to get something working in minutes.

Let's rewrite the first dialog example from yesterday. First, as always, we show the finished result: Running

    $ ./guidefate-dialog.pl

Pops up a native looking dialog box:

Pressing the OK button closes the window and prints our familiar greeting:

    $ ./guidefate-dialog.pl
    Merry Christmas, Wise Old Elf

I bet that was complicated to code, right? Nope, couldn't be easier - we didn't even have to really code the GUI bit at all:

    #!/usr/bin/perl

    use 5.024;
    use warnings;

    use GUIDeFATE;

    my $gui = GUIDeFATE-&gt;new(&lt;&lt;&#39;DIALOG&#39;);
    +---------------------------------------+
    |T Merry Christmas Wisher               |
    +M--------------------------------------+
    |  Who?                                 |
    |  [                                  ] |
    |  {   OK   }{ Cancel }                 |
    +---------------------------------------+
    DIALOG

    my $frame = $gui-&gt;getFrame;

    # ok
    sub btn2 {
        my $who = $frame-&gt;getValue(&#39;textctrl1&#39;);
        say &quot;Merry Christmas, $who&quot;;
        $frame-&gt;quit
    }

    # cancel
    sub btn3 { $frame-&gt;quit }

    $gui-&gt;MainLoop;

Rather than specifying the controls with some sort of abstract windowing toolkit, or laying them out with HTML and CSS as happened yesterday, GUIDeFATE takes a different approach: You simply draw out the user interface using ASCII-art. This doesn't give the same level of control that you might normally want from your GUI toolkit, but what it does allow you to do is quickly create an interface in seconds.

There's also no explicit mapping of controls to Perl. Controls are named after the type of thing they are. The first control is called 'textctrl1' because it's a text control and the first control. The second control, a button, is 'btn2', the third is 'btn3'. Pressing buttons call the subroutines named after the control. It's all very simple - but you don't have to even work that out. The quickest way to work out what a button is called is just to press it and read the error message.

    $ ./guidefate-dialog.pl
    Undefined subroutine &amp;main::btn3 called at ./guidefate-dialog.pl line 35.

The quickest way to work out what the name of a text field is is to just print out the contents of all the text fields and take it from there:

sub show_all_values {
&nbsp;&nbsp;&nbsp;&nbsp;for (keys %{ $frame }) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $control = $frame-&gt;{$_};
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;say &quot;$_: &quot;.$control-&gt;GetValue
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if $control &amp;&amp; $control-&gt;can('GetValue');
&nbsp;&nbsp;&nbsp;&nbsp;}
}

But I liked the Browser!

In the above example GUIDeFATE was using the cross platform Wx graphics toolkit library. This means that the same code should run Linux, macOS, and even Windows. But Wx can be a little tricky to install if you don't have precompiled binaries to hand (I've been doing Perl for over twenty five years and it took me a few hours to wrestle it into submission using the latest versions of Perl and macOS.) The browser based solution we had yesterday didn't have that same level of complex dependencies.

Luckily, GUIDeFATE isn't tied to any one underlying toolkit. It actually support seven different backends - Wx, Tk, Gtk, Qt, Win32, HTML and Websocket. Switching to 'Tk' is as simple as passing an extra argument to the constructor

my $gui = GUIDeFATE-&gt;new(&lt;&lt;'DIALOG', 'tk');
...DIALOG

Or even ask it to just render in the browser:

my $gui = GUIDeFATE-&gt;new(&lt;&lt;'DIALOG', 'web' );
...DIALOG

Like so:

Clicking OK prints out the message as before - no further code changes were necessary.

A More Complex Example

For good measure here's a straight port of the code I wrote yesterday for editing notes.

#!/usr/bin/perl

use 5.024;
use warnings;

use GUIDeFATE;
use Path::Tiny    qw( path );
use List::UtilsBy qw( min_by );
use File::Copy    qw( move );

my $gui = GUIDeFATE-&gt;new(&lt;&lt;'DIALOG' );
+---------------------------------------+
|T Note Processor                       |
+M--------------------------------------+
|[                                     ]|
|+T------------------------------------+|
||                                     ||
||                                     ||
||                                     ||
||                                     ||
||                                     ||
||                                     ||
||                                     ||
||                                     ||
|+-------------------------------------+|
|{ Archive }                    { Save }|
+---------------------------------------+
DIALOG
my $frame = $gui-&gt;getFrame;

# where the files are kept
my $notes_dir   = path($ENV{HOME}, 'notes');
my $archive_dir = path($ENV{HOME}, '.archived-notes');

# this is the current file we're working on
my $file;

sub next_note () {
    # find the oldest file to work on 
    $file = min_by { $_-&gt;stat-&gt;mtime } $notes_dir-&gt;children;

    # update the form in the browser
&nbsp;&nbsp;&nbsp;&nbsp;# title is the filename (without dir nor extension)
    $frame-&gt;setValue('textctrl0', $file-&gt;basename(qr/.txt/));
&nbsp;&nbsp;&nbsp;&nbsp;$frame-&gt;setValue('TextCtrl2', $file-&gt;slurp_utf8 );
}

# archive clicked
sub btn3 {
&nbsp;&nbsp;&nbsp;&nbsp;move($file, &quot;$ENV{HOME}/.notes-archive&quot;);
&nbsp;&nbsp;&nbsp;&nbsp;next_note();
};

# save clicked
sub btn4 {
&nbsp;&nbsp;&nbsp;&nbsp;my $title    = $frame-&gt;getValue('textctrl0');
&nbsp;&nbsp;&nbsp;&nbsp;my $contents = $frame-&gt;getValue('TextCtrl2'); 

    # write the note out, possibly in a new location
    path( $notes_dir, $title . '.txt')-&gt;spew_utf8( $contents );

    # if we renamed the note delete the old note
    if ($title ne $file-&gt;basename(qr/.txt/)) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;unlink $file;
&nbsp;&nbsp;&nbsp;&nbsp;}

&nbsp;&nbsp;&nbsp;&nbsp;next_note();
}

next_note();
$gui-&gt;MainLoop;

While not as colorful as the HTML version, it presents a simple functional interface:

We can easily flesh this out just a little more. For example, we can add confirmation for archiving:

# archive clicked
sub btn3 {
&nbsp;&nbsp;&nbsp;&nbsp;if ($frame-&gt;showDialog(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;Sure?&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;Are you sure you want to archive?&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;OKC&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;!&quot;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;)
&nbsp;&nbsp;&nbsp;&nbsp;){
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;move($file, &quot;$ENV{HOME}/.notes-archive&quot;);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;next_note();
&nbsp;&nbsp;&nbsp;&nbsp;}
};

GUIDeFATE has a bunch of handy things to make quick output really simple - file dialogs, menus, and a collection of other widgets that I haven't shown here. I encourage you to have a play with it - it'll only take a minute or two to write your first app!

Now With Added Interactivity

2019-12-11T00:00:00Z

The Wise Old Elf had locked himself in his office for several days. The other elves were starting to get worried.

It had all started after helping Buster Stripytights with a command line script that launched a browser based web app. Then one of the elves had heard him muttering about something that Fir Cidergift had been working on to use Mojo::AsyncAwait to handle awating like JavaScript does. Apparently something about these two ideas had inspired the elf into a deep coding session.

The furious typing noises emanating from behind the door stopped. Suddenly The Wise Old Elf burst out of his office waving his arms.

"Eureka! Eureka!" he shouted (which as we all know is elf for "this bath water is too hot") "Just take a look at this".

Crowding around the elves watched the Wise Old Elf type at the terminal:

   $ ./merry.pl

No sooner had he hit return then a browser window popped up on the screen showing a dialog.

The wise old elf pressed a "OK" and back at the terminal the Perl script printed out the text from the text field.

    $ ./merry.pl
    Merry Christmas, Wise Old Elf

"That's not the impressive bit", the Wise Old Elf explained. "The impressive bit is how I got it to do that". He opened the his editor and brought up the source code.

#!/user/bin/perl

use QuickBrowserGUI;
use Mojo::AsyncAwait;

callback 'ok_clicked' =&gt; async sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $name = await call_javascript('getFormTextFieldValue');
&nbsp;&nbsp;&nbsp;&nbsp;print &quot;Merry Christmas, $name\n&quot;;

&nbsp;&nbsp;&nbsp;&nbsp;await call_javascript('close');
};

callback 'cancel_clicked' =&gt; async sub {
&nbsp;&nbsp;&nbsp;&nbsp;await call_javascript('close');
};

start();

__DATA__

@@ content.html.ep

&lt;h1&gt;Who?&lt;/h1&gt;

&lt;div class=&quot;form-group&quot;&gt;
&lt;input  id='string' class=&quot;form-control&quot; value=&quot;Santa&quot;&gt;
&lt;/div&gt;

&lt;div class=&quot;form-group&quot;&gt;
&lt;button id='ok'     class=&quot;btn btn-primary clickable&quot;&gt;OK&lt;/button&gt;
&lt;button id='cancel' class=&quot;btn btn-danger  clickable&quot;&gt;Cancel&lt;/button&gt;
&lt;/div&gt;

&lt;script&gt;
function getFormTextFieldValue() {
&nbsp;&nbsp;&nbsp;&nbsp;return $('#string').val();
}
&lt;/script&gt;

Perl code is being triggered from JavaScript (in this case automatically when the buttons are pressed) and we can also see the Perl code calling JavaScript code and asynchronously awaiting for the return value to be returned to it.

Under the Hood

Under the hood the Wise Old Elf had tied Perl and JavaScript together with a websocket. He'd dressed the whole thing up with a wrapper of Bootstrap to make it pretty. And he'd taken advantage of the promises and await syntax to produce code that had virtually hidden the complexity of having to await for Perl and JavaScript to talk over a socket.

package QuickBrowserGUI;

# Switch back to modifying the main package directly
# This is normally a really bad idea, but considering how this is
# meant to be used in one-off scripts and how much we'd have to
# export (everything) this is actually the cleanest way to do it.
package main;

use Mojolicious::Lite;

use Browser::Open qw( open_browser );
use Mojo::JSON qw( encode_json decode_json );
use Net::EmptyPort qw( empty_port );

my $port = empty_port();

# these are the only two HTTP routes.  All other communication occurs
# via the websocket
get '/' =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $c = shift;

&nbsp;&nbsp;&nbsp;&nbsp;$c-&gt;render(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'index',

        # The address of the websocket we're going to connect on.
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# Use &quot;encode_json&quot; out of habit (any data you need to render
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# in a JavaScript should be encoded to JSON with a &lt;script&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# safe JSON encoding library like Mojo::JSON)
        websocket_address =&gt; encode_json(&quot;ws://127.0.0.1:$port/perl&quot;),
&nbsp;&nbsp;&nbsp;&nbsp;);
};
post '/exit' =&gt; sub { exit };

# global state

# named code that will be executed whenever called from JavaScript
# via the websocket.  Can be declared as 'callback foo =&gt; sub { ... };'
my %callbacks;
sub callback ($$) {
&nbsp;&nbsp;&nbsp;&nbsp;my $name = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $callback = shift;
&nbsp;&nbsp;&nbsp;&nbsp;$callbacks{ $name } = $callback;
}

# on ready handlers that are called (in order) when the JavaScript
# document is ready and the websocket has been connected.  Can
# be declared as 'on_ready sub { ... };'
my @on_ready;
sub on_ready(&amp;) {
&nbsp;&nbsp;&nbsp;&nbsp;push @on_ready, shift;
}

# Whenever we call JavaScript from Perl we store a promise here
# which will be resolved once the JavaScript sends the results back
# down the websocket to Perl
my %websocket_resolvable_promises;

# this websocket is the guts of the communication between the
# browser and the perl code
my $websocket_tx;
websocket '/perl' =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;

    # $websocket_tx is the transaction we can use to send data to the
&nbsp;&nbsp;&nbsp;&nbsp;# websocket.  Normally when writing a webserver we'd have
&nbsp;&nbsp;&nbsp;&nbsp;# to worry about one of these per websocket connection, but
&nbsp;&nbsp;&nbsp;&nbsp;# as we control both the server and client here we know for
&nbsp;&nbsp;&nbsp;&nbsp;# sure there's only ever one websocket connection
    $websocket_tx = $self-&gt;tx;

&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;on( message =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my (undef, $message) = @_;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $data = decode_json($message);

        # TYPE 'ready'
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# the JS is sending a ready message meaning that we need
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# to call all of the on_ready handlers in @on_ready
        if ($data-&gt;{type} eq 'ready') {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$_-&gt;() for @on_ready;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}

        # TYPE 'callback'
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# the JS is sending a callback message (either directly because
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# someone executed 'perlCallback(&quot;name&quot;, arg, arg..)' or implicitly
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# because someone clicked on a '.clickable' button.  Note
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# that these callbacks cannot return anything to JavaScript.
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# They're called in a blocking fashion so they should not block,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# but obviously they can await with async/await as normal and
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# call JavaScript functions via 'call_javascript' to pass
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# control back to the JS code.
        if ($data-&gt;{type} eq 'callback') {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $name = $data-&gt;{payload}{name};
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $args = $data-&gt;{oayload}{args};

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $cb = $callbacks{ $name } or return;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$cb-&gt;(@{ $args });
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}

        # type 'response'
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# the JS is sending the result of a call from Perl to JS
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# this includes the id of the promise that must be resolved
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# with whatever the JavaScript function returned
        if ($data-&gt;{type} eq 'response') {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $id = $data-&gt;{id};
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $promise_to_resolve = $websocket_resolvable_promises{ $id }
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;or return;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$promise_to_resolve-&gt;resolve( $data-&gt;{payload} );
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;});
};

# this code calls the JavaScript routine on the client in an
# async manner via the websocket, serializing and deserializing the
# data you pass via JSON.
sub call_javascript ($@) {
&nbsp;&nbsp;&nbsp;&nbsp;my $name = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my @args = @_;

    # each call needs a unique id
    state $id = 0;
&nbsp;&nbsp;&nbsp;&nbsp;$id++;

    # send the request to call the JavaScript over the websocket
    $websocket_tx-&gt;send({
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;json =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;type =&gt; 'call',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;id =&gt; $id,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;payload =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;name =&gt; $name,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;args =&gt; \@args,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;});

    # create a promise that our websocket handler will resolve when
&nbsp;&nbsp;&nbsp;&nbsp;# it gets the result from JavaScript back over the websocket
    my $promise = Mojo::Promise-&gt;new();
&nbsp;&nbsp;&nbsp;&nbsp;$websocket_resolvable_promises{ $id } = $promise;
&nbsp;&nbsp;&nbsp;&nbsp;return $promise;
};

# starting up the webserver on the correct port, opening the browser
# and suppressing logs.  This is the same as described in
# http://perladvent.org/2019/2019-12-09.html
app-&gt;log-&gt;level('warn');
my $base_url = &quot;http://127.0.0.1:$port&quot;;
app-&gt;hook(before_server_start =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $server = shift;
&nbsp;&nbsp;&nbsp;&nbsp;$server-&gt;silent(1);
&nbsp;&nbsp;&nbsp;&nbsp;open_browser($base_url);
});
sub start { app-&gt;start('daemon','--listen', $base_url ); }

# also include these templates plus whatever is in the main script
BEGIN { push @{ app-&gt;renderer-&gt;classes }, 'QuickBrowserGUI' };
package QuickBrowserGUI;
__DATA__

@@ index.html.ep

&lt;html&gt;

% # load jquery, bootstrap, etc.
&lt;link rel=&quot;stylesheet&quot; href=&quot;https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/css/bootstrap.min.css&quot; integrity=&quot;sha384-ggOyR0iXCbMQv3Xipma34MD+dH/1fQ784/j6cY/iJTQUOhcWr7x9JvoRxT2MZw1T&quot; crossorigin=&quot;anonymous&quot;&gt;
&lt;script src=&quot;https://code.jquery.com/jquery-3.2.1.slim.min.js&quot; integrity=&quot;sha384-KJ3o2DKtIkvYIK3UENzmM7KCkRr/rE9/Qpg6aAZGJwFDMVNA/GpGFF93hXpG5KkN&quot; crossorigin=&quot;anonymous&quot;&gt;&lt;/script&gt;
&lt;script src=&quot;https://cdnjs.cloudflare.com/ajax/libs/popper.js/1.12.9/umd/popper.min.js&quot; integrity=&quot;sha384-ApNbgh9B+Y1QKtv3Rn7W3mgPxhU9K/ScQsAP7hUibX39j7fakFPskvXusvfa0b4Q&quot; crossorigin=&quot;anonymous&quot;&gt;&lt;/script&gt;
&lt;script src=&quot;https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0/js/bootstrap.min.js&quot; integrity=&quot;sha384-JZR6Spejh4U02d8jOt6vLEHfe/JQGiRRSQQxSfFWpi1MquVdAyjUar5+76PVCmYl&quot; crossorigin=&quot;anonymous&quot;&gt;&lt;/script&gt;

&lt;script&gt;
% # when the page is closed have the browser send a POST
% # to /exit to tell Mojolicious to shut down
window.addEventListener(
&nbsp;&nbsp;&nbsp;&nbsp;&quot;unload&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;() =&gt; navigator.sendBeacon(&quot;/exit&quot;),
&nbsp;&nbsp;&nbsp;&nbsp;false
)
&lt;/script&gt;

&lt;body&gt;

&lt;script&gt;
&nbsp;&nbsp;&nbsp;&nbsp;var ws = new WebSocket(&lt;%== $websocket_address %&gt;);

&nbsp;&nbsp;&nbsp;&nbsp;// handle messages from Perl
&nbsp;&nbsp;&nbsp;&nbsp;ws.onmessage = (msg) =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;var data = JSON.parse(msg.data)

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;// perl called us, call the named function and send the
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;// results back over the websocket
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if (data.type == 'call') {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;var result = window[data.payload.name](...data.payload.args)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;ws.send(JSON.stringify({
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'type'    : 'response',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'id'      : data.id,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'payload' : result
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}));
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;}

&nbsp;&nbsp;&nbsp;&nbsp;// trigger the on_ready events perl side when the connection
&nbsp;&nbsp;&nbsp;&nbsp;// has been established
&nbsp;&nbsp;&nbsp;&nbsp;ws.onopen = () =&gt; ws.send('{&quot;type&quot;:&quot;ready&quot;}')

&nbsp;&nbsp;&nbsp;&nbsp;function perlCallback(name, ...args) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;ws.send(JSON.stringify({
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'type'    : 'callback',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'payload' : {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'name' : name, 
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'args' : args
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}))
&nbsp;&nbsp;&nbsp;&nbsp;}
&lt;/script&gt;

% # include the per script html
&lt;main role=&quot;main&quot; class=&quot;container&quot;&gt;
%= include 'content'
&lt;/main&gt;

&lt;script&gt;
$(() =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;// anything 'clickable' will call the 'id_clicked' callback
&nbsp;&nbsp;&nbsp;&nbsp;// in perl space when clicked (i.e. something with the id of
&nbsp;&nbsp;&nbsp;&nbsp;// &quot;foo&quot; will call the &quot;foo_clicked&quot; callback)
&nbsp;&nbsp;&nbsp;&nbsp;$('.clickable').on('click', function () {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;var name = this.id + '_clicked'
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perlCallback(name)
&nbsp;&nbsp;&nbsp;&nbsp;})
});
&lt;/script&gt;

&lt;/body&gt;
&lt;/html&gt;

Writing Something More Powerful

I've got a directory full of plain text files containing all the notes I've been collecting for that last five years or so. By now a lot of these are out of date.

What I need to do is write a GUI application that will allow me to view one note at a time, starting with the oldest first, and let me either trash the note or modify the title and body of the note to bring it up to date.

Maybe I can use the Wise Old Elf's tool to write that? What we want is something that looks like this:

Finding the oldest file in the notes directory is easy with List::UtilBy. It returns the item from the passed list for which the code in the { ... } produced the smallest value.

$file = min_by { $_-&gt;stat-&gt;mtime } $notes_dir-&gt;children;

Once we have that we can just pass the title and contents of the file through to JavaScript

my $title            = $file-&gt;basename(qr/.txt/);
my $contents_of_file = $file-&gt;slurp_utf8;
await call_javascript('updateNote', $title, $contents_of_file);

Where it can update the forms:

function updateNote(title,contents) {
&nbsp;&nbsp;&nbsp;&nbsp;$('#title').val(title);
&nbsp;&nbsp;&nbsp;&nbsp;$('#contents').val(contents);
}

And that's about it for the smarts. The rest is just simply reacting to button presses and writing out / moving the files.

Here's the full script - the entire application is no more than sixty lines of actual code.

#!/usr/bin/perl

use QuickBrowserGUI;
use Mojo::AsyncAwait;
use Path::Tiny    qw( path );
use List::UtilsBy qw( min_by );
use File::Copy    qw( move );

# where the files are kept
my $notes_dir   = path($ENV{HOME}, 'notes');
my $archive_dir = path($ENV{HOME}, '.archived-notes');

# this is the current file we're working on
my $file;

async next_note =&gt; sub () {
    # find the oldest file to work on 
    $file = min_by { $_-&gt;stat-&gt;mtime } $notes_dir-&gt;children;

    # update the form in the browser
&nbsp;&nbsp;&nbsp;&nbsp;# title is the filename (without dir nor extension)
    my $title = $file-&gt;basename(qr/.txt/);
&nbsp;&nbsp;&nbsp;&nbsp;my $contents_of_file = $file-&gt;slurp_utf8;
&nbsp;&nbsp;&nbsp;&nbsp;await call_javascript('updateNote', $title, $contents_of_file);
};

callback 'save_clicked' =&gt; async sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $new_data = await call_javascript('noteData');

    # write the note out, possibly in a new location
    path( $notes_dir, $new_data-&gt;{title} . '.txt')-&gt;spew_utf8(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$new_data-&gt;{contents},
&nbsp;&nbsp;&nbsp;&nbsp;);

    # if we renamed the note delete the old note
    if ($new_data-&gt;{title} ne $file-&gt;basename(qr/.txt/)) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;unlink $file;
&nbsp;&nbsp;&nbsp;&nbsp;}

&nbsp;&nbsp;&nbsp;&nbsp;next_note();
};

callback 'archive_clicked' =&gt; async sub {
&nbsp;&nbsp;&nbsp;&nbsp;move($file, &quot;$ENV{HOME}/.notes-archive&quot;);
&nbsp;&nbsp;&nbsp;&nbsp;next_note();
};

on_ready async sub { next_note() };
start();

__DATA__

@@ content.html.ep

&lt;h1&gt;Edit Notes&lt;/h1&gt;

&lt;div class=&quot;form-group&quot;&gt;
&lt;input id='title' class=&quot;form-control&quot;&gt;
&lt;/div&gt;

&lt;div class=&quot;form-group&quot;&gt;
&lt;textarea id='contents' class=&quot;form-control&quot;&gt;&lt;/textarea&gt;
&lt;/div&gt;

&lt;div class=&quot;form-group&quot;&gt;
&lt;button id='save'    class=&quot;btn btn-primary clickable float-right&quot;&gt;Save&lt;/button&gt;
&lt;button id='archive' class=&quot;btn btn-danger  clickable&quot;&gt;Archive&lt;/button&gt;
&lt;/div&gt;

&lt;script&gt;
function noteData() {
&nbsp;&nbsp;&nbsp;&nbsp;return {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'title'     : $('#title').val(),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'contents'  : $('#contents').val(),
&nbsp;&nbsp;&nbsp;&nbsp;}
}
function updateNote(title,contents) {
&nbsp;&nbsp;&nbsp;&nbsp;$('#title').val(title);
&nbsp;&nbsp;&nbsp;&nbsp;$('#contents').val(contents);
}
&lt;/script&gt;

Awaiting Christmas

2019-12-10T00:00:00Z

Fir Cidergift was working on a new project at the North Pole to monitor world events. If there anything - anything at all - that was going on in the world that could impact Christmas deliveries, the elves need to know about it right away.

A Blocking Solution

Fir's prototype was a simple single process web server that would go off and scrape news sites and render them on one page. The current version only scraped the top story on Slate, but it was a good start for a morning's work. Not only had Fir got the scraping working, but he'd also made a stab at a simple caching mechanism that cached the rendered output for thirty seconds to prevent the troops of elves at the North Pole from overloading their internet connection as they refeshed every few seconds.

#!/usr/bin/perl

use Mojolicious::Lite;
use 5.024;
use experimental 'signatures';

sub update_cache ($c) {
&nbsp;&nbsp;&nbsp;&nbsp;state $time_to_update = 0;
&nbsp;&nbsp;&nbsp;&nbsp;return if time &lt; $time_to_update;
&nbsp;&nbsp;&nbsp;&nbsp;$time_to_update = time + 30;

    # get the home page of Slate
    my $homepage = $c-&gt;ua-&gt;get('https://slate.com/');

    # grab the url for the big headline
    my $url =  $homepage-&gt;res
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;dom
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;at('.story-card__headline')
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;parent
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;parent
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;attr('href');

    # get the actual article
    my $article = app-&gt;ua-&gt;get($url);
&nbsp;&nbsp;&nbsp;&nbsp;my $dom = $article-&gt;res-&gt;dom;

    # render our homepage to a static file where we can have
&nbsp;&nbsp;&nbsp;&nbsp;# mojo serve as needed
    $c-&gt;app-&gt;home-&gt;child('public','home.html')
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;spurt(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$c-&gt;render_to_string(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'template',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;headline   =&gt; $dom-&gt;at('.article__hed')-&gt;text,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sub_header =&gt; $dom-&gt;at('.article__dek')-&gt;text,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;);

    # cache the main picture from the article into the 'public' dir
&nbsp;&nbsp;&nbsp;&nbsp;# where mojo will directly serve static files from
    my $picture_url = $dom-&gt;at('.image__src')-&gt;attr('data-normal');
&nbsp;&nbsp;&nbsp;&nbsp;my $picture = $c-&gt;ua-&gt;get($picture_url);
&nbsp;&nbsp;&nbsp;&nbsp;$c-&gt;app-&gt;home-&gt;child('public','image.jpg')
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;spurt( $picture-&gt;res-&gt;body );
}

# if someone gets '/' just spit out the static home.html file,
# updating it if need be first
get '/' =&gt; sub ($c) {
&nbsp;&nbsp;&nbsp;&nbsp;update_cache($c);
&nbsp;&nbsp;&nbsp;&nbsp;$c-&gt;reply-&gt;static('home.html');
};

app-&gt;start;

__DATA__

@@ template.html.ep
&lt;html&gt;
&lt;body&gt;
&lt;h1&gt;&lt;%= $headline %&gt;&lt;/h1&gt;
&lt;p&gt;&lt;%= $sub_header %&gt;&lt;/p&gt;
&lt;img src=&quot;image.jpg&quot;&gt;
&lt;/html&gt;

"It's looking good", the Wise Old Elf commented. "But every thirty seconds things are going to get bad for the users. The unlucky elf that hit the page is going to have to sit there while all the websites are scraped. Also, anyone else that comes along isn't going to get a page either - our webserver is single threaded and the thread is busy waiting around for webpages to come back to it over the internet, not serving data."

Callbacks

What Fir needed to do was change his code so that the end user always immediately be delivered the cached version of the page. If the cache was out of date then Mojolicious should start to scrape a new version in the background ready for the next elf that came along while at the same time in the foreground serving the older version to the current elf immediately. No more waiting for impatient elves!

Fir read the documentation for Mojolicious and discovered that Mojo::UserAgent doesn't have to block and return the scraped web page, but instead you can pass it a callback that will be executed when it's done fetching data. A quick rewrite later and the update_cache function now looked like this:

sub update_cache($c) {
&nbsp;&nbsp;&nbsp;&nbsp;state $time_to_update = 0;
&nbsp;&nbsp;&nbsp;&nbsp;return if time &lt; $time_to_update;
&nbsp;&nbsp;&nbsp;&nbsp;$time_to_update = time + 30;

    # get the home page of Slate
    $c-&gt;ua-&gt;get('https://slate.com/', sub ($, $homepage) {
        # grab the url for the big headline
        my $url =  $homepage-&gt;res
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;dom
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;at('.story-card__headline')
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;parent
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;parent
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;attr('href');

        # get the actual article
        $c-&gt;ua-&gt;get($url, sub ($, $article) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $dom = $article-&gt;res-&gt;dom;

            # render our homepage to a static file where we can have
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# mojo serve as needed
            $c-&gt;app-&gt;home-&gt;child('public','home.html')
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;spurt(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$c-&gt;render_to_string(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'template',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;headline   =&gt; $dom-&gt;at('.article__hed')-&gt;text,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sub_header =&gt; $dom-&gt;at('.article__dek')-&gt;text,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;);

            # cache the main picture from the article into the 'public' dir
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# where mojo will directly serve static files from
            my $picture_url = $dom-&gt;at('.image__src')-&gt;attr('data-normal');
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$c-&gt;ua-&gt;get($picture_url, sub ($, $picture) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$c-&gt;app-&gt;home-&gt;child('public','image.jpg')
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;spurt( $picture-&gt;res-&gt;body );
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;});
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;});
&nbsp;&nbsp;&nbsp;&nbsp;});
}

The trouble was that the code had got decidedly harder to follow. Each network request resulted in another callback being scheduled from the parent callback. By the time that the callback for downloading the graphic which was called from the callback for downloading the article which was called from the callback for downloading the homepage was called, things were getting pretty deep - and the amount of indenting was getting out of control.

Promises

It was time to take a different approach. Fir remembered an article on Mojo::Promise from last year's advent calendar. Could using promises help with the crazy indenting?

sub update_cache($c) {
&nbsp;&nbsp;&nbsp;&nbsp;state $time_to_update = 0;
&nbsp;&nbsp;&nbsp;&nbsp;return if time &lt; $time_to_update;
&nbsp;&nbsp;&nbsp;&nbsp;$time_to_update = time + 30;

    # get the home page of Slate
    $c-&gt;ua-&gt;get_p('https://slate.com/')
&nbsp;&nbsp;&nbsp;&nbsp;-&gt;then(sub ($homepage, @) {
        # grab the url for the big headline
        my $url =  $homepage-&gt;res
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;dom
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;at('.story-card__headline')
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;parent
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;parent
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;attr('href');

        # get the actual article
        return $c-&gt;ua-&gt;get_p($url);
&nbsp;&nbsp;&nbsp;&nbsp;})-&gt;then( sub ($article, @) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $dom = $article-&gt;res-&gt;dom;

        # render our homepage to a static file where we can have
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# mojo serve as needed
        $c-&gt;app-&gt;home-&gt;child('public','home.html')
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;spurt(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$c-&gt;render_to_string(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'template',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;headline   =&gt; $dom-&gt;at('.article__hed')-&gt;text,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sub_header =&gt; $dom-&gt;at('.article__dek')-&gt;text,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;);

        # get the main picture
        my $picture_url = $dom-&gt;at('.image__src')-&gt;attr('data-normal');
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return $c-&gt;ua-&gt;get_p($picture_url);
&nbsp;&nbsp;&nbsp;&nbsp;})-&gt;then( sub ($picture, @) {
        # cache the main picture from the article into the 'public' dir
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# where mojo will directly serve static files from
        $c-&gt;app-&gt;home-&gt;child('public','image.jpg')
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;spurt( $picture-&gt;res-&gt;body );
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return;
&nbsp;&nbsp;&nbsp;&nbsp;});
}

Now Fir had a pattern of the then subroutines being called whenever the previous promise was resolved. No more indenting!

Personally however, I don't find this much more readable than the callback code. Explicit promises are powerful things when you're passing them around your code, but when control is just flowing from the top of the page to the bottom as it is here they can add a lot of extra code that is distracting. It's also adding a whole bunch of extra scopes which make it harder to access variables from the top of your code in the bottom and can easily make the code very torturous to write - the cure is worse than the disease.

Async and Await

What we need is Perl to be a little more like JavaScript. JavaScript has an await keyword that can tell the interpreter to stop and wait for a promise to be fulfilled before continuing (just like $promise->wait does) but also allow other code to run at that point. This typically isn't something we can add to a language without making changes to the interpret itself - after all you need the ability to hop out of the subroutine and then later jump right back into the middle of the subroutine where you left off.

Luckily, Fir hadn't just been reading the Perl Advent Calendar last year, he'd also read the Mojolicious Advent Calendar's entry on the Mojo::AsyncAwait module which does "XS and C-level shenanigans" in the Perl interpreter to allow the async and await keywords to suspend and resume execution.

Now Fir could rewrite the update_cache subroutine to run async, and he could use the await keyword to stop and await the promises (while executing other code while it waits!)

async update_cache =&gt; sub ($c) {
&nbsp;&nbsp;&nbsp;&nbsp;state $time_to_update = 0;
&nbsp;&nbsp;&nbsp;&nbsp;return if time &lt; $time_to_update;
&nbsp;&nbsp;&nbsp;&nbsp;$time_to_update = time + 30;

    # get the home page of Slate
    my $homepage = await $c-&gt;ua-&gt;get_p('https://slate.com/');

    # grab the url for the big headline
    my $url =  $homepage-&gt;res
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;dom
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;at('.story-card__headline')
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;parent
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;parent
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;attr('href');

&nbsp;&nbsp;&nbsp;&nbsp;my $article = await $c-&gt;ua-&gt;get_p($url);
&nbsp;&nbsp;&nbsp;&nbsp;my $dom = $article-&gt;res-&gt;dom;

    # render our homepage to a static file where we can have
&nbsp;&nbsp;&nbsp;&nbsp;# mojo serve as needed
    $c-&gt;app-&gt;home-&gt;child('public','home.html')
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;spurt(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$c-&gt;render_to_string(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'template',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;headline   =&gt; $dom-&gt;at('.article__hed')-&gt;text,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sub_header =&gt; $dom-&gt;at('.article__dek')-&gt;text,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;);

    # get the main picture
    my $picture_url = $dom-&gt;at('.image__src')-&gt;attr('data-normal');
&nbsp;&nbsp;&nbsp;&nbsp;my $picture = await $c-&gt;ua-&gt;get_p($picture_url);

    # cache the main picture from the article into the 'public' dir
&nbsp;&nbsp;&nbsp;&nbsp;# where mojo will directly serve static files from
    $c-&gt;app-&gt;home-&gt;child('public','image.jpg')
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;spurt( $picture-&gt;res-&gt;body );

};

This code looks identical to the original blocking code that Fir started out with, apart from the introduction of the async keyword to declare the update_cache subroutine and the use of await $c->ua->get_p(...) instead of $c->ua->get(...).

The behavior however is completely different - the subroutine stops executing as soon as it hits that first await and switches back to the caller, delivering the cached page while network requests continue in the background.

Nice. Now all he had to do was add scraping logic for another thirty or so websites and he'd have something awesome to show at standup tomorrow morning.

Command Line Browser Apps

2019-12-09T00:00:00Z

The weeks leading up to Christmas is a stressful time for most elves at the North Pole. Not so for Buster Stripytights. No...every week was stressful for him.

You see, Buster's job is nothing short of making sure that enough toys are produced throughout the year. Every week it's his job to compute how production is going, if they were ahead or behind schedule, and if Santa was going to have enough toys to make every good child happy, or if it was going to be a disaster this year. It hasn't happened yet, but it's only thanks to the diligent work of Mr Stripytights that any issue has been detected and dealt with before it became a real problem.

As you can imagine, this involves a lot of number crunching and What-If type predictions. Most importantly, it involves a lot of quick data visualization.

A few years ago Buster had despaired about getting the kind of interactive output he needed from his Perl data crunching scripts. That was before the Wise Old Elf had stepped in.

The Plan

Some people like to wield the terminal. Others like to have an interactive web page to control things.

However, the Wise Old Elf is...wise. He likes the best of both worlds: Being able to jump from the command line into the browser and then quickly back to the terminal again, and onto the next command.

For the task Buster needed he suggested making a script to immediately display the output of crunching the data in a web browser.

When the script was executed from the terminal the Perl script should:

Do the initial processing of data
Finds a random unused port on localhost
Open a web server on that unused port
Open the browser to point at that port
Finally when the browser window is closed, quit the script

Simple! Let's break down how to do that!

The Start of our Web Application

Using a web server to pass the output to the browser has several advantages over writing out temporary files. We don't have to figure out a way to periodically clear up those files. We can pause execution of subsequent commands in the terminal till the browser window is closed. We can control all files the browser has to load. And we have the full potential to pass information back and forward to Perl as the user interacts with the contents of the browser window.

The start of our interactive tool is a Mojolicious web app (using the Mojolicious::Lite framework).

#!/usr/bin/perl

use Mojolicious::Lite;
use experimental 'signatures';

get '/' =&gt; 'index';

our $message = &quot;Merry Christmas from the script!&quot;;

app-&gt;start('daemon');

__DATA__
@@ index.html.ep
&lt;html&gt;
&lt;body&gt;
&lt;%= $main::message %&gt;
&lt;/body&gt;
&lt;/html&gt;

Running the script shows it starts up a server on the

    $ ./script.pl
    [2019-11-23 10:20:42.21211] [19502] [info] Listening at &quot;http://*:3000&quot;

We defined just one route (/) that renders the index template in the DATA section, which will dynamically include data from our Perl code.

Picking a Random Port

At the moment our server will always open on the standard Mojolicious development port, port 3000. But Buster needs to be able to display more than one graph on the screen at any one time! Each of these servers are going to have to pick their own port to run on.

This is actually quite simple with the help of the Net::EmptyPort module which can find a random port that nothing else is using for us:

use Net::EmptyPort qw( empty_port );
my $base_url = 'http://127.0.0.1:' . empty_port();
app-&gt;start('daemon','--listen', $base_url );

Opening The Page Automatically

To make this more like an "app" we don't want Buster to have to copy any paste the URL from the terminal into his browser after the program starts up. We want the web page just to immediately open up as soon as the script is ready to display something to the user.

This can be achieved by hooking the before_server_start Mojolicious event. We'll have it call the open_browser function from the ever-so-handy Browser::Open module as soon as Mojolcious is ready to serve web pages.

While we're at it we don't need Mojolicious to print URLs or debug information out to the console anymore, so we suppress all of that:

#!/usr/bin/perl

use Mojolicious::Lite;
use experimental 'signatures';

use Net::EmptyPort qw( empty_port );
use Browser::Open qw( open_browser );

get '/' =&gt; 'index';

# stop logging out when we visit URLs
app-&gt;log-&gt;level('warn');

# open the browser as soon as we start
my $base_url = 'http://127.0.0.1:' . empty_port();
app-&gt;hook(before_server_start =&gt; sub ($server, @) {
&nbsp;&nbsp;&nbsp;&nbsp;$server-&gt;silent(1);  # don't display &quot;Server available...&quot;
&nbsp;&nbsp;&nbsp;&nbsp;open_browser($base_url);
});

app-&gt;start('daemon','--listen', $base_url );
...

Quitting Time

To make this like a real application we don't want Buster to have to remember to head back to the terminal and ctrl-C the command line program when he's done with the graph. There must be some way to automatically quit the script as soon as the browser window closes!

We can hook the unload event in JavaScript fairly easily:

window.addEventListener( &quot;unload&quot;, ... );

But what should we have that do? Ideally we'd like to send a HTTP request back to the browser, but doing this via AJAX is unreliable: The page might complete closing before the asynchronous web request gets far enough along. Never fear! We're running a faily modern web browser, so we can make use of beacons.

The Beacon API is a fire-and-forget non-blocking way to tell the browser to make a HTTP POST request as soon as it is able to and we don't care about the result. This means we can make a simple call like so:

navigator.sendBeacon(&quot;/exit&quot;)

And the browser will continue to make the call to our backend even after its closed the window with our webpage in it.

#!/usr/bin/perl

use Mojolicious::Lite;
use experimental 'signatures';

...

get '/' =&gt; 'index';

# when our beacon notifies us, just quit right away
post '/exit' =&gt; sub { exit };

...

__DATA__
@@ index.html.ep
&lt;html&gt;
&lt;script&gt;
// when the page is closed have the browser send a POST
// to /exit to tell Mojolicious to shut down
window.addEventListener(
&nbsp;&nbsp;&nbsp;&nbsp;&quot;unload&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;() =&gt; navigator.sendBeacon(&quot;/exit&quot;),
&nbsp;&nbsp;&nbsp;&nbsp;false
);
&lt;/script&gt;
&lt;body&gt;
&lt;%= $main::message %&gt;
&lt;/body&gt;
&lt;/html&gt;

Putting It All Together

Now we can put all of this together into building a script that dynamically shows any CSV as a graph:

#!/usr/bin/perl

use Mojolicious::Lite;
use experimental 'signatures';

use Net::EmptyPort qw( empty_port );
use Browser::Open qw( open_browser );
use Text::CSV_XS ();

##########################################################

my $filename = shift;

my $csv = Text::CSV_XS-&gt;new({ binary =&gt; 1, auto_diag =&gt; 1 });
open my $fh, &quot;&lt;:encoding(utf8)&quot;, $filename or die &quot;$filename: $!&quot;;

my $data = {};
my $titles = $csv-&gt;getline($fh);
my $xlabel = shift @{ $titles };
$data-&gt;{labels} = [];
$data-&gt;{datasets} = [
&nbsp;&nbsp;&nbsp;&nbsp;map { +{ label =&gt; $_, data =&gt; [] } } @{ $titles }
];

while (my $row = $csv-&gt;getline($fh)) {
&nbsp;&nbsp;&nbsp;&nbsp;push @{ $data-&gt;{labels} }, shift @{ $row };
&nbsp;&nbsp;&nbsp;&nbsp;push @{ $data-&gt;{datasets}[ $_ ]{data} }, $row-&gt;[ $_ ]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;for 0..(scalar(@{ $row })-1);
}

close $fh or die &quot;$filename: $!&quot;;

##########################################################

get '/' =&gt; sub ($c, @) {
&nbsp;&nbsp;&nbsp;&nbsp;$c-&gt;render(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'index',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;title  =&gt; $filename =~ s/[.]csv$//r,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;xlabel =&gt; $xlabel,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;cols   =&gt; $data,
&nbsp;&nbsp;&nbsp;&nbsp;);
};
post '/exit' =&gt; sub { exit };

app-&gt;log-&gt;level('warn');

my $base_url = 'http://127.0.0.1:' . empty_port();
app-&gt;hook(before_server_start =&gt; sub ($server, @) {
&nbsp;&nbsp;&nbsp;&nbsp;$server-&gt;silent(1);
&nbsp;&nbsp;&nbsp;&nbsp;open_browser($base_url);
});

app-&gt;start('daemon','--listen', $base_url );

__DATA__
@@ index.html.ep
% # This pages includes output directly in the  &lt;script&gt;...&lt;/script&gt;
% # tags.  Note that this is only safe because:
% 
% #   (a) I'm using to_json which outputs characters not bytes so
% #       when Mojolicious does the final byte encoding everything will
% #        work out and not be double encoded, and
% 
% #   (b) Mojo::JSON (unlike many other JSON libraries) *also* escapes
% #       any '/' as '\/' meaning that a rogue '&lt;/script&gt;' in the data
% #       won't terminate the script tags and present a possible
% #       JavaScript injection attack
% 
% use Mojo::JSON qw( to_json );
&lt;html&gt;
&lt;script&gt;
// when the page is closed have the browser send a POST
// to /exit to tell Mojolicious to shut down
window.addEventListener(
&nbsp;&nbsp;&nbsp;&nbsp;&quot;unload&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;() =&gt; navigator.sendBeacon(&quot;/exit&quot;),
&nbsp;&nbsp;&nbsp;&nbsp;false
);
&lt;/script&gt;
&lt;script src=&quot;https://cdn.jsdelivr.net/npm/chart.xkcd@1.1/dist/chart.xkcd.min.js&quot;&gt;&lt;/script&gt;
&lt;body&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;svg class=&quot;chart&quot;&gt;&lt;/svg&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;script&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;const chartElement = document.querySelector('.chart');
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;const lineChart = new chartXkcd.Line(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;chartElement,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;title: &lt;%== to_json( $title ) %&gt;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;xLabel: &lt;%== to_json( $xlabel ) %&gt;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;data: &lt;%== to_json( $cols ) %&gt;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;options: {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;legendPosition: chartXkcd.config.positionType.upLeft
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;);
&nbsp;&nbsp;&nbsp;&nbsp;&lt;/script&gt;
&lt;/body&gt;
&lt;/html&gt;

Of course, we could go further than all of this, making a completely interactive application with Perl and JavaScript passing information back and forward to each other...but that's a project for another day.

Christmas Movie Time!

2019-12-08T00:00:00Z

Have you ever wondered what the best Christmas Movie of all time is?

Spoiler Alert: It's "It's a Wonderful Life".

Of course, that's not just my opinion: I can prove it...with Perl.

Christmas Movies

The first thing we need to prove this comprehensively is a collection of Christmas movies.

Did you know that Wikipedia has a list of Christmas movies on it? Neither did I, but I shouldn't be surprised; It has pretty much everything and the kitchen sink on it. Let's scrape that list and put it in a database.

First, we create need a table:

CREATE TABLE wikipedia_films (
&nbsp;&nbsp;&nbsp;&nbsp;name TEXT,
&nbsp;&nbsp;&nbsp;&nbsp;year INTEGER
);

We can use the on-disk daemonless SQLite SQL database to do this. Most systems ship with the sqlite3 command line tool that'll write the database from the SQL for us:

    $ sqlite3 /tmp/db &lt; wikipedia_films.sql

Now we need a program that can scrape the web page and populate the database. Easy-peasy with Mojo::UserAgent, which we've covered extensively in past advent calendars:

#!/usr/bin/perl

use strict;
use 5.024;

use DBI;
use Mojo::UserAgent;

my $dbh = DBI-&gt;connect(&quot;dbi:SQLite:dbname=/tmp/db&quot;);

my $ua = Mojo::UserAgent-&gt;new();
my $res = $ua-&gt;get(
&nbsp;&nbsp;&nbsp;&nbsp;'https://en.wikipedia.org/wiki/List_of_Christmas_films'
)-&gt;result;
if ($res-&gt;is_error) { die $res-&gt;message }

$dbh-&gt;begin_work;
$res-&gt;dom-&gt;find('.wikitable tbody tr')-&gt;each(sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $a = $_-&gt;at(&quot;td:first-child * a&quot;);
&nbsp;&nbsp;&nbsp;&nbsp;next unless $a;
&nbsp;&nbsp;&nbsp;&nbsp;my $name = $a-&gt;text;

&nbsp;&nbsp;&nbsp;&nbsp;my $year = $_-&gt;at(&quot;td:nth-child(2)&quot;)-&gt;text;

&nbsp;&nbsp;&nbsp;&nbsp;say STDERR &quot;Inserting $name ($year)&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;$dbh-&gt;do( &lt;&lt;'SQL', {}, $name, $year );
        INSERT INTO wikipedia_films
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(name, year) VALUES (?,?)
SQL
});
$dbh-&gt;commit;

Now we've got a big old list in our database...but what's the best of these movies?

Downloading The IMDb

If we're being scientific about this we shouldn't just use our opinion. We should use the wisdom of crowds: The Internet Movie Database rating for the film.

So that's straight forward: First we just download the entire of the IMDb...wait, you didn't know we could do that? Sure! The IMDb publishes a bunch of tab separated compressed files of their core data every day.

If we use lwp-mirror to download the files we can mirror the large files to disk.

   $ lwp-mirror https://datasets.imdbws.com/title.basics.tsv.gz title.basics.tsv.gz
   $ lwp-mirror https://datasets.imdbws.com/title.ratings.tsv.gz title.ratings.tsv.gz

Because we're using lwp-mirror we can safely re-run the downloads as often as we want - a new version will only be downloaded when the contents changes.

Importing into Our Database

Okay, we next need to put all of that data into our database. Let's create a new table:

CREATE TABLE imdb_films (
&nbsp;&nbsp;&nbsp;&nbsp;title TEXT,
&nbsp;&nbsp;&nbsp;&nbsp;name TEXT,
&nbsp;&nbsp;&nbsp;&nbsp;year INTEGER,
&nbsp;&nbsp;&nbsp;&nbsp;rating FLOAT
);

CREATE INDEX imdb_films_title_idx
ON imdb_films(title);

In the database:

    $ sqlite3 /tmp/db &lt; imdb_films.sql

And populate it with films:

#!/usr/bin/perl

use strict;
use 5.024;

use DBI;
use List::AllUtils qw( zip );
use Mojo::UserAgent;
use PerlIO::gzip;
use Term::ProgressBar;

my $dbh = DBI-&gt;connect(&quot;dbi:SQLite:dbname=/tmp/db&quot;);

# how big is this file?
my $total = `gunzip -c title.basics.tsv.gz | wc -l`;

# the file is gzipped, so use the gzip layer
# to transparently decompress it as we read it
open my $fh, '&lt;:gzip', 'title.basics.tsv.gz'
or die &quot;Can't open file: $!&quot;;

# read the first line in that contains the headings
$_ = &lt;$fh&gt;;
chomp;
my @headings = split /\t/;

# prepare the insert statement
my $sth = $dbh-&gt;prepare(&lt;&lt;'SQL');
    INSERT INTO imdb_films
&nbsp;&nbsp;&nbsp;&nbsp;( title, name, year )
&nbsp;&nbsp;&nbsp;&nbsp;VALUES
&nbsp;&nbsp;&nbsp;&nbsp;( ?, ?, ?)
SQL

# process each row of the file
my $progress = Term::ProgressBar-&gt;new ({
&nbsp;&nbsp;&nbsp;&nbsp;count =&gt; $total,
&nbsp;&nbsp;&nbsp;&nbsp;ETA   =&gt; 'linear',
});
$dbh-&gt;begin_work;
while (&lt;$fh&gt;) {
&nbsp;&nbsp;&nbsp;&nbsp;chomp;
&nbsp;&nbsp;&nbsp;&nbsp;my @row_data = split /\t/;

    # zip returns an element from each of the arrays 
&nbsp;&nbsp;&nbsp;&nbsp;# in turn i.e. key, value, key, value, key, value...
    my %data = zip @headings, @row_data;

    # ignore anything that isn't a movie or, ahem, isn't
&nbsp;&nbsp;&nbsp;&nbsp;# in the true christmas spirit
    next if $data{titleType} ne 'movie';
&nbsp;&nbsp;&nbsp;&nbsp;next if $data{isAdult};

    # insert just some of the fields from the data
&nbsp;&nbsp;&nbsp;&nbsp;# note ratings aren't in here yet - next script!
    $sth-&gt;execute(@data{qw(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;tconst
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;originalTitle
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;startYear
&nbsp;&nbsp;&nbsp;&nbsp;)});

&nbsp;&nbsp;&nbsp;&nbsp;$progress-&gt;update($.);
}
$dbh-&gt;commit;

And do almost same thing with the ratings for the films:

#!/usr/bin/perl

use strict;
use 5.024;

use DBI;
use List::AllUtils qw( zip );
use Mojo::UserAgent;
use PerlIO::gzip;
use Term::ProgressBar;

my $dbh = DBI-&gt;connect(&quot;dbi:SQLite:dbname=/tmp/db&quot;);

# how big is this file?
my $total = `gunzip -c title.ratings.tsv.gz | wc -l`;

# the file is gzipped, so use the gzip layer
# to transparently decompress it as we read it
open my $fh, '&lt;:gzip', 'title.ratings.tsv.gz'
or die &quot;Can't open file: $!&quot;;

# read the first line in that contains the headings
$_ = &lt;$fh&gt;;
chomp;
my @headings = split /\t/;

# prepare the insert statement
my $sth = $dbh-&gt;prepare(&lt;&lt;'SQL');
    UPDATE imdb_films
&nbsp;&nbsp;&nbsp;&nbsp;SET rating = ?
&nbsp;&nbsp;&nbsp;&nbsp;WHERE title = ?
SQL

# process each row of the file
my $progress = Term::ProgressBar-&gt;new ({
&nbsp;&nbsp;&nbsp;&nbsp;count =&gt; $total,
&nbsp;&nbsp;&nbsp;&nbsp;ETA   =&gt; 'linear',
});
$dbh-&gt;begin_work;
while (&lt;$fh&gt;) {
&nbsp;&nbsp;&nbsp;&nbsp;chomp;
&nbsp;&nbsp;&nbsp;&nbsp;my @row_data = split /\t/;

    # zip returns an element from each of the arrays 
&nbsp;&nbsp;&nbsp;&nbsp;# in turn i.e. key, value, key, value, key, value...
    my %data = zip @headings, @row_data;

&nbsp;&nbsp;&nbsp;&nbsp;$sth-&gt;execute(@data{qw(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;averageRating
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;tconst
&nbsp;&nbsp;&nbsp;&nbsp;)});

&nbsp;&nbsp;&nbsp;&nbsp;$progress-&gt;update($.);
}
$dbh-&gt;commit;

The Moment of Truth

Finally, we can categorically prove what's the best Christmas Film

    $ sqlite3 /tmp/db
    sqlite&gt; SELECT name
       ...&gt; FROM wikipedia_films
       ...&gt; JOIN imdb_films
       ...&gt; USING (name, year)
       ...&gt; ORDER BY rating DESC
       ...&gt; LIMIT 1;
    It&#39;s a Wonderful Life

Show Me Mo'

2019-12-07T00:00:00Z

Conifer Sweetbaker, Software Programmer Elf second class grumbled. Despite what the Wise Old Elf insisted about maintaining the quality of the code they used at the North Pole, Conifer had to admit it to himself: He hated doing code reviews. And there was no code that he hated reviewing more than his best friend Currant Northwick's spaghetti code.

The Elf's code was a mess of Perl that looks like it had been written before the first dot com boom. There were mostly no objects and Conifer had already caught more than one case where there'd been a typo in the hash keys (if those had just been objects and method calls Currant would have got a proper error message.) Occasionally Currant did deign to use an object - or at least that's what Conifer thought he was doing by the smattering of new and bless that peppered his code, but worryingly, there was a lack of accessor methods and direct access into the blessed hash all over the shop.

"Why, for Santa's sake, WHY? It's as if you'd never heard of Moose" he cajoled his buddy.

Moose was of course the object framework of choice at the North Pole. The powerful postmodern object system not only provides a awesome abstraction for defining object classes and accessor methods beyond the primitive bless keywords, but also provides a rich meta object protocol the envy of many lesser languages.

"Too slow startup time", Conifer complained. "And I couldn't get it installed on the old development platform over in the southern workshop - they don't have a C compiler for installing software like that".

Conifer didn't want to argue with his friend. When Moose programs start up they do take a little longer than basic Perl code that doesn't maintain a meta object protocol. And yes, you need a working compiler to install Moose's dependencies (or the ability to apt-get install it - Moose is widely distributed in the ten years or so it's been the defacto standard in Perl.) Conifer wasn't sure which system Currant was talking about (all buildings surrounding the North Pole are to the south) but he realized he just didn't want to argue.

"How about Moo? That's quick.", Conifer tried a conciliatory suggestion.

"Still slower than coding it by hand!", Currant quipped, "Still needs an external dependency! And still too much typing."

There was no satisfying some elves. Moo is set of pure Perl classes that offered a subset of the Moose syntax that'll do very nicely if for any number of reasons you can't use Moose. But Conifer really wanted something as portable, quick and with as little typing as writing the broken frameworkless code he was trying to maintain now.

There's really no arguing with some Elves.

"I know what you want," Conifer laughted, "You want Mo, Baby!"

Mo

If Moo is a cut down version of Moose, then Mo is a super trimmed to the bone and then slightly further implementation of something not too dissimilar to Moo in as little code as humanly possible.

Mo is like a super-terse version of Moose suitable for prototyping and quick one off scripts. For example, if you need to get a bunch of super heros together very, very quickly:

#!/usr/bin/perl
use 5.024;

package Person;
use Mo;
has 'name';
has 'codename';

package Team;
use Mo;
has 'members';
sub assemble { say $_-&gt;name.' assemble!' for shift-&gt;members-&gt;@* }

package main;

my $avengers = Team-&gt;new(
&nbsp;&nbsp;members =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;Person-&gt;new(name =&gt; 'Bruce Banner', codename =&gt; 'The Hulk'),
&nbsp;&nbsp;&nbsp;&nbsp;Person-&gt;new(name =&gt; 'Clint Barton', codename =&gt; 'Hawkeye' ),
&nbsp;&nbsp;&nbsp;&nbsp;Person-&gt;new(name =&gt; 'Natasha Romanoff', codename =&gt; 'Black Widow'),
&nbsp;&nbsp;&nbsp;&nbsp;Person-&gt;new(name =&gt; 'Steve Rogers', codename =&gt; 'Captain America'),
&nbsp;&nbsp;&nbsp;&nbsp;Person-&gt;new(name =&gt; 'Tony Stark', codename =&gt; 'Ironman' ),
&nbsp;&nbsp;],
);
print $avengers-&gt;assemble;

Brevity

Just like Moose and Moo, Mo creates the constructor for your object class for you and allows you to define accessor methods with the handy has syntax.

However, whereas Moose and Moo require at least an is directive like so:

package Person;
use Moose;
has name     =&gt; ( is =&gt; 'rw');
has codename =&gt; ( is =&gt; 'rw');

Mo allows you to skip all the boilerplate if you want.

package Person;
use Mo;
has 'name';
has 'codename';

That doesn't mean Mo isn't able to handle complex things...it just does it with a lot less code.

Consider this Moose code:

package Archer;
use Moose;
extends 'Person';

has weapon =&gt; (
&nbsp;&nbsp;is =&gt; 'rw',
&nbsp;&nbsp;lazy =&gt; 1,
&nbsp;&nbsp;default =&gt; sub { shift-&gt;codename . &quot;'s bow&quot; }
);

has arrows =&gt; (
&nbsp;&nbsp;is =&gt; 'ro',
&nbsp;&nbsp;lazy =&gt; 1,
&nbsp;&nbsp;default =&gt; sub { [ 'normal'x5, 'trick', 'explosive' ] },
);

This can we written a lot more succinctly in Mo

package Archer;
use Mo;
extends 'Person';

has weapon =&gt; sub { shift-&gt;codename . &quot;'s bow&quot; };
has arrows =&gt; is =&gt; ro =&gt; [ 'normal'x5, 'trick', 'explosive' ];

Three key things make this code quicker to write:

Everything is lazy by default. This means that the accessor values aren't populated until they're accessed the first time. To force something to be non-lazy with Mo, you explicitly have to use <lazy = 0>>.
The default keyword is completely optional. If Mo sees a subroutine reference it assumes it's the default subroutine.
Array references and hash references are assumed to be templates that need to be shallow copied. So [1,2,3] is the same as lazy => 1, default => sub { [1,2,3] } in Moose. (Deep hash / arrays still require more traditional syntax however!)

Speed

Okay, so it's quicker to write...but what about quicker to run, and more importantly, quicker to start up.

Let's see what the timings are for our above script by benchmarking it on one of Microsoft's Standard Linux 4 core 8GB instances. I've prepared three versions of the script for testing, each using either Moose, Moo or Mo.

    $ time perl moose.pl &gt;/dev/null
    real    0m0.183s
    user    0m0.163s
    sys     0m0.020s
    
    $ time perl moo.pl &gt;/dev/null
    real    0m0.036s
    user    0m0.020s
    sys     0m0.016s
    
    $ time perl mo.pl &gt;/dev/null
    real    0m0.006s
    user    0m0.006s
    sys     0m0.000s

We can see that just as Moo is faster than Moose an order of magnitude, Mo is fast by an order of magnitude again. To put this in some real world scenario, the Mo code is so fast that we could execute it every single frame of a 60Hz television video playback. The Moose version barely gets the five frames a second of the worst possible animated gif.

Memory

Speed isn't everything. What about memory usage?

    $ /usr/bin/time -f &#39;%MK&#39; perl moose.pl &gt;/dev/null
    20200K
    $ /usr/bin/time -f &#39;%MK&#39; perl moo.pl &gt;/dev/null
    8372K
    $ /usr/bin/time -f &#39;%MK&#39; perl mo.pl &gt;/dev/null
    4668K

Whoa, that's a big difference. We should also consider that the baseline Perl interpreter takes up the majority of the memory:

    /usr/bin/time -f &#39;%MK&#39; perl -e 1 &gt;/dev/null
    4144K

Portability

In order to install Moose and its dependencies you need a working compiler. Moo is much easier to install - it's a pure Perl solution, though still has several classes and its own distribution on the CPAN that you'll need to run any Moo code. Mo? Mo is designed to be bundled with your application.

It's common to see a custom versions of Mo bundled with other modules within their distribution. Instead of using the CPAN version of Mo:

package Spline::Reticulator;
use Mo;
...

They rely on their own version that the include in the distribution itself

use Spline::Reticulator::Mo;
...

The version of Mo that is distribution is often a cut down selection of the Mo source code providing just what the project needs and no more. Mo ships with a tool Mo::Inline that makes producing these modules trivial.

First, write a dummy package shim explaining what parts of Mo you'd like included

package Spline::Reticulator::Mo;
# use Mo qw'build builder default import';
1;

Then run the mo-inline script to expand the code:

  $ mo-inline .
  Mo Inlined ./lib/Spline/Reticulator/Mo.pm

If you were to poke inside the class now you'd see it contains a single line optomised version of Mo, just like one of the many examples on the CPAN.

It's even possible to completely inline Mo inside a script by including the inlined code directly in the script:

#!/usr/bin/perl

package My::Mo;
BEGIN { $INC{'My/Mo.pm'}=__FILE__;
&nbsp;&nbsp;no warnings;my$M=__PACKAGE__.'::';*{$M.Objec...&lt;snip&gt;
}

use 5.024;

package Person;
use My::Mo;
has 'name';
has 'codename';
...

By wrapping the inline code inside a BEGIN { ... } (to make sure that the code is executed before the code below it is parsed) and by introducing $INC{'My/Mo.pm'}=__FILE__ (which prevents perl from actually searching on disk for a file called My/Mo.pm) we can create a My::Mo class we can use in the script whenever we want to enable Mo.

A Victory, FSVO Victory...

"Okay...Okay!", Currant Northwick begrudgingly agreed, "I'll rewrite this code with Mo. But you do realize you're going to have to code review it again from scratch, right?"

The Weather Outside Is Frightful

2019-12-06T00:00:00Z

Bad Weather

Being at the North Pole snow is something that you have to get used to. There's no snow days, you don't get to call in if the weather is bad, and there's no putting off Christmas no matter how much of the white stuff falls.

Instead, you have to be prepared.

It's really important that the elves know when there's a snowstorm coming, and they employ a whole team

But what about us mere mortals? Shouldn't we be prepared too in case, say, it snows so much at 6am on Christmas morning a car containing radioactive isotopes flips in a snowstorm, crashes into the telegraph pole outside your house, rips down all the electrical cabling that provides power to your house and then bursts into flames (don't worry, that's only ever happened to me once).

Well, we can't afford to have a team of elves working night and day to alert us of bad weather. But we can have Perl do it for us.

Dark Sky

DarkSky is a very handy website for gathering weather predictions offering doppler radar maps, predictive forecasting for up to a week in advance, per minute rainfall for the next hour in easy to read graphical form, and a compelling time-machine feature for seeing both historical and predicted future weather.

More importantly for our purposes, it offers a comprehensive API with a generous free tier that we can use to poll for weather updates throughout the day.

#!/usr/bin/perl

use 5.024;
use warnings;

use DarkSky::API;
my $forecast = DarkSky::API-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;key       =&gt; '8e983a4b1eca4ebf9385f413f8ffa668',

    # this is New York City, NY, USA
    longitude =&gt; -74.0060,
&nbsp;&nbsp;&nbsp;&nbsp;latitude  =&gt; 40.7128,
);

my $weather = $forecast-&gt;currently;
say &quot;$weather-&gt;{icon}: $weather-&gt;{summary}&quot;;

Where are we?

So far we've been passing fixed coordinates to the Dark Sky API. What we'd rather do is actually give weather reports from where we're actually located!

The first step is to find out what our external IP is. This isn't the local IP address that's been assigned to the computer we're using (which is more than likely something from the private IP address space assigned by your router) but the real, globally addressable, IP address that our ISP assigned to our router.

The easiest way to do this is to contact an external web site and ask it what IP address it received the request from. There's several JSON API services that will happily do this for us.

use JSON::PP qw( decode_json );
use HTTP::Tiny;

my $ip_response = HTTP::Tiny-&gt;new-&gt;get('https://api.myip.com');
die &quot;Problem fetching IP&quot; unless $ip_response-&gt;{success};

# the response contains JSON of the form
#   { &quot;ip&quot; : &quot;50.116.23.211&quot; ... }
my $ip_data = decode_json( $ip_response-&gt;{content });
my $ip = $ip_data-&gt;{ip};

Now we have the IP address we need to translate that into latitude and longitude. MaxMind offer a free downloadable database of IP addresses to approximate locations that we can use to do this (they also offer more accurate databases for a fee which we can switch to if we want more accurate weather reports.)

MaxMind publish some handy Perl modules on the CPAN that you can use to access these databases without much work:

use GeoIP2::Database::Reader;

# follow the instructions at
# https://dev.maxmind.com/geoip/geoip2/geolite2/
# to be able to download the database
my $reader = GeoIP2::Database::Reader-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;file    =&gt; 'GeoLite2-City.mmdb',
&nbsp;&nbsp;&nbsp;&nbsp;locales =&gt; [ 'en' ],
);

my $city = $reader-&gt;city( ip =&gt; $ip );
my $location = $city-&gt;location;

# these are only approximate, but good enough
# for our weather prediction
say 'Latitude:  ', $location-&gt;latitude;
say 'Longitude: ', $location-&gt;longitude;

We can now feed those coordinates into the DarkSky API to get the weather where we are:

my $forecast = DarkSky::API-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;key       =&gt; '8e983a4b1eca4ebf9385f413f8ffa668',
&nbsp;&nbsp;&nbsp;&nbsp;longitude =&gt; $location-&gt;longitude,
&nbsp;&nbsp;&nbsp;&nbsp;latitude  =&gt; $location-&gt;latitude,
);
my $weather = $forecast-&gt;currently;
say &quot;$weather-&gt;{icon}: $weather-&gt;{summary}&quot;;

Look to the Future Now

If we're going to be forewarned about weather we need to examine the response from DarkSky a little more closely.

use Data::Dumper;
print Dumper $forecast-&gt;hourly;

This gives us quite a lot of data:

$VAR1 = {
&nbsp;&nbsp;&nbsp;&nbsp;'data' =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;{
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'ozone' =&gt; '327.9',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'visibility' =&gt; '4.759',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'summary' =&gt; 'Overcast',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'humidity' =&gt; '0.91',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'uvIndex' =&gt; 0,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'icon' =&gt; 'cloudy',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'windGust' =&gt; '1.46',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'dewPoint' =&gt; '31.52',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'time' =&gt; 1574139600,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'apparentTemperature' =&gt; '33.92',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'cloudCover' =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'precipProbability' =&gt; 0,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'windSpeed' =&gt; '1.46',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'temperature' =&gt; '33.92',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'windBearing' =&gt; 234,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'pressure' =&gt; '1004.9',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'precipIntensity' =&gt; 0
&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;{
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'time' =&gt; 1574143200,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'humidity' =&gt; '0.91',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'uvIndex' =&gt; 0,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'icon' =&gt; 'cloudy',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'windGust' =&gt; '4.77',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'dewPoint' =&gt; '31.27',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'summary' =&gt; 'Overcast',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'ozone' =&gt; '328.3',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'visibility' =&gt; '3.397',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'temperature' =&gt; '33.66',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'windBearing' =&gt; 275,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'pressure' =&gt; '1005.3',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'precipIntensity' =&gt; 0,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'windSpeed' =&gt; '4.77',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'precipProbability' =&gt; 0,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'apparentTemperature' =&gt; '29.23',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'cloudCover' =&gt; 1
&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;...
&nbsp;&nbsp;&nbsp;&nbsp;{
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'ozone' =&gt; '336.1',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'visibility' =&gt; '2.837',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'summary' =&gt; 'Light Snow',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'uvIndex' =&gt; 0,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'windGust' =&gt; '0.16',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'icon' =&gt; 'snow',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'dewPoint' =&gt; '30.49',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'humidity' =&gt; '0.89',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'time' =&gt; 1574164800,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'precipAccumulation' =&gt; '0.4816',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'apparentTemperature' =&gt; '33.36',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'cloudCover' =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'precipProbability' =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'precipType' =&gt; 'snow',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'windSpeed' =&gt; '0.16',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'windBearing' =&gt; 257,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'temperature' =&gt; '33.36',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'precipIntensity' =&gt; '0.0507',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'pressure' =&gt; '1006.1'
&nbsp;&nbsp;&nbsp;&nbsp;},
...

As you can see we've got lots of options for deciding if DarkSky thinks it's going to snow: The precipAccumulation (how much build up there's going to be), the precipProbability (how likely we're going to get water falling from the sky) and precipType (snow? sleet? rain?) But that's probably overthinking the entire problem; If DarkSky thinks it's going to snow that hour, it'll pick the snow icon.

Generating a summary is therefore straight forward

my @hourly = $forecast-&gt;hourly-&gt;{data}-&gt;@*;
for my $hour (@hourly) {
&nbsp;&nbsp;&nbsp;&nbsp;say scalar( localtime($hour-&gt;{time}) ),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;q{ },
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$hour-&gt;{icon};
}

Which today gives us the dire warning that there's snow coming soon...

    Tue Nov 19 11:00:00 2019 cloudy
    Tue Nov 19 12:00:00 2019 rain
    Tue Nov 19 13:00:00 2019 rain
    Tue Nov 19 14:00:00 2019 rain
    Tue Nov 19 15:00:00 2019 rain
    Tue Nov 19 16:00:00 2019 sleet
    Tue Nov 19 17:00:00 2019 snow
    Tue Nov 19 18:00:00 2019 snow
    Tue Nov 19 19:00:00 2019 snow
    Tue Nov 19 20:00:00 2019 cloudy
    Tue Nov 19 21:00:00 2019 cloudy
    Tue Nov 19 22:00:00 2019 cloudy
    ...

I'll install this on a cron job on the Raspberry Pi that I have sitting hidden in the mass of cables by my desk. I'll have to get it to give me a warning if the snow is coming somehow:

    my @hourly = $forecast-&gt;hourly-&gt;{data}-&gt;@*;
    splice @hourly, 12;  # reduce @hourly to first 12 hours

    use List::AllUtils qw( any );
    if (any { $_-&gt;{icon} eq &#39;snow&#39; } @hours) {
        # turn my lights blue!
        # see http://perladvent.org/2019/2019-12-05        
        use LightFactory;
        $_-&gt;set_color(&#39;blue&#39;) for LightFactory-&gt;new-&gt;items;
    }

Anyway...I'd better go and make sure there's gas for the snowblower.

Christmas Lights

2019-12-05T00:00:00Z

Smart, but Dumb

The lighting system in my house is smart. I can ask Alexa to turn lights on and off, or I can press buttons mounted on my wall to select preselected scenes of lights. Lights come on automatically when it gets dark, and turn off automatically at last thing at night (since, you know, my kids are always leaving their closet lights on.)

But the lights in my house are also dumb. They don't turn on when I wake up in the morning, they don't change their appearance due to whatever's going on in the world. They don't even know to get my attention when I get that all important email!

Right now they look the same all year round. Heck, do they even know it's Christmas time at all?

I can fix all of this though...with Perl.

Phillips Hue Home Bridge

My lights use the peer-to-peer zigbee wireless protocol to relay control messages to each other. Command and control is handled by a Phillips Hue Home Bridge, a small 'puck' shaped device with an ethernet socket in the back that can monitor the zigbee sensors and send out zigbee commands.

The normal way to control the Hue bridge is with the GUI of the Hue app from your smartphone. But anything the smart phone can do you can also do through the Hub's HTTP REST API...and with that, from Perl.

The first step is to find out what the local internal IP address of the Hue Bridge is. If it can talk to the internet the Hue Bridge registers the current internal API it has with the central Phillips servers. You can query them with a simple HTTP JSON API call:

   $ curl https://www.meethue.com/api/nupnp
   [{&quot;id&quot;:&quot;001788fffead6e94&quot;,&quot;internalipaddress&quot;:&quot;192.168.1.2&quot;}]

Sweet. The only other thing we need to do is get any API key we can use to talk to the bridge. This can be achieved by POSTing some JSON to the local Hue Bridge.

    $ curl -X POST -d &#39;{&quot;devicetype&quot;:&quot;perl-interface&quot;}&#39; http://192.168.1.2/api
    [{&quot;error&quot;:{&quot;type&quot;:101,&quot;address&quot;:&quot;&quot;,&quot;description&quot;:&quot;link button not pressed&quot;}}]

Wait, that didn't give us an API key...oh, right, it now wants us to press the button on the top of the hub to prove we're authorized to get a new API key. Let's press it, then try that again:

    curl -X POST -d &#39;{&quot;devicetype&quot;:&quot;perl-interface&quot;}&#39; http://192.168.1.2/api
    [{&quot;success&quot;:{&quot;username&quot;:&quot;xyznl1BwQryLMOhJ3uNPUxnR7eQIwwqrkd5Kt0dd&quot;}}]

Great, that username is our key. With it we can start making API calls:

    curl http://192.168.1.2/api/xyznl1BwQryLMOhJ3uNPUxnR7eQIwwqrkd5Kt0dd/config | json_pp
    {
        &quot;netmask&quot; : &quot;255.255.255.0&quot;,
        &quot;portalstate&quot; : {
            &quot;signedon&quot; : true,
            &quot;incoming&quot; : false,
            &quot;outgoing&quot; : true,
            &quot;communication&quot; : &quot;disconnected&quot;
        },
        &quot;apiversion&quot; : &quot;1.35.0&quot;,
        &quot;backup&quot; : {
            &quot;status&quot; : &quot;idle&quot;,
            &quot;errorcode&quot; : 0
        },
        &quot;portalservices&quot; : true,
        ...

Building a Bridge Class

Messing around with the curl command is going to get tiresome fast, so it's time to break out our Perl code.

First let's start by writing a Bridge class that can handle the basics of talking HTTP to our Hue Bridge.

package Bridge;

use Moo;
use HTTP::Tiny;
use JSON::PP qw( encode_json decode_json );
use experimental 'signatures';

has http_tiny =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;is =&gt; 'ro',
&nbsp;&nbsp;&nbsp;&nbsp;lazy =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;default =&gt; sub { return HTTP::Tiny-&gt;new },
);

has key =&gt; ( is =&gt; 'ro', default =&gt; $ENV{HUE_KEY} );

has ip_address =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;is =&gt; 'ro',
&nbsp;&nbsp;&nbsp;&nbsp;lazy =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;default =&gt; sub ($self, @) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $response = $self-&gt;http_tiny-&gt;get('https://www.meethue.com/api/nupnp');
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;die 'Failed!' unless $response-&gt;{success};
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $result = decode_json($response-&gt;{content});
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return $result-&gt;[0]{internalipaddress};
&nbsp;&nbsp;&nbsp;&nbsp;},
);

# get the data from the URL fragment, and return the parsed JSON (if any)
sub get ($self, $fragment) {
&nbsp;&nbsp;&nbsp;&nbsp;my $url = $self-&gt;_url($fragment);
&nbsp;&nbsp;&nbsp;&nbsp;my $tiny = $self-&gt;http_tiny;

&nbsp;&nbsp;&nbsp;&nbsp;my $response = $tiny-&gt;get($url);
&nbsp;&nbsp;&nbsp;&nbsp;die 'Failed!' unless $response-&gt;{success};

&nbsp;&nbsp;&nbsp;&nbsp;return decode_json($response-&gt;{content})
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if length $response-&gt;{content};
&nbsp;&nbsp;&nbsp;&nbsp;return undef;
}

# turn the URL fragment into a full API URL
sub _url ($self, $fragment) {
&nbsp;&nbsp;&nbsp;&nbsp;return 'http://' . $self-&gt;ip_address . '/api/' . $self-&gt;key
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;. $fragment
}

1;

Let's use a simple script to see it in action

#!/usr/bin/perl

use 5.024;
use warnings;

use Bridge;
use Data::Dumper;

my $bridge = Bridge-&gt;new();
print Dumper $bridge-&gt;get('/lights/1');

This prints out so much information:

$VAR1 = {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'name' =&gt; 'Left office',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'type' =&gt; 'Dimmable light',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'modelid' =&gt; 'LWB014',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'manufacturername' =&gt; 'Philips',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'productid' =&gt; 'Philips-LWB014-1-A19DLv4',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'state' =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'reachable' =&gt; bless( do{\(my $o = 1)}, 'JSON::PP::Boolean' ),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'mode' =&gt; 'homeautomation',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'bri' =&gt; 254,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'alert' =&gt; 'lselect',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'on' =&gt; bless( do{\(my $o = 1)}, 'JSON::PP::Boolean' )
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'uniqueid' =&gt; '00:17:88:01:03:c0:d5:d1-0b',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'swversion' =&gt; '1.46.13_r26312',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'swconfigid' =&gt; '69806BE9',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'capabilities' =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'control' =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'maxlumen' =&gt; 840,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'mindimlevel' =&gt; 2000
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'certified' =&gt; bless( do{\(my $o = 1)}, 'JSON::PP::Boolean' ),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'streaming' =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'renderer' =&gt; bless( do{\(my $o = 0)}, 'JSON::PP::Boolean' ),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'proxy' =&gt; bless( do{\(my $o = 0)}, 'JSON::PP::Boolean' )
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'swupdate' =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'state' =&gt; 'noupdates',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'lastinstall' =&gt; '2019-05-06T18:53:05'
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'config' =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'function' =&gt; 'functional',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'archetype' =&gt; 'classicbulb',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'direction' =&gt; 'omnidirectional',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'startup' =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'configured' =&gt; bless( do{\(my $o = 1)}, 'JSON::PP::Boolean' ),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'mode' =&gt; 'safety'
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'productname' =&gt; 'Hue white lamp'
};

Building Out the Abstraction

Those are quite big data structures! What we need to do is work on an abstraction layer or two that will make working with them easier.

First let's implement a generic Item role for all items. This'll handle the nitty gritty of calling the API to fetch data whenever we want something:

    package Role::Item;

    use Moo::Role;
    use experimental &#39;signatures&#39;;

    use Bridge;

    # we need an &#39;endpoint&#39; method that&#39;ll give us the
    # part of the URL we&#39;re constructing
    requires &#39;endpoint&#39;;

    has bridge =&gt; (
        is =&gt; &#39;lazy&#39;,
        default =&gt; sub { Bridge-&gt;new() },
    );

    has id =&gt; ( is =&gt; &#39;ro&#39; );

    # this is where the data from the server is lazy-loaded via
    # the REST API
    has _data =&gt; (
        is =&gt; &#39;ro&#39;,
        clearer =&gt; &#39;flush_cache&#39;,
        lazy =&gt; 1,
        default =&gt; sub ($self) {
            return $self-&gt;bridge-&gt;get($self-&gt;endpoint.&#39;/&#39;.$self-&gt;id);
        },
    );

    # all things in the Hue API (lights, sensors, rules, etc) have names
    sub name ($self) { $self-&gt;_data-&gt;{name} }

    1;

And we can implement that in a basic Light class:

package Light;

use Moo;
with 'Role::Item';

sub endpoint { '/lights' }

# a few basic facts about the light from the data structure
sub on         ($self) { $self-&gt;_data-&gt;{state}{on} }
sub brightness ($self) { $self-&gt;_data-&gt;{state}{bri} }

1;

Which means we can easily write a script to find the status of a given light:

#!/usr/bin/perl

use 5.024;
use warnings;

use Light;
my $light = Light-&gt;new( id =&gt; shift );
print $light-&gt;name, ' light is ';
say $light-&gt;on ? 'on' : 'off';

So if we happen to know the ID of the light we want to talk to, we can now find out if it's on or not:

    $ ./status 1
    Left office is on

More than one at a time?

Of course, I don't tend to memorize the IDs of all the light bulbs in my house. It'd be much nicer to use the friendly name that we've assigned to the bulb. It'd also be great to pull down all the information for all the bulbs in one go rather than making an individual API call for each.

The Hue Bridge supports this by performing a simple GET request without the id as part of the URL:

    curl http://192.168.1.2/api/xyZnl1BwQryLMNhJ3uNxUxnl7eQIwwqrkd5Kt0dd/lights
    {
    &quot;2&quot; : { ... },
    &quot;4&quot; : { ... },
    &quot;15&quot; : { ... },
    &quot;6&quot; : { ... },
    ...
    }

Each of the keys in this top level object is the id of the light, and each of the values is the exact same JSON data structure that we would have received had we made an individual HTTP call per id.

Let's create a Factory class that can use this API call to make multiple Light objects at once.

First up, the generic Role again:

package Role::Factory;

use Moo::Role;
use experimental 'signatures';

use Bridge;

# we need to know both the URL endpoint *and* the
# name of the class we're constructing
requires 'endpoint', 'item_class';

has bridge =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;is =&gt; 'ro',
&nbsp;&nbsp;&nbsp;&nbsp;lazy =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;default =&gt; sub { Bridge-&gt;new() },
);

has _data =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;is =&gt; 'ro',
&nbsp;&nbsp;&nbsp;&nbsp;clearer =&gt; 'flush_cache',
&nbsp;&nbsp;&nbsp;&nbsp;lazy =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;default =&gt; sub ($self) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return $self-&gt;bridge-&gt;get( $self-&gt;endpoint );
&nbsp;&nbsp;&nbsp;&nbsp;},
);

sub items ($self) {
&nbsp;&nbsp;&nbsp;&nbsp;return $self-&gt;_data_to_items( $self-&gt;_data );
}

sub _data_to_items( $self, $data ) {
&nbsp;&nbsp;&nbsp;&nbsp;return map {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;item_class-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;bridge =&gt; $self-&gt;bridge,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;_data =&gt; $data-&gt;{$_},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;id =&gt; $_
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;)
&nbsp;&nbsp;&nbsp;&nbsp;} keys %{ $data };
}

1;

Note how we're passing the _data into the Light classes. Since we're directly populating those attributes the objects never have to lazily call their default callbacks and don't have to make individual HTTP calls to populate themselves. Neat.

The LightFactory class is tiny:

package LightFactory;

use Moo;
use experimental 'signatures';

use Light;

with 'Role::Factory';

sub endpoint { '/lights' }
sub item_class { 'Light' }

1;

We can now trivially write a script to show the status of all lights in the house:

#!/usr/bin/perl

use 5.024;
use warnings;

use LightFactory;

my $lf = LightFactory-&gt;new;
foreach ($lf-&gt;items) {
&nbsp;&nbsp;&nbsp;&nbsp;print $_-&gt;name . ' light is ';
&nbsp;&nbsp;&nbsp;&nbsp;say $_-&gt;on ? 'on' : 'off';
}

Which prints out some useful information:

    Bottom Studio downlight light is on
    Center Front Room light is on
    Elder&#39;s Overhead 1 light is on
    Elder&#39;s Overhead 2 light is on
    Elder&#39;s&rsquo;s Closet light is off
    Left Front Room light is on
    Left Studio Rooflight light is on
    Left office light is on
    Library by Computer light is on
    Main door left light is on
    Main door right light is on
    Middle downlight studio light is on
    Right office light is on
    Right studio Rooflight light is on
    South light is off
    Top Downlight Studio light is on
    Upstairs Studio light is on
    West light is on
    Younger&#39;s Closet light is off
    Younger&#39;s overhead 1 light is on
    Younger&#39;s overhead 2 light is on

Hmm. I need to turn some lights off.

Turning the lights off

Reading information about lights is all very well, but we want more control than that.

If we look at our light data structure we can see the state key are some values we'd like to change:

$VAR1 = {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;...
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'state' =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'reachable' =&gt; bless( do{\(my $o = 1)}, 'JSON::PP::Boolean' ),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'mode' =&gt; 'homeautomation',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'bri' =&gt; 254,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'alert' =&gt; 'lselect',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'on' =&gt; bless( do{\(my $o = 1)}, 'JSON::PP::Boolean' )
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;...

Specifically we'd like to change the on value to false.

Making changes with the Hue Bridge is easy - you just have to PUT data instead of GETing it.

    curl -X PUT \
         -d &#39;{&quot;on&quot;:false} \
         http://192.168.1.2/api/xyznl1BwQryLMOhJ3uNPUxnR7eQIwwqrkd5Kt0dd/lights/1/state

There's two notable things about this curl command. Firstly, note the /state at the end of the URL, meaning we're changing the state key within the lights/1 object. Secondly, note that we're not specifying all the keys in the JSON we're putting to this URL - any key we don't mention will be unchanged.

So, we want to do this from Perl space. Let's add a put method to our Bridge class:

sub put ($self, $fragment, $data) {
&nbsp;&nbsp;&nbsp;&nbsp;my $url = $self-&gt;_url($fragment);
&nbsp;&nbsp;&nbsp;&nbsp;my $tiny = $self-&gt;http_tiny;

&nbsp;&nbsp;&nbsp;&nbsp;$tiny-&gt;request('PUT', $url, { content =&gt; encode_json($data) });
}

And then to the Lights class add a _set_state method that will take a hashref of new state options

sub _set_state( $self, $new_state ) {
&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;bridge-&gt;put(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;join ('/', $self-&gt;endpoint, $self-&gt;id,'state'),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$new_state,
&nbsp;&nbsp;&nbsp;&nbsp;);
}

Now we can write some quick wrappers to turn lights on and off easily:

    sub turn ($self, $new) {
        my $value = defined($new) &amp;&amp; $new &amp;&amp; $new !~ /^off$/i ?
            JSON::PP::true : JSON::PP::false;
        $self-&gt;_set_state({ on =&gt; $value } );
    }
    sub turn_on($self)  { $self-&gt;turn(&#39;on&#39;)  };
    sub turn_off($self) { $self-&gt;turn(&#39;off&#39;) };

Let's save some electricity!

$_-&gt;turn_off foreach LightFactory-&gt;new-items;

Christmas Lights

On and off is all very good, but these lights are more capible than that. They can be set to arbitary brightness levels, and the more advanced ones can be set to any color.

Since it's Christmas, let's use this ability to make some christmas lights.

In order to set the color of the lights we're going to need to work out the hue, saturation, and lightness rating for the colors we want to use. To do this we're going to use the Convert::Color module from the CPAN, specifically by creating a Convert::Color::VGA instance from the name of the color we want to use and then converting it into an Convert::Color::HSL instance.

Let's wrap that up in a handy method inside the Light class:

sub set_color($self, $color_name) {
&nbsp;&nbsp;&nbsp;&nbsp;my $hsl = Convert::Color::VGA-&gt;new( $color_name )
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;convert_to('hsl');

&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;_set_state({
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;hue =&gt; int( $hsl-&gt;hue/360*65535 ),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sat =&gt; int( $hsl-&gt;saturation*254 ),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;bri =&gt; int( $hsl-&gt;lightness*254 ),
&nbsp;&nbsp;&nbsp;&nbsp;})
}

Now we can finally write a simple script to get the lights to change in a Christmassy way:

#!/usr/bin/perl

use 5.024;
use warnings;

use LightFactory;

my %all_lights = map {
&nbsp;&nbsp;&nbsp;&nbsp;$_-&gt;name =&gt; $_
} LightFactory-&gt;new-&gt;items;

# I really should have done a more consistent job of naming these
my @lights = @all_lights{
&nbsp;&nbsp;&nbsp;&nbsp;&quot;Bottom Studio downlight&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&quot;Middle downlight studio&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&quot;Top Downlight Studio&quot;,
};

while (1) {
&nbsp;&nbsp;&nbsp;&nbsp;$lights[0]-&gt;set_color('red');
&nbsp;&nbsp;&nbsp;&nbsp;$lights[1]-&gt;set_color('green');
&nbsp;&nbsp;&nbsp;&nbsp;$lights[2]-&gt;set_color('red');
&nbsp;&nbsp;&nbsp;&nbsp;sleep 1;

&nbsp;&nbsp;&nbsp;&nbsp;$lights[0]-&gt;set_color('green');
&nbsp;&nbsp;&nbsp;&nbsp;$lights[1]-&gt;set_color('red');
&nbsp;&nbsp;&nbsp;&nbsp;$lights[2]-&gt;set_color('green');
&nbsp;&nbsp;&nbsp;&nbsp;sleep 1;
}

Going for Perl

2019-12-04T00:00:00Z

Go On

Many people thought that Wise Old Elf, being, well, old, wouldn't be much for these brand new programming languages. But, they forget... the Wise Old Elf isn't just Old, he is Wise too. So he knew that you have to use the best tool for the job.

More recently the Wise Old Elf had been running a small team of elves that had been experimenting with writing some of their more speed critical code in Go. Previously at the North Pole they'd resorted to using C code - often called via Inline::C - when their beloved Perl just wasn't fast enough. But they'd had a lot of problems with that - dealing with memory management, having to often delve into the dark arts of XS coding, so the Wise Old Elf had started his experiment with something a little more modern.

And thus the Wise Old Elf suddenly found himself with a bunch of Go code that he would love the main North Pole codebase to be able to make use of without having to rewrite any of their battle-tested Perl code in Go. What he really needed was a way to call the new Go code from within Perl.

Shared Library Time

The Wise Old Elf decided he should have an experiment of his own. So he set himself a challenge: Write some trivial Go code and get it executed from within Perl.

Go is perfectly capable of producing a shared library. Here's a "Hello, World" type example for this time of the year.

package main

import &quot;fmt&quot;

func main() {
&nbsp;&nbsp;&nbsp;&nbsp;WishMerryChristmas()
}

func WishMerryChristmas() {
&nbsp;&nbsp;&nbsp;&nbsp;fmt.Println(&quot;We wish you a Merry Christmas&quot;);
}

To make this into a shared library we need to make a few scant changes.

Add an import "C" statement

Empty out the main() func

Add //export decorators on what we want to export

Even with these changes the code looks mostly the same:

package main

import &quot;C&quot;

import &quot;fmt&quot;

func main() {}

//export WishMerryChristmas
func WishMerryChristmas() {
&nbsp;&nbsp;&nbsp;&nbsp;fmt.Println(&quot;We wish you a Merry Christmas&quot;);
}

We can now compile this on the command line

    $ go build -o merrychristmas.so -buildmode=c-shared
    $ ls merrychristmas*
    -rw-r--r-- 1 wiseold wiseold 1.3K Nov 19 00:27 merrychristmas.h
    -rw-r--r-- 1 wiseold wiseold 2.0M Nov 19 00:27 merrychristmas.so

We've got two new files, the header file (the merrychristmas.h) and the shared object file (the merrychristmas.so file.) We can safely discard the header file since we're not going to use the traditional C linking route here - we're going to use one of Perl's excellent Foreign Function Interface libraries to access the shared object instead.

As an aside you'll notice that merrychristmas.so is huge for a library that has a single function that prints a simple string in it. That's because it's not just that - it also contains all of the Go runtime and packages also! We're able to distribute that shared object along with our Perl code without any other Go scaffolding or support files.

Bring On The Platypus

So, now we have a shared object from our Go code, how can we access it from Perl? With FFI::Platypus of course!

#!/usr/bin/perl

use strict;
use warnings;

# load our chosen FFI interface module
use FFI::Platypus;

# configure it to talk to our shared object library
my $ffi = FFI::Platypus-&gt;new( api =&gt; 1 );
$ffi-&gt;lib( './merrychristmas.so' );

# bind the exported &quot;WishMerryChristmas&quot; to the
# &quot;WishMerryChristmas&quot; function in Perl space, and
# declare that it takes no args and returns nothing
$ffi-&gt;attach(WishMerryChristmas =&gt; []);

# call it!
WishMerryChristmas();

And does it work?

    $ perl merry.pl 
    We Wish You a Merry Christmas

It's a Christmas miracle!

In, Out, Shake It All About

Okay, so how about something more complicated. Let's modify the go function to print out the message a number of times:

//export WishMerryChristmas
func WishMerryChristmas(n int) {
&nbsp;&nbsp;&nbsp;&nbsp;for i := 0; i &lt; n; i++ {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;fmt.Println(&quot;We wish you a Merry Christmas&quot;);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
}

Now in our Perl script we can modify it to specify that we can pass in an argument:

$ffi-&gt;attach(MerryChristmas =&gt; ['long']);
WishMerryChristmas(3);
print &quot;And a Happy New Year\n&quot;;

And that works:

    $ perl merry.pl
    We wish you a Merry Christmas
    We wish you a Merry Christmas
    We wish you a Merry Christmas
    And a Happy New Year

But hang on, why did we specify long when we declared WhichMerryChristmas to take an int? That's because we're not specifying the Go type to FFI::Platypus, but the C type. And a Go int is represented by a C long.

We can make this a whole lot clearer if we teach FFI::Platypus about a type alias for Go ints:

# declare a type alias
$ffi-&gt;type( long =&gt; 'go_int' );

# then make use of it idiomatically when we attach
$ffi-&gt;attach(MerryChristmas =&gt; ['go_int']);

This mismatch between C types and Go types becomes even clearer if we change our function to take a string:

//export WishMerryChristmas
func WishMerryChristmas(who string) {
&nbsp;&nbsp;&nbsp;&nbsp;fmt.Printf(&quot;We wish you a Merry Christmas, %s\n&quot;, who);
}

And then naively call it from Perl:

# this code is wrong...
$ffi-&gt;attach(WishMerryChristmas =&gt; ['string']);
WishMerryChristmas('Santa');

We get junk out:

    $ perl merry.pl 
    We wish you a Merry Christmas, SantapV

That's because we're calling the Go code with a C string (i.e. a null terminated array of bytes) rather than the Go string structure it expects which should look somewhat like this in C space:

typedef struct{const char *p; go_int len;} go_str;

A Record Solution

There's several approaches we can take to help cross the divide. The simplest solution is to define in Perl space a wrapper for the struct we need to pass in

package GoString;
use FFI::Platypus::Record;

# this is the same as
# typedef struct{const char *p; go_int len;} go_str;
record_layout_1(
&nbsp;&nbsp;&nbsp;&nbsp;'string rw' =&gt; 'p',
&nbsp;&nbsp;&nbsp;&nbsp;'long'      =&gt; 'len',
);

&nbsp;
&nbsp;And now with a suitable argument declaration we can call it from Perl

#!perl
$ffi-&gt;attach(WishMerryChristmas =&gt; ['record(GoString)']);
my $stirng = 'Santa';
my $go_string = GoString-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;p =&gt; $string,
&nbsp;&nbsp;&nbsp;&nbsp;len =&gt; length($string),
);
WishMerryChristmas($go_string);

We finally get the output we wanted all along:

    $ perl merry.pl 
    We wish you a Merry Christmas, Santa

We can further simplify this by passing the attach method a wrapper function that does the conversion for us:

$ffi-&gt;attach( WishMerryChristmas =&gt; ['record(GoString)'] =&gt; 'void', sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $real_function = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $string = shift;

&nbsp;&nbsp;&nbsp;&nbsp;$real_function-&gt;(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;GoString-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;p =&gt; $string,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;len =&gt; length($string),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;)
&nbsp;&nbsp;&nbsp;&nbsp;)
});

WishMerryChristmas('Santa');

So a Merry Christmas to you too - from multiple programming languages!

Two Factor Elfication

2019-12-03T00:00:00Z

Day three.

Day three of piles of presents where there shouldn't be.

Day three of the hackers breaking into the North Pole systems.

Enough was enough. Yes, they'd compromised Pepper's account for the third day running, but Butters Jollycane was completely done with trying to get his hapless colleague to protect his password - it was a lost cause. Today was going to be the last day that anyone getting access to an Elf's password was going to allow them access to all of the North Pole systems. Jollycane was going to configure their system for Two-Factor Authentication.

2FA

Two Factor Authentication simply means that you have a second factor that you use for authentication. Typical factors include things that you know (passwords, security questions,) things that you have (dongles or apps that create unguessable time-based sequences) or things that you are (biometrics.)

Jollycane wasn't able to add finger print or retinal scanners for the elves, so he was going to have to rely on the elves having something they knew (their password) and something they had.

By My OATH They Won't Get In

Jollycane needed a solution that he could implement in the next few hours. No time to ship devices to all the elves. He'd have them make use of their company issued cell phones for now.

Google Authenticator is one of many smart-phone apps that implement the One Time Password algorithms as defined by the open OATH specification in order to act as a second factor. In short, every thirty seconds the app displays a new six digit code which the user has to enter when logging in in addition to the password.

There's a shared secret known only to the website and the authenticator app. Both the app and the server run the same algorithm based upon the current time and the shared secret. If the code the user copies from their phone matches the server's expected value then authentication occurs.

use Authen::OATH ();
use Convert::Base32 qw( decode_base32 );

my $oath = Authen::OATH-&gt;new;
my $secret = 'mySecret';
my $otp = $oath-&gt;totp(  decode_base32( $secret ) );

if ($the_code_the_user_entered eq $otp) {
&nbsp;&nbsp;&nbsp;&nbsp;say &quot;ACCESS GRANTED&quot;;
} else {
&nbsp;&nbsp;&nbsp;&nbsp;say &quot;HACKER ALERT WHOOP WHOOP&quot;;
}

Passing Secrets

Jollycane needed a way to allow his elves to configure their authenticator apps. The most common way to do this is to create a QR code (a "2d barcode") that uses the otpauth url scheme. Google Authenticator allows users to "scan" this QR code with their phone's camera.

Crating these in Perl is actually quite straight forward once you know the format the URL should be in

my $qrcode = HTML::QRCode-&gt;new;
my $html = $qrcode-&gt;plot(
&nbsp;&nbsp;&nbsp;&nbsp;'otpauth://totp/'                        # URI standard
&nbsp;&nbsp;&nbsp;&nbsp;. 'pfrostyflakes@northpole.example.com'  # label
&nbsp;&nbsp;&nbsp;&nbsp;. '?secret='. decode_base32( $secret )   # secret
&nbsp;&nbsp;&nbsp;&nbsp;. '&amp;issuer=North+Pole'                   # issuer
);

This outputs a bunch of HTML that when rended by a browser looks like:

Hopefully that would be good enough to finally keep these kids out!

Have Elf Been Pwned?

2019-12-02T00:00:00Z

Mess with the Best...

Butters Jollycane silently cursed. The piles of presents from yesterday were back. Each of the hackers had, if anything, larger piles of gifts waiting to go out than they'd had the day before - even though they were meant to be on the naughty list.

This could only mean one thing: Somehow that Dade Murphy kid had got back into the system despite Jollycane's efforts yesterday to make sure everyone was now using sufficiently strong passwords hasn't been enough.

He checked the logs. Yep, they'd got in using Pepper's account again.

...Get Hacked Like The Rest

"I don't understand it", Pepper explained, "that zxcvbn doohicky you made yesterday said the password was fine"

"Okay, okay...let's see the new Post-it note."

"Oh I didn't write it down this time", Pepper beamed, "I can remember it! After all it's one of the passwords I've been using for years!"

"Wait, you use the same password on other sites?"

"Oh yes. Very secure it is. I've never had a problem with it...I use it for all my accounts"

Jollycane inwardly sighed.

Have I Been Pwned?

Credential reuse on websites is a real problem. No matter how secure you make your website, if an elf reuses a username or password that they've used on another website and that website gets hacked, it can spell doom and gloom for your security. People who are most definitely on Santa's naughty list regularly distribute lists of these stolen credentials. All Dade Murphy had to do was download a copy of these lists and see if the same compromised username and password that Pepper had used on Elf Single Mingles would allow him to login to Santa's workshop using Pepper's account.

Jollycane quickly pulled up the Have I Been Pwned? website and tapped in Pepper's account details.

Have I Been Pwned keeps a copy of all of the well known lists of stolen credentials and allows people to check if their credentials have been exposed (if you haven't done so recently you might want to check out your email address on there right now!) Looking at the screen Jollycane could see numerous places where Pepper's account had been broken into on other sites.

Password Reuse Avoidance?

Jollycane would send out an all workshop email instructing everyone to not reuse their passwords on any other websites. But how could he enforce that?

Believe it or not, Have I Been Pwned? has an API for that, or rather they have an API that'll let you work out if a password has been included anywhere in any of the well known published password breaches.

Using the API is slightly more complicated than a normal REST API but WebService::HIBP abstracts away the details:

my $hibp = WebService::HIBP-&gt;new();
for my $password (
&nbsp;&nbsp;&nbsp;&nbsp;'santa',
&nbsp;&nbsp;&nbsp;&nbsp;'Merry Christmas',
&nbsp;&nbsp;&nbsp;&nbsp;'All I want For Christmas is Yoooooooooou',
) {
&nbsp;&nbsp;&nbsp;&nbsp;say &quot;$password was breached &quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$hibp-&gt;password( $password ),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot; times&quot;;
}

Which shows us just how bad the elves choices are:

    santa was breached 10898 times
    Merry Christmas was breached 7 times
    All I want For Christmas is Yoooooooooou was breached 0 times

But wait, how does it do that without sending HIBP the passwords to check? It obviously doesn't download the terabytes of exposed data each time it checks.

In a word: Hashing. The module creates a one-way hash of the password and then sends just the first few characters of the hash to HIBP via the API (you wouldn't want to send the whole hash because that means HIBP could theoretically brute force the password.) HIBP returns a list of hashes of all compromised passwords that hashes also start with those same characters. The module can then check if the hash of the original password is contained in that list, and if it is, then blammo - the password was compromised.

Another Day

With Website::HIBP Jollycane had plugged another hole. But he was worried. He thought he was done yesterday...but he had a sneaking suspicion that he wasn't quite done with his battle with these particular brats.

J1ngle? No...zxcvbn

2019-12-01T00:00:00Z

Zero Cool Situation

Butters Jollycane stared up in amazement at the towering piles of gifts before him. Never before has he seen such large piles of presents for so few people. There was one pile for "Dade Murphey", another for "Kate Libby" and another for someone with the dubious name of "Cereal Killer".

What's worse, up until a week ago these people had been scheduled for a coal delivery, after a prank they'd been involved in with taking over some automated office lights in a tower block to display dubious messages had got them assigned to the naughty list. So why had Pepper Frostyflakes over in accounting used his login to assign them such lavish gifts at 3am this morning?

Hack The Planet!

"I was asleep in my bed at three am this morning!", Pepper exclaimed, "Do I look like an Elf on the Shelf, up all night long? I need my beauty sleep".

"And your password is secure?", Jollycane asked.

"It's locked away right here, where it always is", Pepper replied as he unlocked his desk draw and pulled out a dog-eared post-it note. "I wrote it down and locked it away because of the silly password rules you tech Elfs put in place - you know, with the numbers and uppercase and lowercase and weird punctuation you guys always want."

Pepper flipped over the post it note which had just one word written on it: J1ngle?

Jollycane's jaw dropped. It was obvious that not only had they been hacked by some young miscreants, but they'd done it just by guessing Pepper's super simple password.

Never fear, zxcvbn is here

Jollycane thought for a minute if he should give Pepper the same lecture he'd given the last six elves that had had their password guessed by mischievous agents. It's not enough to switch an 1 for an i or uppercase the first letter. It's just a simple matter of programming to try those basic transformations too. But Pepper had followed the policy...maybe it was time for a change.

What Jollycane needed was some way to rate the passwords users were using. Luckily, Dropbox has been working on this problem and published their zxcvbn algorithm that can do just that. And there's a Perl implementation on the CPAN, Data::Password::zxcvbn.

#!/usr/bin/perl

use 5.024;
use warnings;

use Data::Password::zxcvbn qw( password_strength);
my $result = password_strength($ARGV[0]);

The result is a hashref that contains a lot of useful information about the strength of the password. At the most basic we have the score:

my @passwords = (
&nbsp;&nbsp;&nbsp;&nbsp;'password',
&nbsp;&nbsp;&nbsp;&nbsp;'p@ssword',
&nbsp;&nbsp;&nbsp;&nbsp;'J1ngle?',
&nbsp;&nbsp;&nbsp;&nbsp;'horse staple battery generator',
&nbsp;&nbsp;&nbsp;&nbsp;'B2aFkgEhZvFstE9',
);
foreach my $password (@passwords) {
&nbsp;&nbsp;&nbsp;&nbsp;my $result = password_strength( $password );
&nbsp;&nbsp;&nbsp;&nbsp;say &quot;$result-&gt;{score} $password&quot;;
}

This goes from 0 (never use) to 4 (as secure as the algorithm can figure).

    0 password
    0 p@ssword
    1 J1ngle?
    4 horse staple battery generator
    4 B2aFkgEhZvFstE9

What does that mean in a practical sense? Well, since Santa's workshop hasn't implemented any rate limiting on their website logins (ooops, they should really do that) the hackers can probably make, say, oh, ten requests a second to try and log in. How long would it take for each of the passwords to be broken?

use Time::Duration qw( duration );
foreach my $password (@passwords) {
&nbsp;&nbsp;&nbsp;&nbsp;my $result = password_strength( $password );
&nbsp;&nbsp;&nbsp;&nbsp;my $duration = duration(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$result-&gt;{crack_times_seconds}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;{online_no_throttling_10_per_second}
&nbsp;&nbsp;&nbsp;&nbsp;);
&nbsp;&nbsp;&nbsp;&nbsp;say &quot;$password would be cracked $duration&quot;;
}

Which means:

    password would be cracked just now
    p@ssword would be cracked just now
    J1ngle? would be cracked 9 hours and 33 minutes
    horse staple battery generator would be cracked 2475117468353 years and 229 days
    B2aFkgEhZvFstE9 would be cracked 3170979 years and 72 days

Okay, that really brings it home the difference in password security! Jollycane should implement a rule that no password with a score less than four can be used.

But how can he do that? We've obviously established that simple rules that users (and hackers!) can easily follow don't help matters. What users need is some interactive feedback about why the passwords they're trying to use aren't secure, and what they should do to improve them. password_strength provides help with that too:

foreach my $password (@passwords) {
&nbsp;&nbsp;&nbsp;&nbsp;my $result = password_strength( $password );
&nbsp;&nbsp;&nbsp;&nbsp;next if $result-&gt;{score} &gt; 3;

&nbsp;&nbsp;&nbsp;&nbsp;say &quot;# $password&quot;;

&nbsp;&nbsp;&nbsp;&nbsp;my $feedback = $result-&gt;{feedback};
&nbsp;&nbsp;&nbsp;&nbsp;say &quot;WARNING: $feedback-&gt;{warning}&quot;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if $feedback-&gt;{warning};
&nbsp;&nbsp;&nbsp;&nbsp;say &quot;* $_&quot; foreach $feedback-&gt;{suggestions}-&gt;@*;

&nbsp;&nbsp;&nbsp;&nbsp;say &quot;&quot;;
}

This gives us output we can show the end user:

    # password
    WARNING: This is a top-10 common password
    * Add another word or two. Uncommon words are better.

    # p@ssword
    WARNING: This is similar to a commonly used password
    * Predictable substitutions like &#39;@&#39; instead of &#39;a&#39; don&#39;t help very much
    * Add another word or two. Uncommon words are better.

    # J1ngle?
    * Capitalization doesn&#39;t help very much
    * Predictable substitutions like &#39;@&#39; instead of &#39;a&#39; don&#39;t help very much
    * Add another word or two. Uncommon words are better.

Rollout

Jollycane rolled out the new policy and got all his users to change their passwords. Hopefully that would be enough to keep out those undeserving hooligans....at least until tomorrow....

Perl Advent Calendar 2019

Enjoy Christmas

Ladies and Gentlemen of Christmas 2019

We Wish You a Meme Christmas

Imager

Testing our Impatience

The Tests in Question

Faster

Faster Still

Comparing More

Writing a Test2::Tools Class

Writing a Custom Comparison

Embracing The Negative

Comparatively Good

Test2: Test Harder (but easier)

Making the Easy Stuff Easy: Strictness, Warnings and UTF8

Deep Testing

Exception Checking

Subtests

And More

Controlling your Terminal with Perl

Are We Nearly There Yet?

Clickable Links

Clickable Recognizable Text

Triggers

Complete Control

Syncing our lib directory

Conclusion

Memories of Past Lives

A Blast from the past.

Persisting between program runs

Methods

In Conclusion

P.S. You can Leave it in the production code

Core Strength

Streching our Core Muscles

Beyond a Core Workout

Keep Working It

Taking the Sleigh to a CloudFront

Bundling Mojolicious

Connecting Lambda to Mojolicious

Configuring Cloudfront

Making the Paths Work

A live test

Paws to Plan What Todo

Permissions

Writing The Perl Code

Suddenly Serverless

AWS Lambda

Do It Quickly

The Actual Coding

Complexity

CPAN to the Rescue!

Animated GIFs

Draft Solution

Productivity

And now for something somewhat unrelated.

A different kind of serverless

Writing the &#39;server&#39; script

PSGI

Using a more advanced framework

Back to the Draft

Now With Added Interactivity

Introducing GUIDeFATE

But I liked the Browser!

A More Complex Example

Now With Added Interactivity

Under the Hood

Writing Something More Powerful

Awaiting Christmas

A Blocking Solution

Callbacks

Promises

Async and Await

Command Line Browser Apps

The Plan

The Start of our Web Application

Picking a Random Port

Opening The Page Automatically

Quitting Time

Syncing our `lib` directory

Writing the 'server' script

Show Me Mo'

By My OATH They Won't Get In