Perl Advent Calendar 2017

Merry Christmas!

2017-12-25T00:00:00Z

Merry Christmas Everybody!

This year marks the 18th year the Perl Advent Calendar has been published. Who'da thought all those years ago when I came up with a silly idea at a Perl Mongers' social event we'd still have interesting and exciting things to talk about eighteen years on?

But interesting things to cover we have! This year we've featured articles - in a rather joking fashion - on lots of core technologies that make Perl an ever better and improving language. We've talked about improvements to the core of Perl, Moose and it's vast array of extensions that can make your life easier, we've discussed Perl's amazing Unicode handling - one of the best languages out there for complicated handling - and we've covered tools to help you improve your programming from digging into your memory usage to validating your code with custom Perl Critic rules. We've even covered a bunch of handy little utility modules to allow you to create interactive terminal programs or quickly craft one liners that can grab and manipulate web pages and JSON data.

A lot has improved in the last eighteen years in Perl and every year I continue to learn new techniques and new tools that make my life easier and better.

So thanks to everyone that has been reading, and everyone who has written the modules, tools, and improvements to Perl that I get to talk about each year.

Happy Holidays!

Watching The Perl Conference

2017-12-24T00:00:00Z

Now Christmas was over, the Wise Old Elf was going to go sit on a beach (in the southern hemisphere, where it was summer) and kick back with some quality eggnog.

Of course, the Wise Old Elf doesn't get to be wise by sitting on his laurels, so he was going to take the oppuntinty to catch up with all the videos of the presentations from The Perl Conference 2017 DC on YouTube.

The only problem with his plan was that the beach he had in mind didn't have very good WiFi. So he decided to try and download all the videos to his laptop first. Maybe Perl couyld help him with that?

Scraping the playlist

Since he had learned about ojo it was easy for the Wise Old Elf to write something that would scrape the playlist webpage and print out, one line at a time, the URLs for the various videos in the playlist

    perl -Mojo -E \
      &#39;g(shift)-&gt;dom(&quot;.pl-video-title-link&quot;)-&gt;map(sub{say $_-&gt;attr(&quot;href&quot;)})&#39; \
      &#39;https://www.youtube.com/playlist?list=PLA9_Hq3zhoFxdSVDA4v9Af3iutQxLI14m&#39;

WWW::YouTube::Download

Now the Wise Old Elf had to write some code to parse the web page for each youtube video and then write some more code to download the video. Before he spent a lot of time doing that, he realized he could simply search the CPAN for such a utility. He not only found the wonderful WWW::YouTube::Download module, but also the youtube-download command line utility that shipped with it.

The way the command line utility works is simple; You pass youtube-download a URL and it downloads the video into the current directory. For example to download Dave Rolsky's lightning talk the Wise Old Elf would simply have to type:

    youtube-download /watch?v=DVKfBV2xngg

But how would the Wise Old Elf run youtube-download for each URL? With xargs!

   perl -Mojo -E \
     &#39;g(shift)-&gt;dom(&quot;.pl-video-title-link&quot;)-&gt;map(sub{say $_-&gt;attr(&quot;href&quot;)})&#39; \
     &#39;https://www.youtube.com/playlist?list=PLA9_Hq3zhoFxdSVDA4v9Af3iutQxLI14m&#39;\
     | xargs -n 1 youtube-download

The standard unix xargs command line tool takes arguments on STDIN - one command line argument per line - and runs the utility (in this case youtube-download) with those arguments. By specifying -n 1, xargs will run youtube-download with one argument (i.e. will run youtube-download with each URL passed to it on STDIN.)

All Done

    --&gt; Working on oka4wcsrg0c
    Downloading `oka4wcsrg0c.mp4`
    126211392/126211392 (100.00%)
    Download successful!
    --&gt; Working on DVKfBV2xngg
    Downloading `DVKfBV2xngg.mp4`
    42843944/42843944 (100.00%)
    Download successful!
    --&gt; Working on vQ5qWey_SO4
    Downloading `vQ5qWey_SO4.mp4`
    36677196/36677196 (100.00%)
    Download successful!

A few minutes later - the North Pole has very good Internet - all the videos were downloaded to the Wise Old Elf's computer. Now all he had to do was go stock up on the sunblock!

Speedy Validation

2017-12-23T00:00:00Z

Cheerful Candytree had just pulled an all-nighter trying to track down an elusive bug in the code. For some reason the code that loaded the sled was getting stuck, not returning anything.

sub load_sled {
&nbsp;&nbsp;&nbsp;&nbsp;my $self         = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $present_name = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $qty          = shift // 1;

&nbsp;&nbsp;&nbsp;&nbsp;my $present = $self-&gt;get_present( $present_name )
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;or die &quot;Unknown present: $present_name&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;my $sled = $self-&gt;sled;

&nbsp;&nbsp;&nbsp;&nbsp;while ($qty != 0) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$qty--;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$present-&gt;add_to_sled( $sled );
&nbsp;&nbsp;&nbsp;&nbsp;}
}

Looks good, doesn't it? So why did it never terminate? After much much head scratching Cheerful tracked it down to a little addition some cheeky little elves had snuck in:

# Load inflight movies!
$loader-&gt;load(22, $movie);

Apparently the couple of dozen elves that accompanied Santa on his trip get bored during the long flight over the Atlantic and had decided to load twenty-two copies of a movie to put in their portable DVD players (presumably a couple were still helping steer.)

Since they'd snuck this in without code review, they'd somehow managed to mix up the argument orders. And the movie they'd picked? The 2006 Milla Jovovich film .45. Not being an integer number, and therefore never reaching zero when it was decremented, the sleigh loader had tried to load an infinite number of copies of Taylor Swift's hit single 22 instead. Ooops.

The problem was quickly solved with (a) Swapping the order of the parameters in the code and (b) Giving the offending elves a severe talking to.

Parameter Validation

Cheerful knew that once this bug had occurred once, it was likely to happen again. The first step was to switch to named parameters throughout the codebase:

$loader-&gt;load( qty =&gt; 22, present_name =&gt; $movie );

sub load_sled {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my %p    = @_;

&nbsp;&nbsp;&nbsp;&nbsp;my $present_name = $p{present_name} or die &quot;No present name&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;my $qty          = $p{qty} // 1;

&nbsp;&nbsp;&nbsp;&nbsp;...

Now at least the parameters can't get mixed up! But there's still the chance that $qty would contain an non-interger. Cheerful would really like an exception to be thrown rather than going into a never ending loop.

Maybe we could validate those parameters? The old venerable module for doing this is Params::Validate, which we originally covered in the Perl Advent Calendar over fifteen years ago.

use Params::Validate qw( validate );

sub load_sled {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my %p    = validate( @_, {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;present_name =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;regex    =&gt; qr/./,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;qty          =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;regex    =&gt; qr/\A[1-9][0-9]*$/,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;optional =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;);

&nbsp;&nbsp;&nbsp;&nbsp;my $present_name = $p{present_name};
&nbsp;&nbsp;&nbsp;&nbsp;my $qty          = $p{qty} // 1;

&nbsp;&nbsp;&nbsp;&nbsp;...

Speed Concerns

There's a couple of key problems with using Params::Validate:

Slow to run. Params::Validate can be pretty slow. Not only does it have to validate the arguments each time load_sled is called, it also has to parse the arguments to validate and work out exactly how it has to validate the arguments. Every. Single. Time.
Slow to write. There's a lot of code inside the parameters to validate, none of which is particularly easy to independently test, or after it's written, easy to understand without having to re-read all the code. Our Moose and Moo attributes support a rich reusable type system for validating values, it would be awesome if we could re-use that code to avoid re-writing anything and provide clarity of intent on what the validation system is doing.

In order to address these issues Dave Rolsky wrote a new module called Params::ValidationCompiler. Let's see it in action in Candytree's codebase:

use Params::ValidationCompiler qw( validation_for );
use MooseX::Types::Common::String qw( NonEmptySimpleStr );
use MooseX::Types::Common::Numeric qw( PositiveInt );

my $validator = validation_for(
&nbsp;&nbsp;&nbsp;&nbsp;params =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;present_name =&gt; { type =&gt; NonEmptySimpleStr },
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;qty          =&gt; { type =&gt; PositiveInt, default =&gt; 1 },
&nbsp;&nbsp;&nbsp;&nbsp;},
);

sub load_sled {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my %p    = $validator-&gt;(@_);

&nbsp;&nbsp;&nbsp;&nbsp;my $present_name = $p{present_name};
&nbsp;&nbsp;&nbsp;&nbsp;my $qty          = $p{qty};

Firstly, you'll notice that Params::ValidationCompiler is using Moose types for it's validation routines (though it'll accept Type::Tiny or Specio types as well if you're using those in your codebase instead.) This means that the code is significantly more readable than it was before, and Cheerful has a lot less code to write, maintain, and edge cases to test.

Secondly, you'll note that assigning default values has moved within the realm of the validation routine, meaning we don't have to mess around with that stuff when we're extracting our values from the hash. While we could have also done similar default handling with Params::Validate, the reason this becomes really useful with Params::ValidationCompiler is when we use the named_to_list option to skip the intermediate hash altogether:

my $validator = validation_for(
&nbsp;&nbsp;&nbsp;&nbsp;params =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;present_name =&gt; { type =&gt; NonEmptySimpleStr },
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;qty          =&gt; { type =&gt; PositiveInt, default =&gt; 1 },
&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;named_to_list =&gt; 1,
);

sub load_sled {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my ($present_name, $qty) = $validator-&gt;(@_);

The validator now returns the extracted values in the order in which they were specified in validation_for.

The third and most striking change is that we've split the validation compiling out from the actual call for validation. It's now a two step process - first compile a validator when we first load our code up, once and only once, and then execute it when the subroutine is called. This is significantly quicker.

One of the reasons that this is much quicker is because Params::ValidationCompiler actually compiles a validator, not just builds one. Under the hood it uses Eval::Closure (as we discussed earlier in the month) to build Perl source code to make the fastest possible validator that validates the configuration that it was called with without introducing any extranious logic or subroutine calls. It's even able to take advantage of the inlinable Moose types - Moose types that can themselves return Perl source code to implement their type checking - to bake-in that type checking directly inside that subroutine. This essentially means that Params::ValidationCompiler is as fast as if you'd hand-coded a subroutine with logic to explicitly check the arguments.

To Bed, Perchance to Dream

Now the code was protected from crazy elves, Cherry Candytree was going to take a well earned kip. Hopefully by the time he awoke they wouldn't have found another creative way to break things.

Custom Relationships with DBIx::Class

2017-12-22T00:00:00Z

Today we pick up our story from yesterday where Chestnut Emberflakes was working at break-neck speed to produce a tool that could be used to track the missed deliveries - which needed to be done before Santa completed his current orbit of the planet so he could immeditately head out with a list of what he needed to redo!

The next requirement to be dropped in Emberflakes' lap was that the system needed a classification system to tag each missed delivery with one or more reasons why the delivery was missed. This way when re-delivery was attempted Santa would know what to expect and how to overcome the issues.

No problem, thought Chestnut, as he added a little more SQL:

    CREATE TABLE reason (
        child_id UUID NOT NULL,
        tag TEXT NOT NULL,
        notes TEXT
    );

    ALTER TABLE ONLY reason
        ADD CONSTRAINT reason_pkey
        PRIMARY KEY (child_id, tag);

    ALTER TABLE ONLY reason
        ADD CONSTRAINT child_idfkey
        FOREIGN KEY (child_id)
        REFERENCES  child(child_id)
        DEFERRABLE;

Now each child would have tags (with notes). Chestnut regenerated the DBIx::Class schema:

    bash$ dbicdump -o dump_directory=./lib \
        Prototype::Schema &#39;dbi:Pg:dbname=prototype;host=127.0.0.1;port=5432&#39;

Which created a Prototype::Schema::Result::Reason class, and added the extra relationship to the Prototype::Schema::Result::Child class:

=head2 reasons

Type: has_many

Related object: L&lt;Prototype::Schema::Result::Reason&gt;

=cut

__PACKAGE__-&gt;has_many(
&nbsp;&nbsp;&quot;reasons&quot;,
&nbsp;&nbsp;&quot;Prototype::Schema::Result::Reason&quot;,
&nbsp;&nbsp;{ &quot;foreign.child_id&quot; =&gt; &quot;self.child_id&quot; },
&nbsp;&nbsp;{ cascade_copy =&gt; 0, cascade_delete =&gt; 0 },
);

Accessing the Tags, Inefficently

One problem that Santa had to overcome was the rogue family dog. Some dogs are protective of the household and wants to take a bite out of the stranger in the red suit. Other dogs are so happy Santa's there that they need to bark to let the whole family know how exciting it all is.

While dogs are always a problem, the elite team of elf problem solvers had recently come up with a sure fire solution for Santa's next orbit:

if ($child-&gt;delivery_problem_with_dog )) {
&nbsp;&nbsp;&nbsp;&nbsp;break_out_the_bacon();
}

Now all Chestnut had to do was implement delivery_problem_with_dog. Chestnut quickly produced a basic solution by adding an extra method to Prototype::Schema::Result::Reason (below the section that said DO NOT MODIFY THIS OR ANYTHING ABOVE so his code wouldn't be overwritten by future updates.)

sub delivery_problem_with_dog {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $rs = $self-&gt;search_related('Reason', { tag =&gt; 'dog' });
&nbsp;&nbsp;&nbsp;&nbsp;return $rs-&gt;first;  # will be undef if there's no matching row
}

Looks good, right? Well...not entirely.

Performance Woes

Apparently Christmas Eve is a very bad time to put extra stress on the elves' database server, which according to the sysadmin elves was "overloaded enough thank you very much without you doing a whole bunch of extra selects." Chagrined Chestnut decided to try and investigate exactly what SQL DBIx::Class was sending to the database.

First, he needed another test fixture. Chestnut gave his Kevin fixture a dog problem:

    fixtures/Reason.json:
    [
        {
            &quot;child_id&quot;: &quot;f69eaf6c-bf77-4b29-9eca-78cda6fd2db7&quot;,
            &quot;tag&quot;: &quot;dog&quot;
        }
    ]

Once he'd repopulated his database from the new JSON fixtures using the script we showed you yesterday, Chestnut was ready examine what database calls DBIx::Class was making when he tried simple operations with it. The easiest way to do this is to set the DBIC_TRACE environment variable which will cause DBIx::Class to print out all the SQL it's executing. This can be be combined with reply to give us a blow-by-blow view of what's going on in the database:

    bash$ DBIC_TRACE=1 reply -Ilib -MPrototype::Schema
    0&gt; my $schema = Prototype::Schema-&gt;connect(&#39;dbi:Pg:dbname=prototype;host=127.0.0.1;port=5432&#39;); 1;
    $res[0] = 1

    1&gt; my $child = $schema-&gt;resultset(&#39;Child&#39;)-&gt;find(&quot;f69eaf6c-bf77-4b29-9eca-78cda6fd2db7&quot;); 1
    SELECT me.child_id, me.stocking_address_id, me.name FROM child me
    WHERE ( me.child_id = ? ):
    &#39;f69eaf6c-bf77-4b29-9eca-78cda6fd2db7&#39;
    $res[1] = 1

    2&gt; $child-&gt;delivery_problem_with_dog &amp;&amp; &quot;yes&quot;
    SELECT me.child_id, me.tag, me.notes FROM reason me
    WHERE ( ( me.child_id = ? AND tag = ? ) ):
    &#39;f69eaf6c-bf77-4b29-9eca-78cda6fd2db7&#39;, &#39;dog&#39;
    $res[2] = &#39;yes&#39;

Oh no! The delivery_problem_with_dog is making another SQL call. While one extra call doesn't seem too bad it would mean in production instead of making one call to select all the children his call would be making an extra SQL call per child! Is there any way Chestnut could optimize that?

Teaching DBIx::Class about delivery_problem_with_dog

The problem here is that DBIx::Class isn't able to bring to bear any of its smarts on the delivery_problem_with_dog method because Emberflakes had implemented it just as a plain old Perl method. What he should have done instead is define a new DBIx::Class relationship that did the same thing.

Creating basic relationships in DBIx::Class using the basic syntax is straight forward, but DBIx::Class is actually capable of being configured to build any join that you can create SQL::Abstract syntax for.

For example, joining against the reason table with a condition that the tag is dog.

__PACKAGE__-&gt;might_have(
&nbsp;&nbsp;&quot;delviery_problem_with_dog&quot;,
&nbsp;&nbsp;&quot;Prototype::Schema::Result::Reason&quot;,
&nbsp;&nbsp;sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $args = shift;

&nbsp;&nbsp;&nbsp;&nbsp;return {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;$args-&gt;{foreign_alias}.child_id&quot;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;=&gt; { -ident =&gt; &quot;$args-&gt;{self_alias}.child_id&quot; },
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;$args-&gt;{foreign_alias}.tag&quot; =&gt; { '=', 'dog' },
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;},
);

The final argument to might_have can be a subroutine that should return parameters for SQL::Abstract - which it can build using the prefixes passed to it in its first argument.

Running this as-is doesn't change any of our performance characteristics at all:

    bash$ DBIC_TRACE=1 reply -Ilib -MPrototype::Schema
    0&gt; my $schema = Prototype::Schema-&gt;connect(&#39;dbi:Pg:dbname=prototype;host=127.0.0.1;port=5432&#39;); 1;
    $res[0] = 1

    1&gt; my $child = $schema-&gt;resultset(&#39;Child&#39;)-&gt;find(&quot;f69eaf6c-bf77-4b29-9eca-78cda6fd2db7&quot;); 1
    SELECT me.child_id, me.stocking_address_id, me.name FROM child me
    WHERE ( me.child_id = ? ):
    &#39;f69eaf6c-bf77-4b29-9eca-78cda6fd2db7&#39;
    $res[1] = 1

    2&gt; $child-&gt;delivery_problem_with_dog &amp;&amp; &quot;yes&quot;
    SELECT me.child_id, me.tag, me.notes FROM reason me
    WHERE ( ( me.child_id = ? AND tag = ? ) ):
    &#39;f69eaf6c-bf77-4b29-9eca-78cda6fd2db7&#39;, &#39;dog&#39;
    $res[2] = &#39;yes&#39;

But now DBIx::Class understands the new relationship we can ask it to do much more for us - like prefetching the value of delivery_problem_with_dog when it fetches the Child in the first place!

    bash$ DBIC_TRACE=1 reply -Ilib -MPrototype::Schema
    0&gt; my $schema = Prototype::Schema-&gt;connect(&#39;dbi:Pg:dbname=prototype;host=127.0.0.1;port=5432&#39;); 1;
    $res[0] = 1

    1&gt; my $child = $schema-&gt;resultset(&#39;Child&#39;)-&gt;find(&quot;f69eaf6c-bf77-4b29-9eca-78cda6fd2db7&quot;,
       { prefetch =&gt; &quot;delivery_problem_with_dog&quot; }); 1
    SELECT me.child_id, me.stocking_address_id, me.name,
           delivery_problem_with_dog.child_id, delivery_problem_with_dog.tag,
           delivery_problem_with_dog.notes FROM child me
    LEFT JOIN reason delivery_problem_with_dog ON (
      delivery_problem_with_dog.child_id = me.child_id
      AND delivery_problem_with_dog.tag = ?
    )
    WHERE ( me.child_id = ? ):
         &#39;dog&#39;, &#39;f69eaf6c-bf77-4b29-9eca-78cda6fd2db7&#39;
    $res[1] = 1

    2&gt; $child-&gt;delivery_problem_with_dog &amp;&amp; &quot;yes&quot;
    $res[2] = &#39;yes&#39;

Note that the third line (labeled with 2>) doesn't cause a second SQL query to be executed anymore.

All Done

With those changes pushed to deployment (and the sysadmin elves no longer out for his blood) Chestnut Emberflakes could finally relax.

Quickly Building DBIx::Class Schemas

2017-12-21T00:00:00Z

Chestnut Emberflakes had been put in charge of solving a big problem at the North Pole. Several deliveries this year had failed to be delivered and he had to write a tool to store these few thousand orders in a database so Santa could make another quick orbit of the planet to re-deliver all those things he'd missed.

Chestnut only had until the first orbit had been completed to build his tool. He didn't have time to hand craft each and every SQL statement, but neither did he have time to write - and rewrite as he made changes - a bunch of class files for DBIx::Class so he could have it act as a ORM for him.

The Wise Old Elf was very busy as always on Christmas Eve, but he had enough time to part some quick advice: "Let the code build the code for you". Chestnut wasn't sure what that meant, but he'd be sure to figure it out soon.

What Emberflakes Had To Model

The requirements for the database model cold be summed up by this entity relationship diagram.

In short:

Each child would receive one or more named presents
Likewise each brand of present could be given to any number of children
Each child could have an address associated with them where the presents would be delivered (though some children sadly wouldn't have an address and Santa would have to use some ingenuity there instead)
Each address could have any number of children at it

The SQL

Chestnut quickly knocked up some SQL to create a Postgres database. This prototype didn't have to be perfect - he wasn't trying too hard to get all the types right in the most efficient manner, but just get this done.

DROP DATABASE IF EXISTS prototype;
CREATE DATABASE prototype;

\c prototype;

CREATE TABLE stocking_address (
&nbsp;&nbsp;&nbsp;&nbsp;stocking_address_id UUID NOT NULL,
&nbsp;&nbsp;&nbsp;&nbsp;street_address TEXT NOT NULL,
&nbsp;&nbsp;&nbsp;&nbsp;lat float,
&nbsp;&nbsp;&nbsp;&nbsp;lon float
);

ALTER TABLE ONLY stocking_address
&nbsp;&nbsp;&nbsp;&nbsp;ADD CONSTRAINT stocking_address_pkey
&nbsp;&nbsp;&nbsp;&nbsp;PRIMARY KEY (stocking_address_id);

CREATE TABLE child (
&nbsp;&nbsp;&nbsp;&nbsp;child_id UUID NOT NULL,
&nbsp;&nbsp;&nbsp;&nbsp;stocking_address_id UUID,
&nbsp;&nbsp;&nbsp;&nbsp;name TEXT NOT NULL
);

ALTER TABLE ONLY child
&nbsp;&nbsp;&nbsp;&nbsp;ADD CONSTRAINT child_pkey
&nbsp;&nbsp;&nbsp;&nbsp;PRIMARY KEY (child_id);

ALTER TABLE ONLY child
&nbsp;&nbsp;&nbsp;&nbsp;ADD CONSTRAINT child_stocking_address_id_fkey
&nbsp;&nbsp;&nbsp;&nbsp;FOREIGN KEY (stocking_address_id)
&nbsp;&nbsp;&nbsp;&nbsp;REFERENCES  stocking_address(stocking_address_id)
&nbsp;&nbsp;&nbsp;&nbsp;DEFERRABLE;

CREATE TABLE present (
&nbsp;&nbsp;&nbsp;&nbsp;present_id UUID NOT NULL,
&nbsp;&nbsp;&nbsp;&nbsp;description TEXT NOT NULL
);

ALTER TABLE ONLY present
&nbsp;&nbsp;&nbsp;&nbsp;ADD CONSTRAINT present_pkey
&nbsp;&nbsp;&nbsp;&nbsp;PRIMARY KEY (present_id);

CREATE TABLE child_presents (
&nbsp;&nbsp;&nbsp;&nbsp;child_id UUID NOT NULL,
&nbsp;&nbsp;&nbsp;&nbsp;present_id UUID NOT NULL
);

ALTER TABLE ONLY child_presents
&nbsp;&nbsp;&nbsp;&nbsp;ADD CONSTRAINT child_presents_pkey
&nbsp;&nbsp;&nbsp;&nbsp;PRIMARY KEY (child_id, present_id);

ALTER TABLE ONLY child_presents
&nbsp;&nbsp;&nbsp;&nbsp;ADD CONSTRAINT child_idfkey
&nbsp;&nbsp;&nbsp;&nbsp;FOREIGN KEY (child_id)
&nbsp;&nbsp;&nbsp;&nbsp;REFERENCES  child(child_id)
&nbsp;&nbsp;&nbsp;&nbsp;DEFERRABLE;

ALTER TABLE ONLY child_presents
&nbsp;&nbsp;&nbsp;&nbsp;ADD CONSTRAINT present_idfkey
&nbsp;&nbsp;&nbsp;&nbsp;FOREIGN KEY (present_id)
&nbsp;&nbsp;&nbsp;&nbsp;REFERENCES  present(present_id)
&nbsp;&nbsp;&nbsp;&nbsp;DEFERRABLE;

He'd at least spent the time writing in the foreign key constraints. He didn't have much time to spare, but he had even less time to spare debugging his database if he didn't stop junk being put in their by mistake!

Chestnut quickly setup the database on his dev machine:

    bash$ psql &lt; database.sql
    DROP DATABASE
    CREATE DATABASE
    You are now connected to database &quot;prototype&quot; as user &quot;Chestnut&quot;.
    CREATE TABLE
    ALTER TABLE
    CREATE TABLE
    ALTER TABLE
    ALTER TABLE
    CREATE TABLE
    ALTER TABLE
    CREATE TABLE
    ALTER TABLE
    ALTER TABLE
    ALTER TABLE

Building The ORM Classes Automatically

Emberflakes was just about to call out to see if anyone would help him when the Wise Old Elf snatched away his keyboard and typed something.

    bash$ dbicdump -o dump_directory=./lib \
        Prototype::Schema &#39;dbi:Pg:dbname=prototype;host=127.0.0.1;port=5432&#39;

And ran away. Emberflames was left staring at the message on his screen:

    Dumping manual schema for Prototype::Schema to directory ./lib ...
    Schema dump completed.

What the huh? With no one to explain what had just happened Chestnut figured he better peek inside the lib directory.

    bash$ find .
    find .
    .
    ./lib
    ./lib/Prototype
    ./lib/Prototype/Schema
    ./lib/Prototype/Schema/Result
    ./lib/Prototype/Schema/Result/Child.pm
    ./lib/Prototype/Schema/Result/ChildPresent.pm
    ./lib/Prototype/Schema/Result/Present.pm
    ./lib/Prototype/Schema/Result/StockingAddress.pm
    ./lib/Prototype/Schema.pm

Ooooh. It'd all been written for him. Opening up one of the files shows all the code.

use utf8;
package Prototype::Schema::Result::Child;

# Created by DBIx::Class::Schema::Loader
# DO NOT MODIFY THE FIRST PART OF THIS FILE

=head1 NAME

Prototype::Schema::Result::Child

=cut

use strict;
use warnings;

use base 'DBIx::Class::Core';

=head1 TABLE: C&lt;child&gt;

=cut

__PACKAGE__-&gt;table(&quot;child&quot;);

=head1 ACCESSORS

=head2 child_id

&nbsp;&nbsp;data_type: 'uuid'
&nbsp;&nbsp;is_nullable: 0
&nbsp;&nbsp;size: 16

=head2 stocking_address_id

&nbsp;&nbsp;data_type: 'uuid'
&nbsp;&nbsp;is_foreign_key: 1
&nbsp;&nbsp;is_nullable: 1
&nbsp;&nbsp;size: 16

=head2 name

&nbsp;&nbsp;data_type: 'text'
&nbsp;&nbsp;is_nullable: 0

=cut

__PACKAGE__-&gt;add_columns(
&nbsp;&nbsp;&quot;child_id&quot;,
&nbsp;&nbsp;{ data_type =&gt; &quot;uuid&quot;, is_nullable =&gt; 0, size =&gt; 16 },
&nbsp;&nbsp;&quot;stocking_address_id&quot;,
&nbsp;&nbsp;{ data_type =&gt; &quot;uuid&quot;, is_foreign_key =&gt; 1, is_nullable =&gt; 1, size =&gt; 16 },
&nbsp;&nbsp;&quot;name&quot;,
&nbsp;&nbsp;{ data_type =&gt; &quot;text&quot;, is_nullable =&gt; 0 },
);

=head1 PRIMARY KEY

=over 4

=item * L&lt;/child_id&gt;

=back

=cut

__PACKAGE__-&gt;set_primary_key(&quot;child_id&quot;);

=head1 RELATIONS

=head2 child_presents

Type: has_many

Related object: L&lt;Prototype::Schema::Result::ChildPresent&gt;

=cut

__PACKAGE__-&gt;has_many(
&nbsp;&nbsp;&quot;child_presents&quot;,
&nbsp;&nbsp;&quot;Prototype::Schema::Result::ChildPresent&quot;,
&nbsp;&nbsp;{ &quot;foreign.child_id&quot; =&gt; &quot;self.child_id&quot; },
&nbsp;&nbsp;{ cascade_copy =&gt; 0, cascade_delete =&gt; 0 },
);

=head2 stocking_address

Type: belongs_to

Related object: L&lt;Prototype::Schema::Result::StockingAddress&gt;

=cut

__PACKAGE__-&gt;belongs_to(
&nbsp;&nbsp;&quot;stocking_address&quot;,
&nbsp;&nbsp;&quot;Prototype::Schema::Result::StockingAddress&quot;,
&nbsp;&nbsp;{ stocking_address_id =&gt; &quot;stocking_address_id&quot; },
&nbsp;&nbsp;{
&nbsp;&nbsp;&nbsp;&nbsp;is_deferrable =&gt; 0,
&nbsp;&nbsp;&nbsp;&nbsp;join_type     =&gt; &quot;LEFT&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;on_delete     =&gt; &quot;NO ACTION&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;on_update     =&gt; &quot;NO ACTION&quot;,
&nbsp;&nbsp;},
);

=head2 presents

Type: many_to_many

Composing rels: L&lt;/child_presents&gt; -&gt; present

=cut

__PACKAGE__-&gt;many_to_many(&quot;presents&quot;, &quot;child_presents&quot;, &quot;present&quot;);


# Created by DBIx::Class::Schema::Loader v0.07043 @ 2017-12-20 18:03:02
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:fvT7p0SmZa93Fop9i10jyA


# You can replace this text with custom code or comments, and it will be preserved on regeneration
1;

There's a lot to digest in that code. The important thing to remember was that no human (or elf) had to write any of it. And if any changes were made to the schema then it was possible to regenerate this file by simply re-running the command (regenerating the file won't overwrite or lose any additional code any elf has added below the DO NOT MODIFY THIS OR ANYTHING ABOVE LINE.)

Loading Test Data

Emberflakes decided that he'd better experiment with what was going on in the database, so he wrote a bunch of test data as JSON files to create some test fixtures.

    fixtures/StockingAddress.json:
    [
        {
            &quot;stocking_address_id&quot;: &quot;db1e1ce1-bc05-4931-b79f-4356ea6270ff&quot;,
            &quot;street_address&quot;: &quot;671 Lincoln Ave. Winnetka, Illinois&quot;,
            &quot;lat&quot;: -87.7358245,
            &quot;lon&quot;: 42.109756
        }
    ]

    fixtures/Present.json:
    [
        {
            &quot;present_id&quot;: &quot;a9c15d33-b157-4513-9638-926d7793fdb1&quot;,
            &quot;description&quot;: &quot;BB Gun&quot;
        },
        {
            &quot;present_id&quot;: &quot;d321221e-6f1e-41ec-82b2-bda7d4783569&quot;,
            &quot;description&quot;: &quot;Micro Machines&quot;
        },
        {
            &quot;present_id&quot;: &quot;108bebb9-871b-45a6-b4e0-36fc720b2165&quot;,
            &quot;description&quot;: &quot;Blowtorch&quot;
        }
    ]

    fixtures/Child.json:
    [
        {
            &quot;child_id&quot;: &quot;f69eaf6c-bf77-4b29-9eca-78cda6fd2db7&quot;,
            &quot;name&quot;: &quot;Kevin McCallister&quot;,
            &quot;stocking_address_id&quot;: &quot;db1e1ce1-bc05-4931-b79f-4356ea6270ff&quot;,
            &quot;child_presents&quot;: [
                { &quot;present_id&quot;: &quot;a9c15d33-b157-4513-9638-926d7793fdb1&quot; },
                { &quot;present_id&quot;: &quot;d321221e-6f1e-41ec-82b2-bda7d4783569&quot; },
                { &quot;present_id&quot;: &quot;108bebb9-871b-45a6-b4e0-36fc720b2165&quot; }
            ]
        }
    ]

Reading these files in and using them to populate the database is fairly straight forward:

#!/usr/bin/perl

use v5.22;
use warnings;
use lib qw(lib);

use JSON::PP qw( decode_json );
use Path::Tiny qw( path );
use Prototype::Schema;

# connect to the database
my $schema = Prototype::Schema-&gt;connect(
&nbsp;&nbsp;&nbsp;&nbsp;'dbi:Pg:dbname=prototype;host=127.0.0.1;port=5432',
);

$schema-&gt;txn_do(sub {
    # run with constraints disabled until the end of a transaction so we
&nbsp;&nbsp;&nbsp;&nbsp;# don't have to worry about the order in which we're inserting
&nbsp;&nbsp;&nbsp;&nbsp;# fixtures into the database
    $schema-&gt;storage-&gt;dbh-&gt;do('SET CONSTRAINTS ALL DEFERRED');

    # for each json file
    for my $file ( grep { /[.]json$/ } path('fixtures')-&gt;children ) {
        # decode the json file
        my $ds = decode_json( path( $file )-&gt;slurp );

        # turn fixtures/Foo.json to Foo
        my $name = path( $file )-&gt;basename('.json');

        # get the result set
        my $rs = $schema-&gt;resultset($name);

        # and insert each json object into the database
        for my $row (@{ $ds }) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$rs-&gt;create( $row );
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;}
});

Since the database schema that Emberflakes had designed had DEFERRABLE constraints it's possible to use SET CONSTRAINTS ALL DEFERRED to allow inserting incomplete foreign key data into the database, as long as when the transaction ends all the foreign keys are in place. If we didn't do this

There's another thing worth noticing: Did you spot that there's no ChildPresent.json file? If you look closely at the Child.json file you'll notice that the child_presents field isn't actually a normal database field at all but the name of a DBIx::Class relationship - and DBIx::Class will take the array of objects that it contains and used them to create related objects for us.

Playing Around with the data

More than anything Chestnut Emberflakes just needed to get to grips with the database schema. What better way to try it out than to use it interactively?

Chestnut fired up the reply, the Perl REPL:

    bash$ reply -Ilib -MPrototype::Schema
    0&gt; my $schema = Prototype::Schema-&gt;connect(&#39;dbi:Pg:dbname=prototype;host=127.0.0.1;port=5432&#39;); 1
    $res[0] = 1

    1&gt; my $child_rs = $schema-&gt;resultset(&#39;Child&#39;); 1
    $res[1] = 1

    2&gt; my $kevin = $child_rs-&gt;find(&quot;f69eaf6c-bf77-4b29-9eca-78cda6fd2db7&quot;); 1
    $res[2] = 1

    3&gt; $kevin-&gt;name;
    $res[3] = &#39;Kevin McCallister&#39;

    4&gt; my $p = $kevin-&gt;presents; 1
    $res[4] = 1

    5&gt; $p-&gt;next-&gt;description;
    $res[5] = &#39;BB Gun&#39;

    6&gt; $p-&gt;next-&gt;description;
    $res[6] = &#39;Micro Machines&#39;

    7&gt; $p-&gt;next-&gt;description;
    $res[7] = &#39;Blowtorch&#39;

    8&gt; $kevin-&gt;name(&#39;Kevin McCallister (aka Macaulay Culkin)&#39;);
    $res[8] = &#39;Kevin McCallister (aka Macaulay Culkin)&#39;

    9&gt; $kevin-&gt;update; 1
    $res[9] = 1

    10&gt; my $children = $child_rs-&gt;search_rs( name =&gt; &#39;Kevin McCallister (aka Macaulay Culkin)&#39; ); 1
    $res[10] = 1

    11&gt; $children-&gt;first-&gt;child_id
    $res[11] = &#39;f69eaf6c-bf77-4b29-9eca-78cda6fd2db7&#39;

    12&gt; $children-&gt;first-&gt;stocking_address-&gt;street_address
    $res[12] = &#39;671 Lincoln Ave. Winnetka, Illinois&#39;

    14&gt;

Note that Chestnut was careful not to return any of the DBIx::Class objects (otherwise reply would dump them out, which would be 300+ lines each of too much detail.)

Not Much Coding, So Much Done

With no actual Perl coding Chestnut Emberflakes had managed to get a fully functioning ORM setup where he could quickly prototype any task that the night might throw at him. Wish him luck...the children are counting on him.

Reindeer

2017-12-20T00:00:00Z

This year the Elves at the North Pole had learned a lot about powerful packages they could load to improve Moose. The problem was that things were getting a little on the long winded size at the top of each of their Moose-based packages...

package ChristmasTree;

use Moose;
use MooseX::AttributeShortcuts;
use MooseX::AutoDestruct;
use MooseX::CascadeClearing;
use MooseX::ClassAttributes;
use MooseX::LazyRequire
use MooseX::StrictConstructor;
use MooseX::UndefTolerant::Attribute;

...

It was enough to make the Wise Old Elf's RSI flair up once more. Something had to be done. It was time for something better than Moose.

What's better than Moose for one of Santa's Elves? That's right: Reindeer. Still the same thing, but with more aerodynamic antlers.

The Reindeer module from the CPAN is a wrapper for Moose that not only loads Moose into your class but loads a whole bunch of handy Moose extensions too. In fact, the above code could simply be replaced by:

package ChristmasTree;
use Reindeer;

Does All The Things

Reindeer does so much that it's hard to document it all...

All our Favourite Extensions

Reindeer pulls in a bunch of modules that:

Provide syntax for abstract methods
Enable coercion by default (i.e. making it opt-out rather than opt-in)
Use shortcuts when writing attribute declarations
Provides currying for attribute delegation
Give you the ability to write class level attributes
Throw exceptions if you try to read an un-set attribute
Offer better syntax for overriding default values for attributes in subclasses
Throw exceptions if unknown parameters are passed to your constructor
Better construct anonymous classes with extra traits

Type Libraries

Reindeer exports a bunch of type libraries into your code. This means, for example, instead of writing your types as strings like so:

has counter =&gt; ( is =&gt; 'ro', isa =&gt; 'Int', default =&gt; 0 );

You can write the same thing using a bunch of types like so:

has counter =&gt; ( is =&gt; 'ro', isa =&gt; Int, default =&gt; 0 );

While these are just fancy no-argument function calls that return their own name (which are often inlined by the perl compiler) they act and feel like a real Perl syntax for types.

Not only do you save those two characters, but by using function calls instead of strings, you also get all the advantages of use strict to catch typos at compile time.

Trait Aliases

Similarly Reindeer exports named traits (again, zero parameter functions, but actual implementations details aren't important.) So instead of writing:

use Moose;
use MooseX::Attribute::ENV;
has home =&gt; ( is =&gt; 'ro', trait =&gt; [ 'ENV' ])

You can write:

use Reindeer;
has home =&gt; ( is =&gt; 'ro', trait =&gt; [ ENV ])

As well as providing the slight reduction in typing, better typo checking, this also provides lazy loading of the trait classes - the first time the named trait is used the trait class will be loaded (this means there's no penalty for having the traits available if you don't use them.)

Extra Language Features and Extensions

Reindeer also enables a bunch non-Moose extra things that are either optional in Perl, or are standard extensions.

Enables all features for the version of Perl you're running. For example, if you're running 5.10 or later then you'll be able to use the say keyword.
Provides try, catch and finally from Try::Tiny to give you handy try { ...} blocks.
Cleans your namespace with namespace::autoclean so utility functions you import aren't callable as methods

Less Typing Is Less Mistakes

The Wise Old Elf was happy. He was well aware that a large amount of the code written by the Elves was written in the last few weeks before Christmas in a big rush. Not only would Reindeer act as a force multiplier for his development team making their work quicker, it would also reduce the amount of code they'd have to write, and hopefully therefore the number of chances to introduce bugs.

Maybe not

2017-12-19T00:00:00Z

"What's this Maybe here for?" asked the Wise Old Elf. He was looking at the new Moose code that Syllabub Fizzyboughs had written for the new and improved Sleigh operating system.

has gps_unit =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;is  =&gt; 'ro',
&nbsp;&nbsp;&nbsp;&nbsp;isa =&gt; Maybe[class_type('GPSUnit')],
);

"You see, Wise Old Elf, the Maybe says that the value can either be whatever is in the brackets or can be undef. So this means the value has to be something that's a GPS unit or undef - in case there's no GPS unit attached, you see.", Syllabub explained.

my $basic_sleigh =&gt; Sleigh-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;name =&gt; 'Mk I'
);

# prints nothing!
say $basic_sleigh-&gt;gps_unit-&gt;name
&nbsp;&nbsp;&nbsp;&nbsp;if defined $basic_sleigh-&gt;gps_unit;

my $fancy_sleigh =&gt; Sleigh-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;name =&gt; 'Mk II',
&nbsp;&nbsp;&nbsp;&nbsp;gps_unit =&gt; GPSUnit-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;name =&gt; 'Super GPS 2001',
&nbsp;&nbsp;&nbsp;&nbsp;),
);

# prints 'Super GPS 2001'
say $fancy_sleigh-&gt;gps_unit-&gt;name
&nbsp;&nbsp;&nbsp;&nbsp;if defined $fancy_sleigh-&gt;gps_unit;

"Yes, yes. I know what Maybe does. But I asked what it's there for. Haven't you heard the expression 'Maybe is a code smell?'"

"No Wise Old Elf, can't say that I have. To be honest, I'm not sure what you mean by code smell. My keyboard smells of freshly baked cookies like any other workstation at the North Pole."

"A code smell, by young elf, is a pattern that indicates that probably there's something wrong with your code. Other people call them 'Red Flags'. In this case it's because nine times out of ten, if you're using a Maybe you're better off using a predicate"

has gps_unit =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;is        =&gt; 'ro',
&nbsp;&nbsp;&nbsp;&nbsp;isa       =&gt; class_type('GPSUnit'),
&nbsp;&nbsp;&nbsp;&nbsp;predicate =&gt; 'has_gps_unit',
);

"Or, if you're using MooseX::AttributeShortcuts"

has gps_unit =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;is        =&gt; 'ro',
&nbsp;&nbsp;&nbsp;&nbsp;isa       =&gt; class_type('GPSUnit'),
&nbsp;&nbsp;&nbsp;&nbsp;predicate =&gt; 1,
);

"So now you can use the has_gps_unit method"

# prints 'Super GPS 2001'
say $fancy_sleigh-&gt;gps_unit-&gt;name
&nbsp;&nbsp;&nbsp;&nbsp;if defined $fancy_sleigh-&gt;has_gps_unit;

MooseX::LazyRequire

"Okay", Syllabub asked, "why would I want to do that?"

The Wise Old Elf explained, for starters, it's a lot more readable with exactly what's going on when you use the has_gps_unit method. But what really blew Syllabub's mind was when the Wise Old Elf showed him MooseX::LazyRequires.

Even with a predicate you can still read from an attribute that hasn't been set in the constructor, and you'll get undef back. This can result in hard to debug problems, where the value is taken, passed somewhere else, then much later in your code when something tries to access it...

# in Sleigh
sub fly_to_destination {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $place = shift;

&nbsp;&nbsp;&nbsp;&nbsp;my $trip = Trip-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;start =&gt; $self-&gt;current_location,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;end   =&gt; $place,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;gps   =&gt; $self-&gt;gps_unit,
&nbsp;&nbsp;&nbsp;&nbsp;);

&nbsp;&nbsp;&nbsp;&nbsp;$trip-&gt;route($self);
}

This leads to the really unreadable error message from deep within the Trip class's route method if the gps_unit attribute isn't set and returns undef when fly_to_destination is called. What you really need to do is throw an exception as soon as you try reading from an accessor that isn't set. That's what MooseX::LazyRequires does for any attribute that has the lazy_requires parameter enabled:

use MooseX::LazyRequire;

has gps_unit =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;is            =&gt; 'ro',
&nbsp;&nbsp;&nbsp;&nbsp;predicate     =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;lazy_required =&gt; 1,
);

Which now, if you don't set the gps_unit prior to calling fly_to_destination, immediately generates a much more readable error message:

    Attribute &#39;gps_unit&#39; must be provided before calling reader
        at /opt/perl/lib/site_perl/5.22.0/MooseX/LazyRequire/Meta/Attribute/Trait/LazyRequire.pm line 34.
        MooseX::LazyRequire::Meta::Attribute::Trait::LazyRequire::__ANON__(Sleigh=HASH(0x7fd3a1807908))
           called at reader Sleigh::gps_unit (defined at Sleigh.pm line 7) line 6
        Sleigh::gps_unit(Sleigh=HASH(0x7fd3a1807908))
           called at Sleigh.pm line 18
        Sleigh::fly_to_destination(Sleigh=HASH(0x7fd3a1807908))
           called at example.pl line 6

Syllabub was convinced and made the changes to all of his code.

MooseX::UndefTolerant::Attribute

"Wise Old Elf, I've got a problem", Syllabub explained the next day, "I changed all my code and now it's broken wherever I pass in undef"

my $sleigh =&gt; Sleigh-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;name =&gt; 'Mk III',
&nbsp;&nbsp;&nbsp;&nbsp;gps_unit =&gt; $factory-&gt;gps_unit, # might return undef if there isn't one
);

"We do this all over the place. Do I have to change all my code?". Syllabub showed the Wise Old Elf what he'd been "forced" to write:

my $gps = $factory-&gt;gps_unit;
if ($gps) {
&nbsp;&nbsp;&nbsp;&nbsp;$sleigh = Sleigh-&gt;new( name =&gt; 'Mk III', gps_unit =&gt; $gps );
} else {
&nbsp;&nbsp;&nbsp;&nbsp;$sleigh = Sleigh-&gt;new( name =&gt; 'Mk III' );
}

The Wise Old Elf explained that he could probably make his life a lot easier with the ternary operator:

my $gps = $factory-&gt;gps_unit;
my $sleigh = Sleigh-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;name =&gt; 'Mk III',
&nbsp;&nbsp;&nbsp;&nbsp;($gps ? ( gps_unit =&gt; $gps ) : ()),
);

But there was another simpler strategy: Use MooseX::UndefTolerant::Attribute to allow undef to mean the same thing as we didn't pass a value.

use MooseX::UndefTolerant::Attribute;

has gps_unit =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;traits        =&gt; [ UndefTolerant ],
&nbsp;&nbsp;&nbsp;&nbsp;is            =&gt; 'ro',
&nbsp;&nbsp;&nbsp;&nbsp;predicate     =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;lazy_required =&gt; 1,
);

...

# this now works fine, as if gps_unit hadn't been passed
my $sleigh =&gt; Sleigh-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;name =&gt; 'Mk IV',
&nbsp;&nbsp;&nbsp;&nbsp;gps_unit =&gt; undef,
);

Cleaner Code All Round

Syllabub was happy. His code was a lot easier to debug, and he'd learned something from the Wise Old Elf. Code review might be painful, but everything was a lot better afterward.

Project Multipli-sleigh-ion

2017-12-18T00:00:00Z

Project Multipli-sleigh-ion was the last, great hope for the North Pole to cope with the ever increasing child population. More children equaled more presents that had to be loaded on the sleigh and it was getting out of hand. Multipli-sleigh-ion was going to address this by replacing the vertical scaling - ever more powerful magic to fit everything in one sack - with horizontal scaling - lots of sacks of presents stashed at strategic locations around the globe for Santa to pick up en-route.

Rustic Starpie had been put in charge of writing modeling code to test the feasibility of this approach. In his model code each class of present consumed one common role Present, and in doing so was required to implement the ideal_sack method.

package Present;
use Moose::Role;

requires 'ideal_sack', 'name';

sub put_in_sack {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my @sacks = @_;

&nbsp;&nbsp;&nbsp;&nbsp;my $ideal_sack = $self-&gt;ideal_sack( @sacks );
&nbsp;&nbsp;&nbsp;&nbsp;unless ($ideal_sack-&gt;full) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$ideal_sack-&gt;add_present( $self );
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return;
&nbsp;&nbsp;&nbsp;&nbsp;}

&nbsp;&nbsp;&nbsp;&nbsp;die &quot;Modeling failed, can't fit &quot;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;. $self-&gt;name .
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;' into sack '
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;. $ideal_sack-&gt;name
}

...

The ideal_sack code was implemented differently in each class that consumed the Present role, but each implementation ultimately decided which of the passed sack objects it should put itself in. For example, the figgy puddings were for the English children, so they always went into the English sack

package FiggyPuddingPresent;

use Moose;
with 'Present';

use List::Util qw( first );

sub name { 'Figgy Pudding' }

sub ideal_sack {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my @sacks = @_;

&nbsp;&nbsp;&nbsp;&nbsp;my $ideal_sack = first { $_-&gt;name eq 'London, UK'} @sacks;
&nbsp;&nbsp;&nbsp;&nbsp;return $ideal_sack;
}

...

The problem Rustic was having with his code is that, well, it wasn't always doing what it was supposed to in all cases. So he decided to add some debugging in the Present role to print out which sack everything was going to go into.

package Present;
use Moose::Role;

requires 'ideal_sack', 'name';

around ideal_sack =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $orig = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;

&nbsp;&nbsp;&nbsp;&nbsp;my $ideal_sack = $self-&gt;$orig(@_);

&nbsp;&nbsp;&nbsp;&nbsp;print &lt;&lt;~&quot;OUT&quot;;
    The ideal sack for a @{[ $self-&gt;name ]} is @{[ $ideal_sack-&gt;name ]}
    OUT

&nbsp;&nbsp;&nbsp;&nbsp;return $ideal_sack;
};

...

This code would cause any ideal_sack method to be wrapped in code that produced output of the form:

    The ideal sack for a Figgy Pudding is London, UK
    The ideal sack for a Chocolate Coin is Paris, France
    The ideal sack for a Chocolate Coin is Moscow, Russia
    The ideal sack for a Figgy Pudding is London, UK
    The ideal sack for a Chocolate Coin is London, UK
    The ideal sack for a Chocolate Coin is New York, USA
    The ideal sack for a Figgy Pudding is London, UK
    Can&#39;t fit Figgy Pudding into sack London, UK at line 16 of Present.pm.

(The chocolate coins are distributed randomly between sacks)

This was somewhat helpful, it really isn't what Rustic wanted. He wanted to know how many Figgy Puddings he'd successfully managed to put into the sack, and he really didn't want to have to count the lines of his debug output. He wanted output of the form:

    The ideal sack for the 3214th Figgy Pudding is London, UK
    The ideal sack for the 91231st Chocolate Coin is Paris, France
    The ideal sack for the 91232nd Chocolate Coin is Moscow, Russia
    The ideal sack for the 3215th Figgy Pudding is London, UK
    The ideal sack for the 91233rd Chocolate Coin is London, UK
    The ideal sack for the 91234th Chocolate Coin is New York, USA
    The ideal sack for the 3216th Figgy Pudding is London, UK
    Can&#39;t fit Figgy Pudding into sack London, UK at line 16 of Present.pm.

How could Rustic get Perl to keep track of the number of times ideal_sack had been called per class? The data can't be stored in the instances because they're distrinct from one another. What Rustic needed was some sort of class level storage.

Luckily, there's a module for that. MooseX::ClassAttribute provides a new keyword class_has that defines an attribute shared at the class level rather than the instance level. All objects of the same class share the same value:

package Present;
use Moose::Role;
use MooseX::ClassAttribute;
use Lingua::EN::Numbers::Ordinate ('ordinate');

requires 'ideal_sack';

class_has _packed_counter =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;is      =&gt; 'rw',
&nbsp;&nbsp;&nbsp;&nbsp;isa     =&gt; 'Int',
&nbsp;&nbsp;&nbsp;&nbsp;default =&gt; 0,
);

around ideal_sack =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $orig = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;

&nbsp;&nbsp;&nbsp;&nbsp;my $ideal_sack = $self-&gt;$orig(@_);

&nbsp;&nbsp;&nbsp;&nbsp;my $counter = $self-&gt;_packed_counter;
&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;_packed_counter( $counter + 1 );
&nbsp;&nbsp;&nbsp;&nbsp;my $c = ordinate( $counter );

&nbsp;&nbsp;&nbsp;&nbsp;print &lt;&lt;~&quot;OUT&quot;;
    The ideal sack for the $c @{[ $self-&gt;name ]} is @{[ $ideal_sack-&gt;name ]}
    OUT

&nbsp;&nbsp;&nbsp;&nbsp;return $ideal_sack;
};

...

We have the full power of Moose attributes behind the class attributes. For example, Rustic could rewrite the above to be clearer with the Moose::Meta::Attribute::Native::Trait::Counter trait to handle incrementing the counter.

package Present;
use Moose::Role;
use MooseX::ClassAttribute;
use Lingua::EN::Numbers::Ordinate ('ordinate');

requires 'ideal_sack';

class_has _packed_counter =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;is      =&gt; 'rw',
&nbsp;&nbsp;&nbsp;&nbsp;isa     =&gt; 'Int',
&nbsp;&nbsp;&nbsp;&nbsp;traits  =&gt; ['Counter'],
&nbsp;&nbsp;&nbsp;&nbsp;default =&gt; 0,
&nbsp;&nbsp;&nbsp;&nbsp;handles =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;_increment_packed_counter =&gt; 'inc',
&nbsp;&nbsp;&nbsp;&nbsp;},
);

around ideal_sack =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $orig = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;

&nbsp;&nbsp;&nbsp;&nbsp;my $ideal_sack = $self-&gt;$orig(@_);

&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;_increment_packed_counter;
&nbsp;&nbsp;&nbsp;&nbsp;my $c = ordinate( $self-&gt;_packed_counter );

&nbsp;&nbsp;&nbsp;&nbsp;print &lt;&lt;~&quot;OUT&quot;;
    The ideal sack for the $c @{[ $self-&gt;name ]} is @{[ $ideal_sack-&gt;name ]}
    OUT

&nbsp;&nbsp;&nbsp;&nbsp;return $ideal_sack;
};

...

With the new debugging output Rustic was quickly able to determine where the problems were in the code in time for his project review with the Wise Old Elf.

Making a constructor argument list, checking it twice.

2017-12-17T00:00:00Z

"Wise Old Elf, Wise Old Elf", Licorice Stripysparkles called out, "I think your code is broken."

"Broken, you say, Licorice? That's odd, it passes all its tests."

"Yeah, Wise Old Elf, I know that. But look, when I try setting the lead reindeer to Robbie, Rudolph's son, when I'm constructing the Sleigh, it just doesn't work! It keeps using the default from the lazy builder, giving me back Rudolph each time."

"Nonsense, young one. There's a test for that. Are you sure that _build_lead_reindeer is being erroneously called?"

"Yep, I put some debug code in it to print out to STDERR, and by jove, it's being called each and every time, if I pass a value for lead_reindeer to the constructor or not."

"Most odd. Show me exactly what you're doing."

Stripysparkles opened up his editor and showed the Wise Old Elf his code:

# create the test sleigh
my $sleigh = SantasSleigh-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;lead_raindeer =&gt; Robbie-&gt;new,
);

say ref $sleigh-&gt;lead_reindeer;

"Licorice, my boy, that's not how you spell reindeer. R-E-I-N not R-A-I-N!"

"Oops, sorry Wise Old Elf, My Bad!"

"No, Licorice, I don't really think it is your bad. If it's anyone's bad it's mine."

Not Strict Enough

By default Moose lets you pass any argument you want to the constructor method. If it doesn't have a corresponding attribute for that parameter Moose happily ignores the parameter.

This can, as Licorice Stripysparkles had discovered, often lead to some hard to diagnose bugs. The solution is to throw an exception if someone passes you a duff argument.

Now, we could write some complex code in a BUILDARGS method that checked the arguments. But it would be fragile, and we would have to keep updating it when our class (or superclasses, or roles) added new attributes. Why don't we instead take advantage of Moose to do some introspection on the object and work this out dynamically for us? Better yet, we could use a reusable class trait (a role for the class's metaclass) that does all of this for us without having to actually write any code for our particular class.

This is exactly what the CPAN module MooseX::StrictConstructor does. Loading this class in your Moose class monkeys around with the metaclass for the class you're writing in order to add strict constructor checks. So once the Wise Old Elf changed the code to include one extra use statement...

package SantasSleigh;
use Moose;
use MooseX::StrictConstructor;

It meant that when Licorice ran his broken code he got an actual helpful error message:

    Found unknown attribute(s) init_arg passed to the constructor: lead_raindeer

For Elves, Shorter is Better

2017-12-16T00:00:00Z

One of the problems in being the Wise Old Elf was, well, the old part. The Wise Old Elf had been typing for so many years - rushing every Christmas - that he'd developed a case of RSI that flared up at the most inconvenient times.

As such, he was always looking for ways to avoid typing so much, and this Christmas, he thought he'd found one.

Verbose. Verbosity. So long winded. On and On.

One of the problems with Moose in its default configuration is that it can be, well, a little wordy...

has lead_reindeer =&gt; (
&nbsp;&nbsp;is      =&gt; 'ro',
&nbsp;&nbsp;isa     =&gt; class_type('SantasReindeer'),
&nbsp;&nbsp;lazy    =&gt; 1,
&nbsp;&nbsp;builder =&gt; '_build_lead_reindeer',
);

has second_reindeer =&gt; (
&nbsp;&nbsp;is      =&gt; 'ro',
&nbsp;&nbsp;isa     =&gt; class_type('SantasReindeer'),
&nbsp;&nbsp;lazy    =&gt; 1,
&nbsp;&nbsp;builder =&gt; '_build_second_reindeer',
);

has third_reindeer =&gt; (
&nbsp;&nbsp;is      =&gt; 'ro',
&nbsp;&nbsp;isa     =&gt; class_type('SantasReindeer'),
&nbsp;&nbsp;lazy    =&gt; 1,
&nbsp;&nbsp;builder =&gt; '_build_third_reindeer',
);

has forth_reindeer =&gt; (
&nbsp;&nbsp;is      =&gt; 'ro',
&nbsp;&nbsp;isa     =&gt; class_type('SantasReindeer'),
&nbsp;&nbsp;lazy    =&gt; 1,
&nbsp;&nbsp;builder =&gt; '_build_forth_reindeer',
);

...;  # and on and on for another five reindeer!

Putting aside the fact that this is probably better written using some sort of array data structure (which is literally an article for another day) what can be done to make this less verbose?

Enter MooseX::AttributeShortcuts

Why, yes, we can make this much shorter, with the help of the MooseX::AttributeShortcuts CPAN module:

use MooseX::AttributeShortcuts;

has [qw(
&nbsp;&nbsp;lead_reindeer second_reindeer third_reindeer forth_reindeer
&nbsp;&nbsp;fifth_reindeer sixth_reindeer seveth_reindeer eighth_reindeer
)] =&gt; (
&nbsp;&nbsp;is              =&gt; 'ro',
&nbsp;&nbsp;isa_instance_of =&gt; 'SantasReindeer',
&nbsp;&nbsp;lazy            =&gt; 1,
&nbsp;&nbsp;builder         =&gt; 1,
);

Loading MooseX::AttributeShortcuts into your Moose class enables a whole bunch of extra parameter handing for has that provides shortcuts to make writing attribute code simpler. In the above example we see two such shortcuts: The first shortcut, writing isa_instance_of => 'SantasReindeer' instead of isa => class_type('SantasReindeer') provides us a little win, the biggest reduction in code comes from builder => 1. By setting the builder to a plain old 1 we're letting MooseX::AttributeShortcuts tell Moose that we want to use the default name for our builder - whatever the accessor is called with _build_ prepended to it. And because now we don't need a custom builder parameter for each attribute, we can declare all nine in a single has declaration!

Can we make this shorter still? Yep! We can just say, like with Moo, that this is lazy.

has [qw(
&nbsp;&nbsp;lead_reindeer second_reindeer third_reindeer forth_reindeer
&nbsp;&nbsp;fifth_reindeer sixth_reindeer seveth_reindeer eighth_reindeer
)] =&gt; (
&nbsp;&nbsp;is              =&gt; 'lazy',
&nbsp;&nbsp;isa_instance_of =&gt; 'SantasReindeer',
);

That shortcut create a read only accessor that is lazy and uses the default Moose accessor.

In addition to lazy, MooseX::AttributeShortcuts also accepts is => 'rwp'. rwp creates a public reader accessor of the form foo and a private writer accessor of the form _set_foo (since by convention in Perl methods starting with an underscore are private and shouldn't be called from outside of the class.)

Custom Anonymous Types

It would be nice to make sure that the lead reindeer has a glowing nose, but that would probably involve a custom type class to check the value's glowing_nose attribute:

package NorthPole::Types;

use MooseX::Types -declare =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;qw(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SantasReindeerWithAGlowingNose
&nbsp;&nbsp;&nbsp;&nbsp;)
];

subtype(
&nbsp;&nbsp;&nbsp;&nbsp;SantasReindeerWithAGlowingNose,
&nbsp;&nbsp;&nbsp;&nbsp;as class_type('SantasReindeer'),
&nbsp;&nbsp;&nbsp;&nbsp;where {},
&nbsp;&nbsp;&nbsp;&nbsp;inline_as {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$_[0]-&gt;parent()-&gt;_inline_check( $_[1] ) . &quot; &amp;&amp; $_[1]-&gt;glowing_nose&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;}
);

And then use that new type:

use NorthPole::Types qw( SantasReindeerWithAGlowingNose );

has lead_reindeer =&gt; (
&nbsp;&nbsp;is  =&gt; 'lazy',
&nbsp;&nbsp;isa =&gt; SantasReindeerWithAGlowingNose,
);

That is a lot of typing if you're only going to use it in one place. How about we use another shortcut?

has lead_reindeer =&gt; (
&nbsp;&nbsp;is  =&gt; 'lazy',
&nbsp;&nbsp;isa =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;die unless blessed &amp;&amp; $_-&gt;isa('SantasReindeer') &amp;&amp; $_-&gt;glowing_nose;
&nbsp;&nbsp;},
);

Here we're quickly defining a new one off type inline! It's not the most readable thing in the world though, is it? MooseX::AttributeShortcuts allows us to specify this in a more straight forward manner by allowing an inline constraint, which is an additional condition that will be checked for truthfulness after the isa / isa_instance_of check has occurred.

has lead_reindeer =&gt; (
&nbsp;&nbsp;is              =&gt; 'lazy',
&nbsp;&nbsp;isa_instance_of =&gt; 'SantasReindeer',
&nbsp;&nbsp;constraint      =&gt; sub { $_-&gt;glowing_nose },
);

As an added benefit writing a constraint / isa pair is that this subtypes the original type, meaning that coercions associated with the original type will just work!

Much much more

The Wise Old Elf continued to read the documentation for MooseX::AttributeShortcuts finding out about all sorts of things, from easy trigger, clearer and predicate declaration through quickly defining inline coercions and builder methods. He, like you should, was going to spend a good afternoon playing with this module - not only to avoid so much typing, but also to avoid writing so much boilerplate code and reduce the potential for bugs.

Mojolicious on the Command Line

2017-12-15T00:00:00Z

Mojolicious provides a utility class, ojo, that allows us to leverage the power of Mojolicious from the command line:

    perl -Mojo -E &#39;say g(&quot;http://goo.gl/EsGk3b&quot;)-&gt;text&#39;

The -M flag tells perl to load the following module, so -Mojo, despite looking like a super secret Mojo flag to perl actually is a cheeky way of saying use ojo.

ojo provides a whole host of single letter functions that are shortcuts to Mojolicious utilities, allowing you to quickly do things like fetching urls, reading and writing files, encoding and decoding json, manipulating data structures and a whole host more.

A Worked Example

Since the things you can do with ojo are virtually limitless, I thought a good intro to ojo might be to show a worked example from the command line.

I like reading the Perl Weekly, the weekly Perl email newsletter that pops into my inbox every week. It's so good that I often find myself wanting to refer back to a linked article later in the week when the email has been buried deep in my ever increasing inbox. Rather than improving my email filing (I'll get around to that one day) I instead wrote a script to grab an archived copy of the email from the Perl Weekly website and print out all the links. How did I do that?

So, let's start by having ojo fetch the archive and print it out

use ojo;

print g('http://perlweekly.com/archive/333.html')-&gt;text;

The g function creates a GET request, returning a Mojo::Message::Response object (which inherits a whole load of useful )

Printing the results of the text method output the entire HTML of the newsletter, of which the bit we're interested in looks like this:

    &lt;div class=&quot;entry-title&quot;&gt;
                &lt;a href=&quot;http://perladvent.org/2017/index.html&quot; style=&quot;
                   font-size: 18px;
                   font-weight: bold;
                   &quot;&gt;Perl Advent Calendar&lt;/a&gt;
              &lt;/div&gt;

So we can adapt our ojo script to use the dom method to pull out just these sections using a CSS selector:

print g(&quot;http://perlweekly.com/archive/333.html&quot;)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;dom(&quot;.entry-title a&quot;)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;join(&quot;\n\n&quot;)

The dom method returns a Mojo::Collection - Mojolicious's super smart array wrapper - on which we can call methods. Here we're just joining them together (and stringifying the objects that dom returned) so we can check we got the right stuff. The output now looks like:

    &lt;a href=&quot;http://perladvent.org/2017/index.html&quot; style=&quot;
                        font-size: 18px;
                        font-weight: bold;
                        &quot;&gt;Perl Advent Calendar&lt;/a&gt;

    &lt;a href=&quot;https://perl6advent.wordpress.com/&quot; style=&quot;
                        font-size: 18px;
                        font-weight: bold;
                        &quot;&gt;Perl 6 Advent Calendar&lt;/a&gt;

    &lt;a href=&quot;https://mojolicious.io/blog/&quot; style=&quot;
                        font-size: 18px;
                        font-weight: bold;
                        &quot;&gt;Mojolicious Advent Calendar&lt;/a&gt;
    (etc)

Okay, we now want to break apart the Mojo::DOM objects that dom returned to get the href and text of the link. To do this we use the map method on the collection that will call a subroutine on each element of the collection (similar to Perl's map keyword on arrays)

print g(&quot;http://perlweekly.com/archive/333.html&quot;)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;dom(&quot;.entry-title a&quot;)-&gt;map( sub {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$_-&gt;attr(&quot;href&quot;) . &quot;: &quot; . $_-&gt;text . &quot;\n&quot;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;})-&gt;join

Calling join with no arguments joins the elements with the empty string. The output is much much closer to what we want:

    https://perl6advent.wordpress.com/: Perl 6 Advent Calendar
    https://mojolicious.io/blog/: Mojolicious Advent Calendar
    http://www.lenjaffe.com/AdventPlanet/2017/: Advent Planet 2017
    http://blogs.perl.org/users/mohammad_s_anwar/2017/12/london-perl-workshop-2017---talks-review.html: London Perl Workshop 2017 - Talks Review
    http://blogs.perl.org/users/sawyer_x/2017/12/perl-5-porters-mailing-list-summary-november-21st---december-5th.html: Perl 5 Porters Mailing List Summary: November 21st - December 5th
    http://blogs.perl.org/users/ovid/2017/12/why-i-wrote-keyworddevelopment.html: Why I wrote Keyword::DEVELOPMENT
    http://blogs.perl.org/users/ovid/2017/12/why-i-wrote-keyworddevelopment.html: And here we go!
    https://p6weekly.wordpress.com/2017/12/04/2017-49-mischieventing/: 2017.49 Mischieventing
    http://blogs.perl.org/users/brian_d_foy/2017/12/nominate-perl-heroes-for-the-2017-white-camel-awards.html: Nominate Perl heroes for the 2017 White Camel Awards
    http://news.perlfoundation.org/2017/12/call-for-volunteers.html: Call for volunteers - TPC::NA 2018 (formerly knows as YAPC::NA)
    http://news.perlfoundation.org/2017/11/booking-sponsors-the-perl-5.html: Booking.com Sponsors the P5CMF
    http://niceperl.blogspot.com/: NICEPERL&#39;s lists
    https://perlmaven.com/open-to-read-and-write: Open file to read and write in Perl, oh and lock it too
    https://www.patreon.com/szabgab: Patreon for Gabor
    https://perl.careers/jobs/rapid-growth-in-perl---developers-wanted-for-an-expanding-central-london-company/?utm_source=perlweekly&amp;utm_campaign=perlweekly&amp;utm_medium=perlweekly: Rapid Growth in Perl - developers wanted for an expanding central London company
    https://perl.careers/jobs/be-a-trailblazer-in-a-time-of-growth---full-stack-architect-required-for-a-rapidly-expanding-london-company/?utm_source=perlweekly&amp;utm_campaign=perlweekly&amp;utm_medium=perlweekly: Be a trailblazer in a time of growth - Full Stack Architect required for a rapidly expanding London company
    https://perl.careers/jobs/londons-trendiest-office-space---lead-perl-developer/?utm_source=perlweekly&amp;utm_campaign=perlweekly&amp;utm_medium=perlweekly: London&#39;s Trendiest Office Space - Lead and Mid-Level Perl Developer roles

But oh dear, some of those links are really really long. Maybe we should use a URL shortener service to make these shorter?

Google's URL shortener works by posting a JSON data structure of the form:

    {
        &quot;longURL&quot;: &quot;https://developers.google.com/url-shortener/v1/getting_started&quot;
    }

To the URL https://www.googleapis.com/urlshortener/v1/url?key=??? where the key is the API key obtained by clicking on the GET A KEY button in the Google URL Shortener documentation. It returns a JSON data structure of the form

    {
      &quot;kind&quot;: &quot;urlshortener#url&quot;,
      &quot;id&quot;: &quot;https://goo.gl/xwCNC&quot;,
      &quot;longUrl&quot;: &quot;https://developers.google.com/url-shortener/v1/getting_started&quot;
    }

Doing this with ojo is straight forward. Instead of using g to make a GET request, we use p to make a POST request. Using json => ... we can pass in the datastructure to be serialized as JSON and posted to the URL.

use ojo;

print p(
&nbsp;&nbsp;&nbsp;&nbsp;&quot;https://www.googleapis.com/urlshortener/v1/url?key=$ENV{API_KEY}&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;{},
&nbsp;&nbsp;&nbsp;&nbsp;json =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;longUrl =&gt; &quot;https://developers.google.com/url-shortener/v1/getting_started&quot;
&nbsp;&nbsp;&nbsp;&nbsp;},
)-&gt;text

But of course we don't want the response from the server as a string, we want it as a Perl data structure so we can grab the id field. That's as simple as using json instead of text.

use ojo;

print p(
&nbsp;&nbsp;&nbsp;&nbsp;&quot;https://www.googleapis.com/urlshortener/v1/url?key=$ENV{API_KEY}&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;{},
&nbsp;&nbsp;&nbsp;&nbsp;json =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;longUrl =&gt; &quot;https://developers.google.com/url-shortener/v1/getting_started&quot;
&nbsp;&nbsp;&nbsp;&nbsp;},
)-&gt;json-&gt;{id};

Or, even better, we can pass a JSON pointer to json and have it extract the value we actually want for us

use ojo;

print p(
&nbsp;&nbsp;&nbsp;&nbsp;&quot;https://www.googleapis.com/urlshortener/v1/url?key=$ENV{API_KEY}&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;{},
&nbsp;&nbsp;&nbsp;&nbsp;json =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;longUrl =&gt; &quot;https://developers.google.com/url-shortener/v1/getting_started&quot;
&nbsp;&nbsp;&nbsp;&nbsp;},
)-&gt;json(&quot;/id&quot;)

Rolling that back into our original code like so:

use ojo;

print g(&quot;http://perlweekly.com/archive/333.html&quot;)
&nbsp;&nbsp;&nbsp;&nbsp;-&gt;dom(&quot;.entry-title a&quot;)-&gt;map( sub {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;p(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;https://www.googleapis.com/urlshortener/v1/url?key=$ENV{API_KEY}&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;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;json =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;longUrl =&gt; $_-&gt;attr('href')
&nbsp;&nbsp;&nbsp;&nbsp;&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;json(&quot;/id&quot;) .
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;: &quot; . $_-&gt;text . &quot;\n&quot;
&nbsp;&nbsp;&nbsp;&nbsp;})-&gt;join

Produces the output we'd like:

    https://goo.gl/wS2jSu: Perl Advent Calendar
    https://goo.gl/B7HqqD: Perl 6 Advent Calendar
    https://goo.gl/xGpyAy: Mojolicious Advent Calendar
    https://goo.gl/f9LBKS: Advent Planet 2017
    https://goo.gl/8aigk1: London Perl Workshop 2017 - Talks Review
    https://goo.gl/j2FzgA: Perl 5 Porters Mailing List Summary: November 21st - December 5th
    https://goo.gl/ptZRF3: Why I wrote Keyword::DEVELOPMENT
    https://goo.gl/ptZRF3: And here we go!
    https://goo.gl/GxETF8: 2017.49 Mischieventing
    https://goo.gl/8q2g21: Nominate Perl heroes for the 2017 White Camel Awards
    https://goo.gl/VCCoHc: Call for volunteers - TPC::NA 2018 (formerly knows as YAPC::NA)
    https://goo.gl/9BRvSA: Booking.com Sponsors the P5CMF
    https://goo.gl/XmJ1wT: NICEPERL&#39;s lists
    https://goo.gl/zPKg2u: Open file to read and write in Perl, oh and lock it too
    https://goo.gl/RChQDF: Patreon for Gabor
    https://goo.gl/wn3c2Q: Rapid Growth in Perl - developers wanted for an expanding central London company
    https://goo.gl/mVZGDQ: Be a trailblazer in a time of growth - Full Stack Architect required for a rapidly expanding London company
    https://goo.gl/4UZctX: London&#39;s Trendiest Office Space - Lead and Mid-Level Perl Developer roles

Prereqing around the Christmas Tree

2017-12-14T00:00:00Z

Mincepie Frostystockings was elated. The Wise Old Elf had just given him permission to port a bunch of little scripts that he'd been using on his development machine to the main North Pole git repository. From there they'd be deployed to the production machines and available for the entire devops team to use to help debug ongoing live issues.

"Just don't forget to make sure the dependencies are installed", were the Wise Old Elf's parting words.

Mincepie scratched his chin. He hadn't exactly been keeping track of dependencies when he'd written these scripts. They'd grown organically with him just installing whatever he'd needed to get it work with cpanm.

How was he going to work out exactly what his requirements are?

Technique 1: Hooking @INC

@INC is a global variable that holds all the locations that perl will look for modules when it attempts to load a module

    shell$ /usr/bin/perl -E &#39;say for @INC&#39;
    /Library/Perl/5.18/darwin-thread-multi-2level
    /Library/Perl/5.18
    /Network/Library/Perl/5.18/darwin-thread-multi-2level
    /Network/Library/Perl/5.18
    /Library/Perl/Updates/5.18.2
    /System/Library/Perl/5.18/darwin-thread-multi-2level
    /System/Library/Perl/5.18
    /System/Library/Perl/Extras/5.18/darwin-thread-multi-2level
    /System/Library/Perl/Extras/5.18
    .

When you use lib qw(...) it's this variable that Perl is modifying.

Perl also lets you put other things than simple strings in @INC, for example a subroutine reference. This subroutine reference will be called every time a module is required and is given the chance to return the code that perl should load (this is how tools like PAR can provide modules directly from a zipfile.)

You can abuse this mechanism to provide debugging each time something is loaded:

# use a BEGIN block so the code is executed before all
# the 'use' statements
BEGIN {
&nbsp;&nbsp;&nbsp;&nbsp;unshift @INC, sub {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my (undef, $name) = @_;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;say $name;

        # don't return anything, meaning Perl will continue
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# searching through @INC as before
        return;
&nbsp;&nbsp;&nbsp;&nbsp;}
}

use Data::Dumper;
use Test::More;
use JSON::PP;

This now prints out the following:

    Carp.pm
    strict.pm
    warnings.pm
    Exporter.pm
    XSLoader.pm
    constant.pm
    warnings/register.pm
    bytes.pm
    overload.pm
    overloading.pm
    Test/More.pm
    Test/Builder/Module.pm
    Test/Builder.pm
    Scalar/Util.pm
    List/Util.pm
    Test2/Util.pm
    Config.pm
    vars.pm
    PerlIO.pm
    Config_heavy.pl
    Config_git.pl
    Test2/API.pm
    Test2/API/Instance.pm
    Test2/Util/Trace.pm
    Test2/Util/HashBase.pm
    mro.pm
    DynaLoader.pm
    Test2/API/Stack.pm
    Test2/Hub.pm
    Test2/Util/ExternalMeta.pm
    Test2/Hub/Subtest.pm
    Test2/Hub/Interceptor.pm
    Test2/Hub/Interceptor/Terminator.pm
    Test2/Event/Ok.pm
    Test2/Event.pm
    Test2/Event/Diag.pm
    Test2/Event/Note.pm
    Test2/Event/Plan.pm
    Test2/Event/Bail.pm
    Test2/Event/Exception.pm
    Test2/Event/Waiting.pm
    Test2/Event/Skip.pm
    Test2/Event/Subtest.pm
    Test2/API/Context.pm
    Test/Builder/Formatter.pm
    Test2/Formatter/TAP.pm
    Test2/Formatter.pm
    Test/Builder/TodoDiag.pm
    JSON/PP.pm
    base.pm
    B.pm

There's a few things worth noting about this output:

The filenames of what we're search for are specified, not the module names. i.e. Foo/Bar.pm not Foo::Bar
It's not just the modules we're requiring directly, but the modules that our modules require. Test2::Event is listed even though we only required Test::More.
Things are only listed once. Even though Test::More itself loads strict and warnings they're not listed a second time after Data::Dumper required them

You can easily turn this into a module

package oreLoadingDebugging;
unshift @INC, sub { say $_[1]; return };
1;

That you can load from the command line

    perl -MoreLoadingDebugging -c myscript.pl

By using the -c flag our script doesn't actually run past the compiling stage meaning (hopefully) the script won't actually do anything.

The Downsides of This Technique

This is a fairly simple technique that, unfortunately has a few downsides:

Doesn't find run time dependencies. Since we're only running some of the Perl phases of execution, we won't find anything that's conditionally loaded at runtime(e.g. something like eval 'use SomethingOptional' if $ENV{FEATURE_NAME})
Totally unsafe. Even with the -c flag there's a chance that something bad will happen when you do this - you're actually running Perl code that's one BEGIN { system("rm -rf $HOME") } from deleting everything you care about on your system. You really don't want to do this with untrusted code!
Must compile. If the code you're using won't compile on the system - probably because you're actually missing some of those dependencies - then you can't effectively use this technique. Mincepie couldn't analyze the scripts on anything but the setup he'd originally written them on.
Filename cleanup. This technique won't give you a clean set of dependencies you can easily work with. The list contains things in the wrong form Foo/Bar.pm rather than Foo::Bar, and is peppered with things that are core pragma (base.pm, mro.pm) and core modules that you wouldn't necessarily need to list as a dependency.
Indirect dependencies. The listed dependencies also contains things that are your dependencies' dependencies - your indirect dependencies - and you don't want to necessarily state in your cpanfile that you depend on all of those because they might change as your direct dependencies' dependencies change

Technique 2: Parsing the source

An alternative approach to executing the code is to attempt to write a program that parses it and works out what all the use and require statements are attempting to do. With a dynamic language like Perl it's not possible for a program to work out every single possible situation that an elf could conceivably write to import code, but its certainly possible to recognize all the ways a sane elf might write import statements - even those that aren't executed every program run!

To do this Mincepie first tried a module on the CPAN Perl::PrereqScanner

use Perl::PrereqScanner;
my $scanner = Perl::PrereqScanner-&gt;new;
my $requirements = $scanner-&gt;scan_file('myscript.pl');

The returned $requirements is a CPAN::Meta::Requirements object. You can do a lot with this - including graphing it - but the simplest thing you can do is just dump it out as a hash;

use JSON::PP qw(encode_json);
print encode_json( $requirements-&gt;as_string_hash );

This helpfully prints out in the above example:

    {&quot;Data::Dumper&quot;:&quot;0&quot;,&quot;JSON::PP&quot;:&quot;0&quot;,&quot;Test::More&quot;:&quot;0&quot;}

This works on Moose code also:

package Rudolph;

use Moose;

extends 'SantasReindeer';

with 'GlowingRedNose';
...

Scanning this correctly shows our dependencies:

    {&quot;GlowingRedNose&quot;:&quot;0&quot;,&quot;Moose&quot;:&quot;0&quot;,&quot;SantasReindeer&quot;:&quot;0&quot;}

Speeding things up with Perl::PrereqScanner::Lite

The only problem with using Perl::PrereqScanner is that it's relatively slow. Under the hood it uses PPI, a Perl parsing library that builds a comprehensive object tree representing each keyword, symbol, structure, etc of the source code. It's powerful - but slow.

    shell$ time perl scan-moose-example.pl
    {&quot;Moose&quot;:&quot;0&quot;,&quot;GlowingRedNose&quot;:&quot;0&quot;,&quot;SantasReindeer&quot;:&quot;0&quot;}
    real    0m0.244s
    user    0m0.215s
    sys     0m0.027s

This might not seem a lot, but when you're scanning a hundred big files you're suddenly taking half a minute or so!

There are alternatives on the CPAN. For example Perl::PrereqScanner::Lite, which from a user point of view is almost the same to use:

use Perl::PrereqScanner::Lite;
my $scanner = Perl::PrereqScanner::Lite-&gt;new;
$scanner-&gt;add_extra_scanner('Moose'); # add extra scanner for moose style
my $result = $scanner-&gt;scan_file('Rudolph.pm');

use JSON::PP qw(encode_json);
print encode_json( $result-&gt;as_string_hash );

But is much faster:

    $ time perl scan-moose-example-with-lite.pl
    {&quot;SantasReindeer&quot;:&quot;0&quot;,&quot;Moose&quot;:&quot;0&quot;,&quot;GlowingRedNose&quot;:&quot;0&quot;}
    real    0m0.053s
    user    0m0.037s
    sys     0m0.014s

Finding optional dependencies with Perl::PrereqScanner::NotSoLite

So far our scanners have only found things that our code always depends on. What about optional dependencies? Things we'd like to load, but work around if they're not available?

if (eval &quot;use Term::ANSIColor; 1&quot;) {
&nbsp;&nbsp;&nbsp;&nbsp;say STDERR Term::ANSIColor::colored(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'STARTING DEBUGGING',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'red on_yellow'
&nbsp;&nbsp;&nbsp;&nbsp;);
} else {
&nbsp;&nbsp;&nbsp;&nbsp;say STDERR 'STARTING DEBUGGING';
}

Both Perl::PrereqScanner and Perl::PrereqScanner::Lite won't detect the dependency on Term::ANSIColor since it's loaded inside the eval string. However, Perl::PrereqScanner::NotSoLite will:

use Perl::PrereqScanner::NotQuiteLite;
my $scanner = Perl::PrereqScanner::NotQuiteLite-&gt;new( suggests =&gt; 1 );
my $result = $scanner-&gt;scan_file('Rudolph.pm');

use JSON::PP qw(encode_json);
say 'requires: '.encode_json( $result-&gt;requires-&gt;as_string_hash );
say 'suggests: '.encode_json( $result-&gt;suggests-&gt;as_string_hash );

We get two hashes out, our hard requirements and things we suggest:

    requires: {&quot;Reindeer&quot;:&quot;0&quot;,&quot;GlowingRedNose&quot;:&quot;0&quot;,&quot;Moose&quot;:&quot;0&quot;}
    suggests: {&quot;Term::ANSIColor&quot;:&quot;0&quot;}

Frostystocking's List

Mincepie Frostystockings had spend a good few hours scanning all his scripts till he was 100% sure that he'd identified everything that they needed to work correctly.

Now all he had to do was try and work out what the heck Acme::Damn was, and why his code was using it...

It's All There in the Numbers!

2017-12-13T00:00:00Z

The number of letters Santa received each year was truly staggering requiring the operations team at the North Pole to invest heavily in automation just to keep up. With state of the art OCR and lexical analysis AI to process the inputs - light-years ahead of what the humans were using - they were able to process almost any letter into an ordered list that their fulfillment team could process:

    1 Barbie
    3 Oranges
    24 Coloring pencils

Which is why Ponsettia Fairytrifle, head of the Letter Processing Team was surprised when Yule Cuddlefluff, head of the fulfillment team burst into her office door with a complaint right when she was in the middle of morning tea break.

"It's no good", he said, "we're just getting garbage out the other end. It'll need to be scrapped. Go back to the old way, with teams of elves reading the letters round the clock"

"Just wait a minute", Ponsettia countered, "before we throw the elfling out with the bathwater, how about you show me what's wrong?"

"What's Wrong! What's Wrong! Just look at this!"

    &#2535;&#2536; Shopkins

"Pure garbage!"

Well, Ponsettia did agree that did look a little unusual, but she thought she'd dig a little before scrapping her entire department. She wondered what those weird characters were, and decided to find out. Perl's charnames::viacode is able to print out the name for any unicode codepoint, and ord can turn any individual character into a codepoint, so...

`1:  2:  3:  4: `	`use utf8; use charnames qw(:full); my @chars = split //, "১২"; say charnames::viacode(ord $_) foreach @chars;`

At which point the script printed out:

    BENGALI DIGIT ONE
    BENGALI DIGIT TWO

And everything became clear! The weird junk was just numbers in another script! After all, the letters did come in from all around the world...

"Don't worry, I can fix this", Ponsettia explained to Yule, "It's just a minor change to the code".

Unicode::UCD is a core module that has been shipping with Perl since the pre-releases of Perl 5.8. One of the things it can do is turn digits of any script into something Perl will be able treat as a number.

`1:  2: `	`use Unicode::UCD qw(num); say num("১২"); # prints "12"`

However, it's clever enough to return undefined if you start mixing your scripts (as that's likely pure nonsense)

use Unicode::UCD qw(num);
say 'junk'
&nbsp;&nbsp;if !defined num(&quot;\N{DEVANAGARI DIGIT THREE}\N{CHAM DIGIT TWO}&quot;);

A few minutes after Yule had left Ponsettia had already checked in a change to her codebase to make the lists print out the right thing. Disaster quickly averted she returned to her still warm cup of tea.

A Christmas Memory

2017-12-12T00:00:00Z

"I just don't get it!"

An elf raising his voice was unheard of. Normally softly spoken, Cedar Greentrifle was several decibels above where his voice should have been and getting louder.

"Mr Greentrifle", the Wise Old Elf interjected, "May I be of some assistance?"

"It's this baubling code! It keeps eating all the memory. And I can't work out why!"

"Ah, then maybe this might be a good time to show you a tool I learned about at the London Perl Workshop that might be just the ticket!"

Introducing Devel::MAT

Devel::MAT is a handy dandy command line tool that can help you work out exactly what is taking up the memory in your Perl program. You can trigger a dump summarizing your program's memory usage at any point in the execution, then load up the pmat console and poke around in that dump to your heart's content until you figure out exactly what went wrong.

Let's see how to use it on a simple example program that's going to allocate a huge string.

#!/usr/bin/perl

use strict;
use warnings;

my $elf = &quot;happy&quot;;
$elf x= 1024*1024*1024;  # 5 Gigs!

In order to analyze the memory usage in our code we need to alter it so that it dumps a summary of the memory to a pmat dump file during the execution of the code. The simplest way to do this is to add a die statement...

#!/usr/bin/perl

use strict;
use warnings;

my $elf = &quot;happy&quot;;
$elf x= 1024*1024*1024;  # 5 Gigs!

die;

..then run the same code with the Devel::MAT::Dumper module configured on the command line to hook exception handling so that a dump file is written when the die occurs:

    shell$ perl -MDevel::MAT::Dumper=-dump_at_DIE script.pl
    Dumping to /Users/Cedar/test/script.pl.pmat because of DIE
    Died at script.pl line 9.

This creates a pmat dump file on disk named the same as our Perl script with an additional .pmat extension:

    shell$ ls
    script.pl  script.pl.pmat

We can load this into the pmat interactive console

    shell$ pmat script.pl.pmat
    Perl memory dumpfile from perl 5.22.0
    Heap contains 2366 objects
    pmat&gt;

And away we go. pmat offers a bunch of commands, all of which can be listed with the help option.

    pmat&gt; help
    callstack - Display the call stack
    count     - Count the various kinds of SV
    elems     - List the elements of an ARRAY SV
    find      - List SVs matching given criteria
    help      - Display a list of available commands
    identify  - Identify an SV by its referrers
    io        - Commands working with IO SVs
    largest   - Find the largest SVs by size
    roots     - Display a list of the root SVs
    show      - Show information about a given SV
    sizes     - Summarize object and byte counts across different SV types
    symbols   - Display a list of the symbol table
    values    - List the values of a HASH-like SV

Tracking down the largest things in your code

The largest command can be very helpful in tracking down what's taking up the most space:

    pmat&gt; largest
    SCALAR(PV) at 0x7fab7d016a60: 5.0 GiB
    HASH(540) at 0x7fab7d002e90=strtab: 33.6 KiB
    INVLIST() at 0x7fab7e01bf88: 9.9 KiB
    INVLIST() at 0x7fab7e01c018: 9.8 KiB
    STASH(84) at 0x7fab7d0030d0=defstash: 3.1 KiB
    others: 228.5 KiB

There's our string, right there at the top: 0x7fab7d016a60. Because our example code was so simple we already know which scalar that is. But, if we didn't, we could easily ask pmat to identify it for us

    pmat&gt; identify 0x7fab7d016a60
    SCALAR(PV) at 0x7fab7d016a60 is:
    \-the lexical $elf at depth 1 of CODE() at 0x7fab7d003478=main_cv, which is:
      \-the main code

Oh, that's obvious. If our code is a little more complex then things are still descriptive enough for us to understand what's happening. For example:

sub santas_workshop {
&nbsp;&nbsp;&nbsp;&nbsp;my $phrase = &quot;happy&quot;;

&nbsp;&nbsp;&nbsp;&nbsp;my $elf = {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;attributes =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;mood =&gt; scalar($phrase x (1024*1024*1024)),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;height =&gt; 'short',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;name =&gt; 'Cedar Greentrifle'
&nbsp;&nbsp;&nbsp;&nbsp;};

&nbsp;&nbsp;&nbsp;&nbsp;die();
}

Results in the identification:

    pmat&gt; identify 0x7f9f9b011860
    SCALAR(PV) at 0x7f9f9b011860 is:
    \-value {state} of HASH(1) at 0x7f9f9b003250, which is:
      \-(via RV) value {attr} of HASH(1) at 0x7f9f9b011878, which is:
        \-(via RV) the lexical $elf at depth 1 of CODE(PP) at 0x7f9f9b016a78, which is:
          \-the symbol &#39;&amp;main::santas_workshop&#39;

So, we can easily identify large strings. What about big data structures

#!/usr/bin/perl

use strict;
use warnings;

sub expand {
&nbsp;&nbsp;&nbsp;&nbsp;my $count = shift() - 1;
&nbsp;&nbsp;&nbsp;&nbsp;return &quot;Merry Christmas&quot; if $count == 0;
&nbsp;&nbsp;&nbsp;&nbsp;return {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;map { $_ =&gt; expand($count) } 1..10
&nbsp;&nbsp;&nbsp;&nbsp;};
}

my $big_data_structure = expand(6);
die();

This creates a tree with a million copies of the string Merry Christmas in it. What does pmat make of this?

    Perl memory dumpfile from perl 5.22.0
    Heap contains 124628 objects
    pmat&gt; largest
    HASH(548) at 0x7fb053002e90=strtab: 33.9 KiB
    INVLIST() at 0x7fb053085f88: 9.9 KiB
    INVLIST() at 0x7fb053086018: 9.8 KiB
    STASH(85) at 0x7fb0530030d0=defstash: 3.2 KiB
    HASH(70) at 0x7fb0530217c8: 2.7 KiB
    others: 10.4 MiB

Not so helpful, the largest thing is the strtab (the cache of constant strings used in our code itself.) Not very helpful.

This is where the --owned option for largest comes in handy. This takes a while to execute, but it can work out cumulative sizes.

    pmat&gt; largest --owned
    CODE() at 0x7fb053003478=main_cv: 10.2 MiB: of which
     |   PAD(3) at 0x7fb053003490: 10.2 MiB: of which
     |    |   REF() at 0x7fb053016ad8: 10.2 MiB
     |    |   HASH(10) at 0x7fb053011950: 10.2 MiB
     |    |   others: 10.2 MiB
     |   SCALAR(UV) at 0x7fb053016a60: 24 bytes
    STASH(85) at 0x7fb0530030d0=defstash: 70.4 KiB: of which
     |   GLOB(%*) at 0x7fb053017918: 22.6 KiB: of which
     |    |   STASH(2) at 0x7fb053021678: 22.4 KiB
     |    |   GLOB(%*) at 0x7fb053034d48: 22.1 KiB
     |    |   others: 22.1 KiB
     |   GLOB(%*) at 0x7fb053080b20: 14.6 KiB: of which
     |    |   STASH(39) at 0x7fb053080b38: 14.5 KiB
     |    |   GLOB(&amp;*) at 0x7fb055015de0: 2.4 KiB
     |    |   others: 12.7 KiB
     |   GLOB(%*) at 0x7fb0530809e8: 3.9 KiB: of which
     |    |   STASH(3) at 0x7fb053080a60: 3.8 KiB
     |    |   GLOB(&amp;*) at 0x7fb053080ad8: 3.3 KiB
     |    |   others: 3.3 KiB
     |   others: 26.1 KiB
    HASH(548) at 0x7fb053002e90=strtab: 33.9 KiB
    REF() at 0x7fb053085fb8: 10.0 KiB: of which
     |   ARRAY(5) at 0x7fb053085fd0: 10.0 KiB: of which
     |    |   INVLIST() at 0x7fb053085f88: 9.9 KiB
     |    |   SCALAR(UV) at 0x7fb053085fa0: 24 bytes
    REF() at 0x7fb0530f1450: 9.9 KiB: of which
     |   ARRAY(5) at 0x7fb053085fe8: 9.9 KiB: of which
     |    |   INVLIST() at 0x7fb053086018: 9.8 KiB
     |    |   SCALAR(UV) at 0x7fb0530f1438: 24 bytes
    others: 162.8 KiB

So the largest thing is unsurprisingly the main code. It owns a REF() to a data structure at 0x7fb053016ad8 that is just over ten megabytes in size. And if we identify that:

    pmat&gt; identify 0x7fb053016ad8
    REF() at 0x7fb053016ad8 is:
    \-the lexical $big_data_structure at depth 1 of CODE() at 0x7fb053003478=main_cv, which is:
      -\the main code

...we see it's the $big_data_structure we were expecting.

Tracking Down Leaks

Perl uses reference counting to keep track of memory. When a data structure has nothing pointing to it anymore (i.e. no variables point to it, no other parts of a data structure point at it) it's unreachable by the program and can be cleared away.

But what happens if we have a data structure point to itself?

my $greeting;
$greeting = {
&nbsp;&nbsp;&nbsp;&nbsp;data =&gt; 'Merry Christmas',
&nbsp;&nbsp;&nbsp;&nbsp;link =&gt; \$greeting,
};

Perl will never be able to reclaim that. The anonymous hash will always be pointed to by the hash value, and the hash value will always be pointed to by the anonymous hash. When $greeting goes out of scope this will leak memory. Do that enough times and this will be the source of the extra memory your program is using.

How can we find these? It's tricky. If the data structure is large enough we can use the largest technique above. Otherwise, we can search for things in the data structure to see if we've got more of these still hanging around than we might expect. For example:

    pmat&gt; find pv --eq &#39;Merry Christmas&#39;
    SCALAR(PV) at 0x7fa2d56e3330: &quot;Merry Christmas&quot;
    SCALAR(PV) at 0x7fa2d54fa2d0: &quot;Merry Christmas&quot;
    SCALAR(PV) at 0x7fa2d57a0588: &quot;Merry Christmas&quot;
    SCALAR(PV) at 0x7fa2d5052890: &quot;Merry Christmas&quot;
    SCALAR(PV) at 0x7fa2d3901790: &quot;Merry Christmas&quot;
    SCALAR(PV) at 0x7fa2d29b26a0: &quot;Merry Christmas&quot;
    SCALAR(PV) at 0x7fa2d518f440: &quot;Merry Christmas&quot;
    SCALAR(PV) at 0x7fa2d579dae0: &quot;Merry Christmas&quot;
    SCALAR(PV) at 0x7fa2d391f868: &quot;Merry Christmas&quot;
    SCALAR(PV) at 0x7fa2d2c7a2a8: &quot;Merry Christmas&quot;
    SCALAR(PV) at 0x7fa2d5259f48: &quot;Merry Christmas&quot;
    SCALAR(PV) at 0x7fa2d2c7b1a8: &quot;Merry Christmas&quot;
    SCALAR(PV) at 0x7fa2d297ae00: &quot;Merry Christmas&quot;
    SCALAR(PV) at 0x7fa2d2a53528: &quot;Merry Christmas&quot;
    SCALAR(PV) at 0x7fa2d510f6a0: &quot;Merry Christmas&quot;
    SCALAR(PV) at 0x7fa2d55ce980: &quot;Merry Christmas&quot;
    SCALAR(PV) at 0x7fa2d401d0d8: &quot;Merry Christmas&quot;
    ...

identify can tell us a little about each of these scalars (including that it has a loop), but obviously not which variable holds them (because none does):

    pmat&gt; identify 0x7fa2d56e3330
    SCALAR(PV) at 0x7fa2d56e3330 is:
    \-value {data} of HASH(2) at 0x7fa2d56e3300, which is (*A):
      \-(via RV) the referrant of REF() at 0x7fa2d56e3348, which is:
        \-value {link} of HASH(2) at 0x7fa2d56e3300, which is:
          \-already found as *A

You might be tempted to search for a hash key. This won't go as well:

    pmat&gt; find pv --eq &#39;data&#39;
    SCALAR(PV) at 0x7fa2d2003340: &quot;data&quot;

    pmat&gt; identify 0x7fa2d2003340
    SCALAR(PV) at 0x7fa2d2003340 is:
    \-a constant of CODE() at 0x7fa2d2003478=main_cv, which is:
      \-the main code

That's because internally perl doesn't keep a copy of the hash key inside each hash - the one and only scalar containing data is the one perl created for the constant string used in the code itself.

A Happy Elf

"I GOT IT I GOT IT I GOT IT"

"Mr Greentrifle! Please keep the noise down..."

Tiny Path Handling

2017-12-11T00:00:00Z

Path::Tiny is a tiny abstraction around file paths that makes it very easy to manipulate them and perform common operations on them.

Recently I've started using Path::Tiny in preference to both the internal Perl operators for file manipulation and the other abstractions like File::Spec and Path::Class because it makes it really easy to handle common operations easily without making the kind of common mistakes that those other approaches often result in when you're coding quickly.

Enough explaining, let's see how to use Path::Tiny in practice...

Building New Path::Tiny instances

Construction of paths is simple: The path function just takes an absolute or relative path.

use Path::Tiny qw( path );

# the password file
my $passwords = path('/etc/passwd');

# my home directory
my $homedir   = path($ENV{HOME});

As you can see Path::Tiny makes no distinction between directories or files - it relies entirely on you doing the right operations on them.

These objects stringify directly into the string form of the path so on my macOS machine this:

say $homedir;

Prints

    /Users/Mark

Paths can be extended with the child method:

# this is '/Users/Mark/shopping_lists/xmas.txt'
my $xmas_list = $homedir-&gt;child('shopping_lists')-&gt;child('xmas.txt');

This could have been written as:

my $xmas_list = $homedir-&gt;child('shopping_lists', 'xmas.txt');

Or like so:

my $xmas_list = $homedir-&gt;child('shopping_lists/xmas.txt');

Or so:

my $relative_path = path('shopping_lists/xmas.txt');
my $xmas_list = $homedir-&gt;child( $relative_path );

Or even with the path constructor function like any of these:

my $xmas_list = path($homedir, 'shopping_list', 'xmas.txt');
my $xmas_list = path($homedir, 'shopping_list/xmas.txt');
my $xmas_list = path($homedir, path('shopping_list/xmas.txt'));

As you can see, using Path::Tiny makes combining paths really simple and helps me avoid one of the biggest problems I always end up with - if the directory path has a trailing slash or not

my $dir                 = '/Users/Mark/shopping_list';
my $with_trailing_slash = &quot;$dir/&quot;;
my $file                = 'mia_birthday.txt';

# WRONG: prints &quot;/Users/Mark/shopping_listmia_birthday.txt&quot;
say &quot;$dir$file&quot;;

# WRONG: prints &quot;/Users/Mark/shopping_list//mia_birthday.txt&quot;
say &quot;$with_trailing_slash/$file&quot;;

# RIGHT: both prints &quot;/Users/Mark/shopping_list/mia_birthday.txt&quot;
say path($dir, $file);
say path($with_trailing_slash, $file);

A Path::Tiny object can also be broken down into the parent directory or the filename without the directory part (the basename):

# This prints '/Users/Mark/shopping_list'
say $xmas_list-&gt;parent;

# This prints 'xmas.txt'
say $xmas_list-&gt;basename;

This sure beats having to use a regular expression on the path string - that too can get very complicated with trailing slashes..

Reading and Writing Files

While easy path manipulation is awesome, where Path::Tiny really shines is how it makes common file operations simple and only one line long:

# add to the end of the file
$xmas_list-&gt;append(&quot;A partridge for the pair tree\n&quot;);

# read in the entire file as single string, then write it out again
my $contents = $xmas_list-&gt;slurp;
$contents =~ s/pair/pear/g;
$xmas_list-&gt;spew( $contents );

Of course, in this day and age we should really be using UTF-8 encoding. Path::Tiny makes this trivial by providing the _utf8 suffix for all the file reading / writing methods which Does The Right Thing:

$xmas_list-&gt;append_utf8(&quot;A \N{BIRD} for the \N{PEAR}\N{DECIDUOUS TREE}&quot;);

Not shown is Path::Tiny Doing The Right Thing when appending to a file when it comes to multiple processes writing to the file at the same time. In traditional Perl code you should open the filehandle you're about to write to and then flock it for the duration you have the file open so that any other code that also takes these two steps will wait for the other process to complete writing and you to release the flock before taking its turn. In reality, most coders skip this step and just hope that they remain lucky that such a conflict doesn't occur ending up with two processes writing to the file at exactly the same time. Path::Tiny handles all of that for you so you don't have to.

Path::Tiny has a slew of handy methods for common reading and writing operations on a file. For example, it can also read a file in as an array of lines:

# sort our Christmas list
$xmas_list-&gt;spew_utf8( sort $xmas_list-&gt;lines_utf8 );

Or alter each line in the file and atomically write the file contents back:

my $counter = 1;
$xmas_list-&gt;edit_lines_utf8(sub {
&nbsp;&nbsp;&nbsp;&nbsp;$_ = &quot;$counter. $_&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;$counter++;
});

Rather than list every single handy-dandy operation that Path::Tiny provides in this article - including reading directory contents (or iterating over them via an iterator function or via callback), opening temp files, absolute and relative path conversion, file testing, copying, removing directory trees and much more - I encourage you to peruse the extensive documentation.

Evaluating the NaughtyNice Formula

2017-12-10T00:00:00Z

As we talked about yesterday, Sugarplum Stripyboughs was developing a system where a formula was stored in the database could be used to calculate the NaughtyNice Formula for a particular gift for a particular child. Using a recursive regular expression she'd already verified that the formula string was valid. Now she had to work out how to execute it.

Turning the Formula into Perl Code

One approach to executing the formula might be build some sort of evaluation engine in code that could interpret the formula - though this would be quite complicated to do and run slowly! A simpler, and more performant, technique would be to transform the formula into Perl code.

Remember, the formula Sugarplum has to execute looks something like this:

  (number_of_tantrums/6)+(age/12*(teeth_brushs_this_year+flosses_this_year))/2

The corresponding Perl code for this would be the following, more or less:

my $formula = sub {
&nbsp;&nbsp;return ($_[0]{number_of_tantrums} / 6)
&nbsp;&nbsp;&nbsp;+ ($_[0]{age} / 12 * (
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$_[0]{teeth_brushs_this_year}+$_[0]flosses_this_year)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;)/2
}

Which could then be called like so:

my $result = $formula-&gt;({
&nbsp;&nbsp;age =&gt; 12,
&nbsp;&nbsp;number_of_tantrums =&gt; 49,
&nbsp;&nbsp;teeth_brushs_this_year =&gt; 721,
&nbsp;&nbsp;flosses_this_year =&gt; 321,
});

Turning the validated expression into code is reasonably straight forward - we just need to convert the variables in the expression into Perl variables as everything else is already valid Perl code.

sub build_formula {
&nbsp;&nbsp;&nbsp;&nbsp;my $formula = shift;

    # replace foo_bar -&gt; $_[0]{foo_bar}
    $formula =~ s{([a-z_]+)}{\$_[0]{$1}}g;

&nbsp;&nbsp;&nbsp;&nbsp;return eval &quot;sub { $formula }&quot; || die $@;
}

Closing over variables

It turns out that several of the variables that the elves over in the Niceness Assurance Department wanted to use in the formula weren't related to the child at all. Things like the value of the gift and number left in stock are instead related to database attributes for that gift, and they need to pass these values in at the time the formula is compiled.

"Hmm," thought Sugarplum Stripyboughs to herself, "How can I do that?" She decided to extend the previous grammar to allow uppercase constants.

my $string = 'good_deeds/GIFT_VALUE*STOCK';

my $playing_cards = build_formula(
&nbsp;&nbsp;&nbsp;&nbsp;$string,
&nbsp;&nbsp;&nbsp;&nbsp;gift_value =&gt; 2,
&nbsp;&nbsp;&nbsp;&nbsp;stock      =&gt; 100,
);

my $real_elephant = build_formula(
&nbsp;&nbsp;&nbsp;&nbsp;$string,
&nbsp;&nbsp;&nbsp;&nbsp;gift_value =&gt; 10_000,
&nbsp;&nbsp;&nbsp;&nbsp;stock      =&gt; 1,
);

Now all she had to do was rewrite her conversions regular expressions to allow upper case variables to be used in the calculation.

sub build_formula {
&nbsp;&nbsp;&nbsp;&nbsp;my $formula = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my %args    = @_;

&nbsp;&nbsp;&nbsp;&nbsp;my $GIFT_VALUE = $args{gift_value};
&nbsp;&nbsp;&nbsp;&nbsp;my $STOCK      = $args{stock};

    # replace FOO_BAR -&gt; $FOO_BAR
    $formula =~ s{([A-Z][A-Z_]*)}{\$$1}g;

    # replace foo_bar -&gt; $_[0]{foo_bar}
    $formula =~ s{([a-z][a-z_]*)}{\$_[0]{$1}}g;

&nbsp;&nbsp;&nbsp;&nbsp;return eval &quot;sub { $formula }&quot; || die $@;
}

Sugarplum was taking advantage of the way perl's memory management works to close over the constants in the subroutine. Each subroutine reference that build_formula's eval creates sees the particular version of $GIFT_VALUE and $STOCK that was assigned in that subroutine only and closes over them retaining their value.

She deployed the updated code and started happily working on the next story in the backlog.

The Mistake, and a Solution

When Sugarplum got back to work early the next data she discovered that one of the elves in the Niceness Assurance Department had created a ticket.

    Value for COST is wrong

Wait, what? There was no $COST variable in this subroutine! After staring at her editor for a few minutes she was stumped. In a last ditch effort she tried searching for the string. And then she found it....at the top of the file, in a totally unrelated part of the code

# boolean to enable/disable cost tracking functionality
const my $COST =&gt; 1;

Ooooh, that's right. The eval will close over any variable that's in scope, including those we don't want it to, letting anyone use anything from anywhere despite it having nothing to do with the formula calculations. What Sugarplum needed was a way to convince Perl which variables she wanted, and which she didn't.

Enter Eval::Closure from the CPAN.

sub build_formula {
&nbsp;&nbsp;&nbsp;&nbsp;my $formula = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my %args    = @_;

    # replace FOO_BAR -&gt; $FOO_BAR
    $formula =~ s{([A-Z][A-Z_]*)}{\$$1}g;

    # replace foo_bar -&gt; $_[0]{foo_bar}
    $formula =~ s{([a-z][a-z_]*)}{\$_[0]{$1}}g;

&nbsp;&nbsp;&nbsp;&nbsp;return eval_closure(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;source =&gt; &quot;sub { $formula }&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;environment =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'$GIFT_VALUE' =&gt; \$args{gift_value},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'$STOCK'      =&gt; \$args{stock},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;);
}

Eval::Closure lets us control exactly which variables the code we compile has access to! Passing in an invalid formula like:

  age/COST

Results in a proper error being thrown even when a $COST is in scope

  Failed to compile source: Global symbol &quot;$COST&quot; requires explicit
  package name (did you forget to declare &quot;my $COST&quot;?) at (eval 5) line 5.

That bug was fixed! Now all Sugarplum had left to do was head down to the Niceness Assurance Department to inquire exactly what they expected COST to do....

Matching the NaughtyNice Formula

2017-12-09T00:00:00Z

Back in the day, you were either Naughty or Nice, and you either got coal or presents from Santa. But Santa had decided that this was a little too all or nothing. So he had tasked his Elf R&D department to develop an application that could determine on a case by case basis if the the child had been good enough for that particular gift.

For example, a child who couldn't sit still when asked probably shouldn't get that eighty pound bar of chocolate that they wanted no matter how often they'd tidied their room. The new art supplies that little Suzy wanted shouldn't really go to the girl that had doodled over the dining room table with the permanent marker. It was a complicated issue.

The elves had decided that each gift should have a NaughtyNice Formula associated with it - an expression stored in the database that could be used to decide if the child deserved that item.

Sugarplum Stripyboughs had been tasked with building the web forms that acted as a front end for the database that all the pointy eared Elves over in the Niceness Assurance Department could use to enter the formula.

The bit she was stuck on was validating the formulas that the Elves were entering in the web app - that they were semantically correct and okay to store in the database. A typical formula might look like this:

     (number_of_tantrums/6)+(age/12*(teeth_brushes_this_year+flosses_this_year))/2

That is to say some variables, some integers, stuck together with brackets and the standard four arithmetic operators (+, -, *, and /).

Writing a regular expression to match this kind of expression without worring about those brackets is fairly straight forward stuff. But those brackets have to match each other. Sugarplum needed to be able to tell that:

     (number_of_a_grades-number_of_c_grades+(days_missed_of_school)

Just wasn't a valid formula - it's missing the last closing ).

The trouble is that expressions like this aren't a "Type-3" grammar on the Chomsky hierarchy - the type of grammars a traditional regular expression engine can match. Simply: To match the number of closing brackets with the number of opening brackets, you need to keep count of the number of times you saw an opening bracket, and a traditional regular expression engine can't do that.

Perl, on the other hand, has a more powerful regular expression engine that can handle these kinds of matches.

Backus-Naur Form

BNF is a way of specifying a grammar formally. Sugarplum quickly whipped up one for the formulas she was trying to match.

 &lt;letter&gt;     ::= &quot;a&quot; | &quot;b&quot; | &quot;c&quot; | &quot;d&quot; | &quot;e&quot; | &quot;f&quot; | &quot;g&quot; | &quot;h&quot; | &quot;i&quot; | &quot;j&quot; |
                  &quot;k&quot; | &quot;l&quot; | &quot;m&quot; | &quot;n&quot; | &quot;o&quot; | &quot;p&quot; | &quot;q&quot; | &quot;r&quot; | &quot;s&quot; | &quot;t&quot; |
                  &quot;u&quot; | &quot;v&quot; | &quot;w&quot; | &quot;x&quot; | &quot;y&quot; | &quot;z&quot;
 &lt;unders&gt;     ::= &lt;letter&gt; | &quot;_&quot; | &lt;letter&gt; &lt;unders&gt; | &quot;_&quot; &lt;unders&gt;
 &lt;variable&gt;   ::= &lt;letter&gt; | &lt;letter&gt; &lt;unders&gt;

 &lt;digit&gt;      ::= &quot;0&quot; | &quot;1&quot; | &quot;2&quot; | &quot;3&quot; | &quot;4&quot; | &quot;5&quot; | &quot;6&quot; | &quot;7&quot; | &quot;8&quot; | &quot;9&quot;
 &lt;startdigit&gt; ::= &quot;1&quot; | &quot;2&quot; | &quot;3&quot; | &quot;4&quot; | &quot;5&quot; | &quot;6&quot; | &quot;7&quot; | &quot;8&quot; | &quot;9&quot;
 &lt;digits&gt;     ::= &lt;digit&gt; | &lt;digit&gt; &lt;digits&gt;
 &lt;number&gt;     ::= &lt;startdigit&gt; | &lt;startdigit&gt; &lt;digits&gt;

 &lt;oper&gt;       ::= &quot;+&quot; | &quot;-&quot; | &quot;*&quot; | &quot;/&quot;
 &lt;bracket&gt;    ::= &quot;(&quot; &lt;expression&gt; &quot;)&quot;
 &lt;thing&gt;      ::= &lt;number&gt; | &lt;variable&gt; | &lt;bracket&gt;
 &lt;expression&gt; ::= &lt;thing&gt; | &lt;thing&gt; &lt;oper&gt; &lt;expression&gt;

That was...better? She decided to make it a bit more readable by turning some of the overly wordy bits into standard regular expression syntax

    &lt;variable&gt;   ::= qr/[a-z][a-z_]*/
    &lt;number&gt;     ::= qr/[1-9][0-9]*/
    &lt;oper&gt;       ::= qr/[+*/-]/
    &lt;bracket&gt;    ::= &quot;(&quot; &lt;expression&gt; &quot;)&quot;
    &lt;thing&gt;      ::= &lt;number&gt; | &lt;variable&gt; | &lt;bracket&gt;
    &lt;expression&gt; ::= &lt;thing&gt; | &lt;thing&gt; &lt;oper&gt; &lt;expression&gt;

Okay, that's a lot clearer. Now to turn this into a Perl regular expression!

Named Capture Groups

In Perl you can create named capture groups in your regular expressions:

&quot;James Bond&quot; =~ /^ (?&lt;first&gt;\S+) \s* (?&lt;last&gt;\S+) $/x;
say &quot;The name's $+{last}, $+{first} $+{last}&quot;

It's actually possible to use named capture blocks to create a sort of library of reusable named regular expressions inside a regular expression:

say &quot;Matches&quot; if $string =~ m{
&nbsp;&nbsp;&nbsp;&nbsp;(?(DEFINE)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(?&lt;wise&gt; Melchior | Caspar | Balthazar )
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(?&lt;gift&gt; gold | frankincense | myrrh )
&nbsp;&nbsp;&nbsp;&nbsp;)

&nbsp;&nbsp;&nbsp;&nbsp;(?:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(?&amp;wise) [ ] (brought|gave) [ ](?&amp;gift) |
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(?&amp;gift) [ ] was [ ] (brought|given) [ ] by [ ] (?&amp;wise)
&nbsp;&nbsp;&nbsp;&nbsp;)
}x;

Everything within the (?(DEFINE) ... ) block isn't actually matched until the various named blocks are called with the (?&block_name) syntax.

While having this sort of library of named parts of a regular expression is nice from a readability point of view, the real power comes from the fact that these definitions can themselves reference other named capture blocks recursively. This allowed Sugarplum to basically directly port the BNF into a Perl regular expression:

say &quot;Matches&quot; if $string =~ m{
&nbsp;&nbsp;(?(DEFINE)
&nbsp;&nbsp;&nbsp;&nbsp;(?&lt;variable&gt;    [a-z][_a-z]* )
&nbsp;&nbsp;&nbsp;&nbsp;(?&lt;number&gt;      [1-9][0-9]* )
&nbsp;&nbsp;&nbsp;&nbsp;(?&lt;oper&gt;        [+*/-] )
&nbsp;&nbsp;&nbsp;&nbsp;(?&lt;bracket&gt;     [(] (?&amp;expression) [)] )
&nbsp;&nbsp;&nbsp;&nbsp;(?&lt;thing&gt;       (?&amp;number) | (?&amp;variable) | (?&amp;bracket) )
&nbsp;&nbsp;&nbsp;&nbsp;(?&lt;expression&gt;  (?&amp;thing) | (?&amp;thing) (?&amp;oper) (?&amp;expression) )
&nbsp;&nbsp;)

&nbsp;&nbsp;\A (?&amp;expression) \z
}x;

With that regular expression written Sugarplum was done with the hard part...unless someone wanted her to write code to execute the formula that is... (to be continued)

Constantly Merry

2017-12-08T00:00:00Z

One of the marks of a good code is that you're aware of what can change and what will not.

For example some things are destined to change:

my $mince_pies_eaten = 0;
$mince_pies_eaten++;  # yum!
$mince_pies_eaten++;  # yum! yum!

And some things are not:

my $WISE_MEN = 3;

It's good practice for your language to prevent you altering constants. Ideally if you accidentally did:

$WISE_MEN++;

You'd want Perl to throw an exception. And you can easily make Perl do that with a little help from a module on the CPAN:

use Const::Fast;

const my $WISE_MEN =&gt; 3;

say &quot;There are $WISE_MEN wise men&quot;;

$WISE_MEN++;

Results in:

    There are 3 wise men
    Modification of a read-only value attempted at - line 7.

The const keyword preceding the my causes the variable that my refers to to be marked read-only and causes perl to throw a run-time exception if anything tries to alter it.

Other constant techniques that don't work as well

There have been several techniques for constants in Perl that you might have heard of, and it's probably best to understand why we shouldn't use them in modern, well maintained code.

The Inlined Subroutine Trick

If you write a subroutine that returns a simple value:

sub WISE_MEN() { return 3 }

Then that subroutine will be inlined when perl compiles your code. This means that:

use Lingua::EN::Numbers::Ordinate qw( ordinate );

sub WISE_MEN() { 3 }

for (1..WISE_MEN) {
&nbsp;&nbsp;&nbsp;&nbsp;say &quot;Getting gift from &quot;.ordinate($_).&quot; wise man&quot;;
}

Doesn't end up calling WISE_MEN from the Perl statement at all - perl is clever enough to substitute a scalar for 3 directly into the compiled op code removing the subroutine call at all. Let's run it through the compiler/decompiler to see the code equivalent to what perl sees once everything has been compiled:

    shell$ perl -Mfeature=say -MO=Deparse script.pl
    sub WISE_MEN () {
        3;
    }
    use Lingua::EN::Numbers::Ordinate (&#39;ordinate&#39;);
    use feature &#39;say&#39;;
    foreach $_ (1 .. 3) {
        say &#39;Getting gift from &#39; . &amp;ordinate($_) . &#39; wise man&#39;;
    }

Note the WISE_MEN in the for loop has gone!

This seems ideal, but there are some big problems:

Prototypes

In order that I can write WISE_MEN not WISE_MEN() I need to declare the subroutine with a prototype, i.e. I need to write:

sub WISE_MEN() { 3 }

The () indicates that no arguments are needed and the call to the subroutine can be written without brackets. However, this syntax is incompatible with the new experimental subroutine signatures feature recent versions of perl offer. Once enabled the same syntax would introduce run-time parameter checking and would result in a bare call to WISE_MEN without the trailing brackets causing an exception. Our subroutine instead would have to be written as:

sub WISE_MEN() :prototype() { 3 }

Which is even less readable than before.

Only Simple Things

Consider this misguided attempt to create constants:

use Lingua::EN::Numbers::Ordinate ('ordinate');

sub MONTH_OF_XMAS() { ordinate(25) };  # 25th
sub DATE_OF_XMAS()  { ordinate(12) };  # 12th

print 'On the '.DATE_OF_XMAS.' day of the '.MONTH_OF_XMAS.' month...';

The value isn't simple enough and perl won't inline it, meaning that not only does our constant result in a subroutine call each time it's called, but it also that results in a call to ordinate each time.

Using `use constant`;

The solution to each of these is to use a core module called constant

use Lingua::EN::Numbers::Ordinate ('ordinate');

use constant MONTH_OF_XMAS =&gt; ordinate(25);
use constant DATE_OF_XMAS  =&gt; ordinate(12);

print 'On the '.DATE_OF_XMAS.' day of the '.MONTH_OF_XMAS.' month...';

This declaration creates a simple subroutine that returns whatever value you passed to the call to use constant. Running this through the parser/deparser shows us that things have been helpfully simplified:

    shell$ perl -MO=Deparse script.pl
    use Lingua::EN::Numbers::Ordinate (&#39;ordinate&#39;);
    use constant (&#39;MONTH_OF_XMAS&#39;, &amp;ordinate(25));
    use constant (&#39;DATE_OF_XMAS&#39;, &amp;ordinate(12));
    print &#39;On the 12th day of the 25th month...&#39;;

However, there's a couple of problems with this technique

No interpolation

Ideally instead of writing:

print 'On the '.DATE_OF_XMAS.' day of the '.MONTH_OF_XMAS.' month...';

We'd love it if we could just write:

print &quot;On the $DATE_OF_XMAS day of the $MONTH_OF_XMAS month...';

Doesn't Play Nice With Hash Keys

Worse, these constants can't be used in situations where Perl would normally automatically quote values for you.

Consider this code:

use constant WISE1 =&gt; 'Melchior';
use constant WISE2 =&gt; 'Caspar';
use constant WISE3 =&gt; 'Balthazar'

my %gifts = (
&nbsp;&nbsp;&nbsp;&nbsp;WISE1 =&gt; 'Gold',
&nbsp;&nbsp;&nbsp;&nbsp;WISE2 =&gt; 'Frankenstein',
&nbsp;&nbsp;&nbsp;&nbsp;WISE3 =&gt; 'Muwhur?',
);

print $gifts{Balthazar};  # doesn't work as we'd expect

The fat comma (aka the =>) causes WISE1 to be the literal string WISE1 not Melchior as we'd expected. We need to write this as:

my %gifts = (
&nbsp;&nbsp;&nbsp;&nbsp;WISE1() =&gt; 'Gold',
&nbsp;&nbsp;&nbsp;&nbsp;WISE2() =&gt; 'Frankenstein',
&nbsp;&nbsp;&nbsp;&nbsp;WISE3() =&gt; 'Muwhur?',
);

The same is true for the hash keys.

# WRONG
my $ag = $gifts{WISE1};

# RIGHT
my $shelly = $gifts{WISE2()};

Const::Fast is...fast.

Const::Fast relies on perl's in-build internal read-only support to make normal variables read-only. This means a variable that Const::Fast has marked as a constant can still be used just like any other variable - interpolated into strings, used as hash keys - except it cannot be altered because it has the read-only flag set.

This read-only functionality isn't provided by Const::Fast - it's just using the same mechanism perl uses internally to stop you altering literals in your source code. For example consider what happens if you write a subroutine that alters its arguments but instead of passing in a variable you pass in a literal string:

sub shorten {
&nbsp;&nbsp;&nbsp;&nbsp;$_[0] =~ s/Christmas/Xmas/;
}

# this works fine
my $string = 'Merry Christmas';
shorten($string);

# this gives the error
# Modification of a read-only value attempted at - line 4.
shorten('Merry Christmas');

Internally perl uses the same sort of representation for the variable $string and the literal string we're passing to shorten, but the latter has a flag set on it to mark it as read only. Const::Fast enables the same flag on variables that you create with const meaning this acts in the same way:

# this also gives the error
# Modification of a read-only value attempted at - line 4.
const my $string =&gt; 'Merry Christmas';
shorten($string);

This means that constants defined by Const::Fast have no run-time penalty and are as fast as hard-coding the value in all the places you use the constant. Awesome!

Choices, choices, so many choices!

2017-12-07T00:00:00Z

Every day we have to tell our computers about the hundreds of choices we make each day. Yes, I'd like to get the blue scarf, not the green one. Change into this directory not that one. Please force push those changes all over that branch. Yes, of course I'm sure!

Being the command line geeks we are, most of the time this comes in the form of passing arguments to command line programs. Passing option flags. Setting enviroment variables before we run the script. All of these things are awesome. We can script them. There's command history. We can use command line tab completion (if we've setup bash or zsh just right.)

But sometimes this can get complex. Maybe as users we don't (or can't) know what all the options are without starting to run the script. Maybe we need to be presented with more choices depending on some of the choices we've already made. Maybe the program needs to ask the user something after it's done something with a remote server, and there was no way to predict what questions it needed to have the answer for when the program was originally run. Or maybe we just want something more user friendly than forcing the user to look up in the man page what options they need to pass.

In these situations we tend to build an interactive GUI app or a web app. However, both of these are much harder to do than writing a program tha parses simple commmand line options - there's event loops to consider, callbacks, possibly listening on various ports. Maybe there's a better, er, choice.

Introducting Term::Choose

Term::Choose is a module that allows us to interactively pick from the terminal from several options. It's really simple to use:

use Term::Choose qw( choose );
my $reindeer = choose([qw(
&nbsp;&nbsp;&nbsp;&nbsp;Ruldolph
&nbsp;&nbsp;&nbsp;&nbsp;Dasher Dancer Prancer Vixen
&nbsp;&nbsp;&nbsp;&nbsp;Comet Cupid Dunder Blixem
)], { prompt =&gt; 'Who is your favourite reindeer?' }) or exit;
say &quot;Cool I like $reindeer too!&quot;;

The user simply moves the selection around with the cursor keys and hits RETURN to pick one. Easy!

Coding this is considerably more simple than developing a GUI or web app, and because it's running on a terminal you can make use of it anywhere - even on a remote server you're connected to over ssh wihtout the overhead and the complexity of doing something tricky with an X-server.

Note also that Term::Choose is a good terminal citizen. It cleans up after itself, removing the interactive prompt from the screen.

More options than fit on the screen

If you have more options than fit on the screen then the screen scrolls when you move down past the last option:

use Term::Choose qw( choose );
my $film = choose(
&nbsp;&nbsp;&nbsp;\@films,
&nbsp;&nbsp;&nbsp;{ prompt =&gt; 'What Christmas movie shall I rent?' },
) or exit;
say &quot;Renting $film&quot;;

Neat! You really don't have to think about it.

Picking More Than One Option

If you use the choose function in list context you can pick more than one option. Just hitting RETURN works as before, picking just the one option. However, hitting SPACE selects multiple options, and then RETURN submits them all.

use Term::Choose qw( choose );
my @options = choose([
&nbsp;&nbsp;&nbsp;&nbsp;'with wrapping paper',
&nbsp;&nbsp;&nbsp;&nbsp;'with a bow on it',
&nbsp;&nbsp;&nbsp;&nbsp;'with ribbons',
&nbsp;&nbsp;&nbsp;&nbsp;'with a gift tag',
], { prompt =&gt; 'How should I wrap up the present?' });
say &quot;Wrapping up the present with $_&quot; for @options;

The Right Choice

Like all my favourite Perl modules, Term::Choose is powerful but simple to use. It does one thing, and does it well. It's the right choice.

North Pole Safety Precautions

2017-12-06T00:00:00Z

The Wise Old Elf was pair programming with Noel Cuddlecrackers, one of the newer elves to join Santa's merry little band of programmers.

Noel and he had agreed to start work on a really simple script. Noel opened a new file, and the Wise Old Elf watched patiently as Noel typed:

use strict;
use warnings;

"Pretty good", the Wise Old Elf thought to himself, "at least he's enabling strictures to help catch mistakes". Noel kept typing though...

no indirect;

"Excellent, Noel's not allowing calls of the form new Foo" the elder Elf thought to himself. But Noel wasn't done typing...

no multidimensional;

"Okay, so Noel's disabling Perl's problematic multi-dimensional array syntax that no-one uses since we use arrays containing references to arrays these days" the Wise old Elf considered. But Noel still was typing more things...

use autodie qw(:all);

"Now he's avoiding to have to manually check each time if one of Perl's IO routines succeeded, and just have them automatically throw an exception". Noel was still typing...

use utf8;

"So he's allowing utf-8 encoding in the document so he can type non-ascii characters directly into the source" the Wise Old Elf mused.

Noel was still typing. The Wise Old Elf had to stop him before he became the Wise Much Older Elf.

"Noel", he asked, "exactly how much more boilerplate stuff are you going to type before we get to work?"

"Not much", the young faced worker replied, with a big grin on his face, "I just have to enable a few experimental features, monkey around with the method resolution order, and..."

"STOP", the Wise Old Elf firmly interrupted. "You do realize that we have a standard module that we use for our in house stuff that does all of this for us, don't you?" Indeed, it was true. A few years back the Wise Old Elf had monkeyed around with a Perl module called Import::Into that allowed a module to import modules into whoever used that module. This allowed the Wise Old Elf to create a standard boilerplate module that they now imported at the start of every Perl source file. Near the top of each file there simply was the line

use NorthPole::Ourperl;

And all the source code that Cuddlecrackers wrote (and was going to add) could be replaced. Import::Into is simple to use - you simply call the fully qualified method import::into on the package name you want to import into whoever uses your module inside the import method:

package NorthPole::Ourperl;
...

sub import {
    # turn on 'use strict' in whoever does 'use NorthPole::Ourperl'
    strict-&gt;import::into(1);
&nbsp;&nbsp;&nbsp;&nbsp;...
}

The full package that the North Pole is currently using looks like this:

## no critic (NamingConventions::Capitalization)
package NorthPole::Ourperl;
## use critic (NamingConventions::Capitalization)

use strict;
use warnings;

our $VERSION = '1.000000';

use Import::Into;

# XXX - it'd be nice to include bareword::filehandles but this conflicts with
# autodie - see https://rt.cpan.org/Ticket/Display.html?id=93591
use autodie 2.25 ();
use IPC::System::Simple;    # to fatalize system
use experimental     ();
use feature          ();
use indirect         ();
use mro              ();
use multidimensional ();

# This adds the UTF-8 layer on STDIN, STDOUT, STDERR for _everyone_
use open qw( :encoding(UTF-8) :std );
use utf8 ();

sub import {
&nbsp;&nbsp;&nbsp;&nbsp;my $caller_level = 1;

&nbsp;&nbsp;&nbsp;&nbsp;strict-&gt;import::into($caller_level);
&nbsp;&nbsp;&nbsp;&nbsp;warnings-&gt;import::into($caller_level);

&nbsp;&nbsp;&nbsp;&nbsp;my @experiments = qw(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;lexical_subs
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;postderef
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;signatures
&nbsp;&nbsp;&nbsp;&nbsp;);
&nbsp;&nbsp;&nbsp;&nbsp;experimental-&gt;import::into( $caller_level, @experiments );

&nbsp;&nbsp;&nbsp;&nbsp;my ($version) = $^V =~ /^v(5\.\d+)/;
&nbsp;&nbsp;&nbsp;&nbsp;feature-&gt;import::into( $caller_level, ':' . $version );
    ## no critic (Subroutines::ProhibitCallsToUnexportedSubs)
    mro::set_mro( scalar caller(), 'c3' );
    ## use critic
    utf8-&gt;import::into($caller_level);

&nbsp;&nbsp;&nbsp;&nbsp;indirect-&gt;unimport::out_of( $caller_level, ':fatal' );
&nbsp;&nbsp;&nbsp;&nbsp;multidimensional-&gt;unimport::out_of($caller_level);
&nbsp;&nbsp;&nbsp;&nbsp;'open'-&gt;import::into( $caller_level, ':encoding(UTF-8)' );
&nbsp;&nbsp;&nbsp;&nbsp;autodie-&gt;import::into( $caller_level, ':all' );
}

1;

This:

Enables strict
Enables warnings
Turns on the experimental lexical subs feature
Turns on the experimental postfix derefencing feature
Turns on the experimental signature feature
Turns on whatever standard features this version of Perl supports (e.g. say, etc)
Sets the method resolution in the module to be c3
Disables indirect method calls
Disables old-style multidimensional array simulation
Configures the filehandles to be UTF-8 everwhere
Enables autodie for all system calls

In one line!

Santa Baby(cart)

2017-12-05T00:00:00Z

Pinecone Candypears was one of the Elves that the Wise Old Elf had wisely brought on to help with the JavaScript toolchain that was becoming an integral part of the new modern North Pole Intranet software. Pinecone wasn't producing the kind of JavaScript the Wise old elf had started out with back in the day with ye olde onclick handlers; Oh no, this modern JavaScript was a serious programming.

"You see", Pinecone was elaborating, "these days in our stack we program in ES6 - modern JavaScript - that's cross compiled with these yarn plugins to turn it into more compatible JavaScript that your dumb browser can run. This allows us to do some pretty funky stuff."

Just to demonstrate Pinecone typed some code into his editor and hit save:

    const countMessage = `There are {presents} left in the sack`

In the background yarn noticed the file was changed and produced a file that worked in the browser.

"Don't you see", Pinecone continued gleefully, "with the new backtick string notation we can stick variables directly into our strings."

"You've been able to do that since forever in Perl just with doublequotes", the wise old Elf smiled.

my $count_message = &quot;There are $presents left in the sack&quot;;

"Ah", Pinecone countered, "but what about a method call?"

    const countMessage = `There are { sack.presents() } left in the sack`

"Well, that's a little different", the Wise Old Elf admitted, "But there is a way"

Introducing the Babycart Operator

In Perl it's possible to put executable code directly in the middle of strings with something we like to call the "babycart operator".

my $count_message = &quot;There are @{[ $sack-&gt;presents ]} left in the sack&quot;;

The babycart operator was named by Philippe Bruhat (BooK) after a series of Japanese films featuring Samurai and babycarts - the code you're sticking in your string is inside the babycart!

It's not really an operator at all, but some clever abuse of several existing operators to get what we want. Consider first of all what happens to arrays that are placed in the middle of strings:

my @count = ( 6 );
my $count_message = &quot;There are @count left in the sack&quot;;

All the elements of the array are stringified and interpolated into the string. Since there's only one thing in the array, the string above gets turned into There are 6 left in the sack.

So what if we use an array reference instead, and use the @{ ... } operator to dereference it?

my $count = [ 6 ];
my $count_message = &quot;There are @{ $count } left in the sack&quot;;

Hey, that still works! Let's put the logic inside the anonymous array:

my $count = [ $sack-&gt;presents ];
my $count_message = &quot;There are @{ $count } left in the sack&quot;;

And now finally let's move that logic inside string:

my $count_message = &quot;There are @{[ $sack-&gt;presents ]} left in the sack&quot;;

But Where Is This Useful?

Even the Wise Old Elf wouldn't recommend using it in the above situation. It's probably better to just write:

my $count_message = 'There are '.$sack-&gt;presents.' left in the sack';

But consider the heredoc where you can't just do that:

sub find_records_over {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $min  = shift;
&nbsp;&nbsp;&nbsp;&nbsp;return $self-&gt;database_handle
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;selectall_arrayref(&lt;&lt;~&quot;SQL&quot;,{},$min);
       SELECT id, @{[ $self-&gt;fieldname ]}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;FROM @{[ $self-&gt;tablename ]}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;WHERE @{[ $self-&gt;fieldname ]} = ?
    SQL
}

Here(doc) it is Merry Christmas

2017-12-04T00:00:00Z

The Wise Old Elf was doing code review for Sloeberry Snoozyflakes, one of the newest elves on his team.

Slowberry was writing a simple routine to count the number of nice children there were this year, in order to get an estimate of the number of presents that Santa would need to deliver.

sub number_of_children {
&nbsp;&nbsp;&nbsp;&nbsp;my $self            = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $naughty_or_nice = shift;

&nbsp;&nbsp;&nbsp;&nbsp;my $sql = &quot;SELECT count(*)\n&quot; .
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;  FROM children\n&quot; .
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;  WHER naughty_or_nice = \$1&quot;;

&nbsp;&nbsp;&nbsp;&nbsp;my $dbh = $self-&gt;database_handle;
&nbsp;&nbsp;&nbsp;&nbsp;return $dbh-&gt;selectall_arrayref($sql,{},$naughty_or_nice)-&gt;[0];
}

"That multi-line sql assignment is a little hard to read.", the Wise Old Elf commented. "Could we change it to make it cleaner?"

Slowberry changed his code to use a heredoc:

sub number_of_children {
&nbsp;&nbsp;&nbsp;&nbsp;my $self            = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $naughty_or_nice = shift;

&nbsp;&nbsp;&nbsp;&nbsp;my $sql = &lt;&lt;END
       SELECT count(*)
         FROM children
         WHER naughty_or_nice = \$1
END

&nbsp;&nbsp;&nbsp;&nbsp;my $dbh = $self-&gt;database_handle;
&nbsp;&nbsp;&nbsp;&nbsp;return $dbh-&gt;selectall_arrayref($sql,{},$naughty_or_nice)-&gt;[0];
}

"That's better," the elf continued, "but if you'd used SQL as the heredoc deliminator rather than than TEXT, then your editor would probably enable syntax highlighting, and you'd probably have noticed that you typo-ed WHERE."

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13: `	`sub number_of_children {     my $self = shift;     my $naughty_or_nice = shift;     my $sql = <<SQL SELECT count(*)    FROM children   WHERE naughty_or_nice = $1 SQL     my $dbh = $self->database_handle;     return $dbh->selectall_arrayref($sql,{},$naughty_or_nice)->[0]; }`

"Not bad, but you probably should put single quotes around the first heredoc deliminator so you don't have escape that $. In fact you should always put " or ' around the heredoc deliminator just to make it clear to whoever is reading your code what you actually meant."

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13: `	`sub number_of_children {     my $self = shift;     my $naughty_or_nice = shift;     my $sql = <<'SQL' SELECT count(*)    FROM children   WHERE naughty_or_nice = $1 SQL     my $dbh = $self->database_handle;     return $dbh->selectall_arrayref($sql,{},$naughty_or_nice)->[0]; }`

"Pretty good. The terminating heredoc deliminator looks weird all over there on the left hand side, not indented like the rest of the subroutine. We're using Perl 5.26, so we can add a tilde in the heredoc syntax to allow us to indent."

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13: `	`sub number_of_children {     my $self = shift;     my $naughty_or_nice = shift;     my $sql = <<~'SQL' SELECT count(*)    FROM children   WHERE naughty_or_nice = $1     SQL     my $dbh = $self->database_handle;     return $dbh->selectall_arrayref($sql,{},$naughty_or_nice)->[0]; }`

"That's awesome. Not that it matters here, but the way this works is that the same amount of whitespace that's before the final heredoc terminator is stripped from the rest of the heredoc. Maybe now we could remove some of the variables?"

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11: `	`sub number_of_children {     my $self = shift;     my $naughty_or_nice = shift;     return $self->database_handle                 ->selectall_arrayref(<<~'SQL',{},$naughty_or_nice)->[0]; SELECT count(*)    FROM children   WHERE naughty_or_nice = $1     SQL }`

"There we go. Now you just need to add some more tests - that broken WHERE from earlier can't have possibly been executed, otherwise we'd have seen a test failure - and we're ready to ship..."

Context Matters

2017-12-03T00:00:00Z

The Wise Old Elf was looking at a code snippet Garland Twinklecake had brought to him.

use Moose;

# holds our DBIx::Class resultsets that can be used to get the
# naughty or nice children one by one
has '_result_sets' =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;is =&gt; 'ro',
&nbsp;&nbsp;&nbsp;&nbsp;lazy =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;builder =&gt; '_build_result_sets',
);

sub _build_result_sets {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $children = $self-&gt;_schema-&gt;resultset('Child');
&nbsp;&nbsp;&nbsp;&nbsp;return {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;naughty =&gt; $rs-&gt;search( naughty =&gt; 1 ),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;nice    =&gt; $rs-&gt;search( naughty =&gt; 0 ),
&nbsp;&nbsp;&nbsp;&nbsp;};
}

sub naughty_child {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;return $self-&gt;_result_sets-&gt;next;
}

sub nice_child {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;return $self-&gt;_result_sets-&gt;next;
}

"I just don't understand why it doesn't work.", Garland complained, "it just freezes right up".

"Okay, okay", the Wise Old Elf reassured, "we can get to the bottom of this. Just run the whole thing with the DBIC_TRACE environment variable set to true. and DBIx::Class will spit out the SQL it's doing to STDERR."

No sooner had Garland run the command again than he immediately saw the problem; Perl was trying to bring back every single child from the database, and, well, that was, as you might expect, taking some time.

"I see what's going on now. You've been bitten by using the search method in list context", the Wise Old Elf explained.

Context Matters

One way that people (and elves) often get into trouble with Perl is forgetting that some functions and methods act differently when called in list or scalar context.

For example, this code creates two results sets we can use later to request children one by one:

my $naughty_result_set = $schema-&gt;resultset('Child')
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&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;search( naughty =&gt; 1 );

my $nice_result_set    = $schema-&gt;resultset('Child')
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&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;search( naughty =&gt; 0 );

This works because search is being called in scalar context both times, and when it's called in scalar context we get back a resultset as the names of the variables indicate. At this point these two abstract resultsets represent sets of conditions that will be run against the database as soon as we call first, next, etc on them or can be used to create further refined result sets by adding additional conditions with further calls to search.

However, this seemingly similar code does something dramatically different

my $result_sets = {
&nbsp;&nbsp;&nbsp;&nbsp;naughty =&gt; $schema-&gt;resultset('Child')-&gt;search( naughty =&gt; 1 ),
&nbsp;&nbsp;&nbsp;&nbsp;nice    =&gt; $schema-&gt;resultset('Child')-&gt;search( naughty =&gt; 0 ),
};

While it looks like the search method here should return one value each time it's called to pair with naughty and nice, that's not what happens. search in list context actually returns all the results as a big list making $result_sets huge and filled with nonsensical data rather than just the two key-value pairs we were expecting. In other situations this can result in security risks where keys and parameters become mismatched.

One way to fix this is to force scalar context with the scalar keyword:

my $result_sets = {
&nbsp;&nbsp;&nbsp;&nbsp;naughty =&gt; scalar($schema-&gt;resultset('Child')-&gt;search( naughty =&gt; 1 )),
&nbsp;&nbsp;&nbsp;&nbsp;nice    =&gt; scalar($schema-&gt;resultset('Child')-&gt;search( naughty =&gt; 0 )),
};

The better solution however, is to just call search_rs instead of search.

my $result_sets = {
&nbsp;&nbsp;&nbsp;&nbsp;naughty =&gt; $schema-&gt;resultset('Child')-&gt;search_rs( naughty =&gt; 1 ),
&nbsp;&nbsp;&nbsp;&nbsp;nice    =&gt; $schema-&gt;resultset('Child')-&gt;search_rs( naughty =&gt; 0 ),
};

search_rs is exactly the same as search, except it always returns a result set object even when called in list context.

Writing a Perl Critic rule

After all this explanation, Garland was frustrated. "Okay, I give up. We should just never call the search method. We should always use search_rs"

The Wise Old Elf agreed, and he had a plan. Rather than just updating the coding standards document, he made sure that no code in the repository contained calls to the search method and made it impossible for new code to sneak in calls to search.

How did he do that? Well, the test suite for the North Pole codebase uses Test::Perl::Critic to ensure that the code in the repo meets the Perl::Critic guidelines defined in the .perlcriticrc. So all the Wise Old Elf had left to do was write a quick Perl::Critic rule that freaks out at any method call to search that isn't wrapped in a no critic type declaration.

package Perl::Critic::Policy::NorthPole::ProhibitSearchMethod;

use strict;
use warnings;

use Perl::Critic::Utils qw( :severities is_method_call );
use base 'Perl::Critic::Policy';

sub default_severity     { return $SEVERITY_HIGHEST }
sub default_themes       { return qw( northpole ) }

# Don't support any parameters in the config file
sub supported_parameters { return () }

# only call 'violates' for elements that are Words (this speeds things up)
sub applies_to           { return 'PPI::Token::Word' }

# examine each PPI::Token::Word in the source code, and violate if it's any
# call to the method 'search'
sub violates {
&nbsp;&nbsp;&nbsp;&nbsp;my $self    = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $element = shift;

&nbsp;&nbsp;&nbsp;&nbsp;return unless $element-&gt;content eq 'search';
&nbsp;&nbsp;&nbsp;&nbsp;return unless is_method_call($element);

&nbsp;&nbsp;&nbsp;&nbsp;return $self-&gt;violation(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'Use of the search() method is prohibited',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;&lt;'END',
DBIx::Class's search() method returns a result set object in scalar context, but
returns a list of results in list context.  This is unsafe when such a call is
used in a constructor as it can mix up the parameter keys and values.  For
example, if search returns no results this:

&nbsp;&nbsp;&nbsp;Foo::Bar-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;foo =&gt; $schema-&gt;resultset('Foo')-&gt;search(...),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;bar =&gt; $user_value,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;baz =&gt; $user_value2,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;...
&nbsp;&nbsp;&nbsp;);

Could be interpreted as

&nbsp;&nbsp;&nbsp;&nbsp;Foo::Bar-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;foo =&gt; 'bar',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$user_value =&gt; baz,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$user_value2 =&gt; ...
&nbsp;&nbsp;&nbsp;&nbsp;);

This critic rule can easily have false positives if other classes have a
C&lt;search&gt; method - we can't tell the difference with simple static analysis.
END
        $element
&nbsp;&nbsp;&nbsp;&nbsp;);
}

1;

Around the world with Emoji

2017-12-02T00:00:00Z

It was the night before the night before Christmas and, as one of the best programmers on the rapid response team, Sherry Silversparkles was in a rush. She'd been handed the task of automating the updating of Santa's twitter account as he travelled around the world. The kind of updates she'd been asked to post were really simple, as was the code she'd hastily written to do so.

use Net::Twitter;
use Country::Codes qw( country );

sub tweet {
&nbsp;&nbsp;&nbsp;&nbsp;my $country_code = shift;

&nbsp;&nbsp;&nbsp;&nbsp;my $country = country($country_code)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;or die &quot;Unknown country!&quot;;

&nbsp;&nbsp;&nbsp;&nbsp;my $twitter = Net::Twitter-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;username =&gt; $user,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;password =&gt; $pass,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;source   =&gt; 'Santa Twitteromatic Two Thousand',
&nbsp;&nbsp;&nbsp;&nbsp;);

&nbsp;&nbsp;&nbsp;&nbsp;$twitter-&gt;update(&quot;Father Christmas's sleigh is flying to $country&quot;);
&nbsp;&nbsp;&nbsp;&nbsp;return;
}

She submitted her work for acceptance by Elf command. However, within minutes she'd got a report back on the contents of her messages: tl;dr. Apparently today's youths wouldn't read more than a couple of words before getting bored and going back to checking Instagram. Elf command had suggested a three glyph alternative message:

🎅→🇺🇸

"Nothing like changing the specs at the last minute" Sherry mused to herself. Now she'd have to work out how to do these changes in a jiffy! Sherry already knew how to render the emoji for Santa and that right arrow:

print &quot;\N{FATHER CHRISTMAS}\N{RIGHTWARDS ARROW}&quot;;

But as hard as she looked in her unicode charts, she couldn't find the character for the US flag, nor for any of the other countries.

After much head scratching, and a relaxing glass of mulled wine, Sherry discovered that not all glyphs in Unicode are represented by a single character. Some glyphs are made up by combining one or more characters:

print &quot;\N{REGIONAL INDICATOR SYMBOL LETTER U}&quot;;
print &quot;\N{REGIONAL INDICATOR SYMBOL LETTER S}&quot;;

On systems that don't understand how to render flags that would simply display as an odd looking U followed by an odd looking S (which hopefully the end user would know as the ISO 3166-1 code for the United States). On more capable systems that would be turned into a United States flag emoji.

So, that was simple - sort of - but Sherry still needed some way to turn the country code that her subroutine was being passed into those corresponding regional indicator characters. Of course, this being Perl, there was a module for that on the CPAN:

use Emoji::NationalFlag qw( code2flag );

...

$twitter-&gt;update(
&nbsp;&nbsp;&nbsp;&quot;\N{FATHER CHRISTMAS}\N{RIGHTWARDS ARROW}&quot; . code2flag( $country_code )
);

This time Sherry's changes were accepted, leaving her free to move onto the next last-minute Christmas programming panic...

Emoji

2017-12-01T00:00:00Z

One of the great things about the Wise Old Elf's job was that he got to keep up with all the latest fads the kids were up to. He fondly remembered the hula-hoop craze. Micromachines. Pogs. Oh the memories!

Today's modern day kids are all about text messages. But not just any old text in their text messages. No, these kids are all about the Emojis. And honestly, how could anyone at the North Pole not love Emojis too? After all, Santa has his very own emoji: Character 127877 in Unicode FATHER CHRISTMAS.

🎅

The Wise Old Elf was working on Perl script to generate text messages to all the elves telling them what a good job they were doing this year. And, of course, this would include the Father Christmas emoji.

The first thing the Wise Old Elf did was universally enable UTF-8 encoding on STDOUT, STDIN, and STDERR with an open pragma:

use open qw( :encoding(UTF-8) :std );

Now when he printed out his emoji Perl would be outputting the byte sequence necessary to represent that emoji in UTF-8 and (hopefully) the other end would be able to recognize the code for Santa and Do The Right Thing.

He then simply printed out the message he wanted, using the hexadecimal code for 127877, 1F385.

print &quot;\x{1F385} thanks you for all your hard work tonight&quot;;

No sooner had he typed this then he started to have second thoughts. \x{1F385} isn't exactly the most instantly recognizable code. What if he had accidentally typed \x{1F383} by mistake, the Unicode character for the jack-o-lantern. What a Nightmare Before Christmas situation that would be!

Of course, the Wise Old Elf was using a modern editor which would be happy to edit utf-8 encoded source code, so he could simply enable UTF-8 source code in Perl too by declaring:

use utf8;

At the top of the source code, and then he'd be able to simply write:

`1: `	`print "🎅 thanks you for all your hard work tonight";`

Was he done? He wasn't so sure.

Typing this would this either involve some crazy keyboard shenanigans to type, or he'd have to copy-and-paste from a Unicode pallet. It wasn't the best situation, but he could put up with that.

The main problem was that the Wise Old Elf was Old enough (and Wise enough) to know that not all editors support UTF-8 source code and all it'll take is one Elf using an editor doing the wrong thing with encodings to potentially break everything. The last thing the Wise Old Elf needed was to post a message of thanks for a bunch of unrenderable character sequences instead of the man in the red suit.

Luckily Perl is able to represent all Unicode characters in a simple, readable, ASCII encodable way: You can use the \N{...} sequence with the official name of the character:

print &quot;\N{FATHER CHRISTMAS} thanks you for all your hard work tonight&quot;;

Perl Advent Calendar 2017

Merry Christmas!

Watching The Perl Conference

Scraping the playlist

WWW::YouTube::Download

All Done

Speedy Validation

Parameter Validation

Speed Concerns

To Bed, Perchance to Dream

Custom Relationships with DBIx::Class

Accessing the Tags, Inefficently

Performance Woes

Teaching DBIx::Class about delivery_problem_with_dog

All Done

Quickly Building DBIx::Class Schemas

What Emberflakes Had To Model

The SQL

Building The ORM Classes Automatically

Loading Test Data

Playing Around with the data

Not Much Coding, So Much Done

Reindeer

Does All The Things

All our Favourite Extensions

Type Libraries

Trait Aliases

Extra Language Features and Extensions

Less Typing Is Less Mistakes

Maybe not

MooseX::LazyRequire

MooseX::UndefTolerant::Attribute

Cleaner Code All Round

Project Multipli-sleigh-ion

Making a constructor argument list, checking it twice.

Not Strict Enough

For Elves, Shorter is Better

Verbose. Verbosity. So long winded. On and On.

Enter MooseX::AttributeShortcuts

Custom Anonymous Types

Much much more

Mojolicious on the Command Line

A Worked Example

Prereqing around the Christmas Tree

Technique 1: Hooking @INC

The Downsides of This Technique

Technique 2: Parsing the source

Speeding things up with Perl::PrereqScanner::Lite

Finding optional dependencies with Perl::PrereqScanner::NotSoLite

Frostystocking&#39;s List

It&#39;s All There in the Numbers!

A Christmas Memory

Introducing Devel::MAT

Tracking down the largest things in your code

Tracking Down Leaks

A Happy Elf

Tiny Path Handling

Building New Path::Tiny instances

Reading and Writing Files

Evaluating the NaughtyNice Formula

Turning the Formula into Perl Code

Closing over variables

The Mistake, and a Solution

Matching the NaughtyNice Formula

Backus-Naur Form

Named Capture Groups

Constantly Merry

Other constant techniques that don&#39;t work as well

The Inlined Subroutine Trick

Prototypes

Only Simple Things

Using use constant;

No interpolation

Doesn&#39;t Play Nice With Hash Keys

Const::Fast is...fast.

Choices, choices, so many choices!

Introducting Term::Choose

More options than fit on the screen

Picking More Than One Option

The Right Choice

Frostystocking's List

It's All There in the Numbers!

Other constant techniques that don't work as well

Using `use constant`;

Doesn't Play Nice With Hash Keys